Convert BMP to Dominoes by Richard Frost

[Junior Librarian]

Convert BMP to Dominoes

Author: @Richard Frost
Source: qb64.org Forum
URL: https://www.qb64.org/forum/index.php?topic=1023.0
Version: 2019

Description:
[This] is an image converter that takes a picture a small block at a time and finds the "best fit" domino for that space. (The woman is Heather Thomas.)

Source Code:

Code: QB64: [Select]

1. ' The woman is Heather Thomas
2.  
3. DEFINT A-Z
4. SCREEN 12
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
13. NEXT n
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
73. DO: _LIMIT 10
74. LOOP UNTIL LEN(INKEY$)
75. SYSTEM
76.  
77. Status:
78. FOR i = 0 TO 7
79.     'COLOR i
80.     LOCATE i + 2, 49: PRINT USING "####"; i; c1(i);
81. NEXT 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!;
97. NEXT i
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;
103. RETURN
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.  

Attachments:
Requires HEATH.BMP

 

BMP2Dominoes.bas

                                                                                                                                         (219 downloads previously)