Text Only | Text with Attachments

QB64.org Forum

Active Forums => Programs => Topic started by: Richard Frost on January 31, 2019, 11:28:18 pm

Title: Convert a BMP to dominos
Post by: Richard Frost on January 31, 2019, 11:28:18 pm
Code: QB64: [Select]
  1. ' The woman is Heather Thomas
  2.  
  3. DEFINT A-Z
  5. DIM dots(7), x(7, 7), y(7, 7), c1(7), c2(28), pixel(7, 7), w(3), y$(30)
  6. cps! = 12.83 ' cost per set
  7. FOR i = 1 TO 28: READ y$(i): NEXT i
  8. FOR n = 1 TO 7
  9.     READ dots(n)
  10.     FOR dot = 1 TO dots(n)
  11.         READ x(n, dot), y(n, dot)
  12.     NEXT dot
  14. xb = 10: xe = 350 ' x begin and end
  15. yb = 0: ye = 470 ' y begin and end
  16. OPEN "heath.bmp" FOR RANDOM AS #1 LEN = 1: FIELD #1, 1 AS t$
  17. FOR y1 = yb TO ye STEP 8
  18.     FOR x1 = xb TO xe STEP 8
  19.         n = 0
  20.         FOR y2 = 0 TO 7
  21.             FOR x2 = 0 TO 7
  22.                 x3 = x1 + x2
  23.                 y3 = y1 + y2
  24.                 r& = CDBL(479 - y3) * 640 + x3 + 441
  25.                 GET #1, r&
  26.                 d = ASC(t$) \ 13
  27.                 IF d > 15 THEN d = 15
  28.                 pixel(x2, y2) = -(d > 7) ' for 3 problem
  29.                 n = n + d
  30.             NEXT x2
  31.         NEXT y2
  32.         n = n / 155 ' 175
  33.         IF n > 6 THEN n = 6
  34.         x$ = x$ + CHR$(48 + n) ' for counting tiles used
  35.         IF LEN(x$) = 2 THEN ' got left & right
  36.             FOR i = 1 TO 28
  37.                 IF x$ = y$(i) THEN c2(i) = c2(i) + 1: EXIT FOR
  38.             NEXT i
  39.             x$ = ""
  40.         END IF
  41.         IF n = 3 THEN ' default bottom left - top right
  42.             IF (l = 3) OR (l = 7) THEN ' can't change direction if the
  43.                 n = l ' last piece was also a 3
  44.             ELSE
  45.                 FOR zi = 0 TO 3
  46.                     w(zi) = 0
  47.                 NEXT zi
  48.                 FOR y2 = 0 TO 7
  49.                     FOR x2 = 0 TO 7
  50.                         xi = x2 \ 4 ' 0 or 1
  51.                         yi = y2 \ 4 ' 0 or 1
  52.                         zi = xi * 2 + yi ' 0-3
  53.                         ' LOCATE zi + 1, 1: PRINT zi;
  54.                         w(zi) = w(zi) + pixel(x2, y2)
  55.                     NEXT x2
  56.                 NEXT y2
  57.                 IF (w(1) + w(2)) > (w(0) + w(3)) THEN n = 7
  58.             END IF
  59.         END IF
  60.         l = n ' save last used (for 3)
  61.         d = dots(n)
  62.         c1(n) = c1(n) + 1
  63.         FOR dot = 1 TO d
  64.             tx = (x1 + 4) + x(n, dot) * 2 - xb
  65.             ty = (y1 + 4) + y(n, dot) * 2 - yb
  66.             PSET (tx, ty), 15
  67.         NEXT dot
  68.         IF INKEY$ = CHR$(27) THEN CLOSE: SCREEN 0, 0, 0, 0: END
  69.         nd = nd + 1
  70.     NEXT x1
  71.     GOSUB Status
  72. NEXT y1
  76.  
  77. Status:
  78. FOR i = 0 TO 7
  79.     'COLOR i
  80.     LOCATE i + 2, 49: PRINT USING "####"; i; c1(i);
  82. RESTORE count
  83. FOR i = 1 TO 28
  84.     LOCATE i + 1, 60: PRINT " ";
  85.     LOCATE i + 1, 60
  86.     IF c2(i) >= max THEN
  87.         max = c2(i)
  88.         PRINT "*";
  89.     ELSE
  90.         PRINT " ";
  91.     END IF
  92.     PRINT y$(i);
  93.     PRINT USING " #### "; c2(i);
  94.     c! = c2(i) * cps!
  95.     c! = c! + c! * .07
  96.     PRINT USING "####.##"; c!;
  98. xn = (xe - xb) / 16
  99. yn = (ye - yb) / 8
  100. LOCATE 27, 52: PRINT xn;
  101. LOCATE 28, 52: PRINT yn;
  102. LOCATE 29, 52: PRINT xn * yn;
  104.  
  105. count:
  106. DATA 00,01,02,03,04,05,06
  107. DATA 11,12,13,14,15,16
  108. DATA 22,23,24,25,26
  109. DATA 33,34,35,36
  110. DATA 44,45,46
  111. DATA 55,56
  112. DATA 66
  113.  
  114. dots:
  115. DATA 1,0,0
  116. DATA 2,0,-1,0,1
  117. DATA 3,-1,-1,0,0,1,1
  118. DATA 4,-1,1,-1,-1,1,-1,1,1
  119. DATA 5,-1,1,-1,-1,1,-1,1,1,0,0
  120. DATA 6,-1,1,-1,0,-1,-1,1,1,1,0,1,-1
  121. DATA 3,1,-1,0,0,-1,1
  122.  
  123.  
Title: Re: Convert a BMP to dominos
Post by: bplus on February 01, 2019, 12:00:51 am
Hey Richard, welcome to forum!
Title: Re: Convert a BMP to dominos
Post by: STxAxTIC on February 01, 2019, 08:55:16 am
This is a really cool utility Richard - thanks for posting!

Say, this example is so cute and to-the-point (no pun), I think it's a great candidate for our Samples section. If you say the code is 100% done then just say the word. We'll move it there when you're ready!
Title: Re: Convert a BMP to dominos
Post by: Richard Frost on February 01, 2019, 04:26:25 pm
No program is ever "done", IMO.  One should review/modify code on a regular basis as one learns more,
or thinks up neat new features to add.    I've forgotten what all the numbers are, but the one of the columns
is for estimating the cost to build it for real - how many box sets at some price....

Few BMPs I had on hand at the time worked out quite as nice as Heather Thomas.  You can't plug in a
different file and expect it to work.  It'd be way better if it could do that.  Also, I neglected to mention the source
of the idea.  It's from seeing a picture of Martin Gardner (Scientific American) with a domino pix in the
background. 

I's gotta ploglam to convert the same picture to best ASCII too, which I may upload.  I's gittin' worried I'll be
banned from the site for sending too much!
Title: Re: Convert a BMP to dominos
Post by: _vince on February 06, 2019, 11:26:05 am
Quote from: STxAxTIC on February 01, 2019, 08:55:16 am
I think it's a great candidate for our Samples section.

Certainly a worthy entry, nice work R. Frost
Text Only | Text with Attachments