Convert image content to PSET expressions....

[pagetelegram]

Thank you!

I'll post final code and wwwbasic template example once I get it all working.

[pagetelegram]

I get memory out of range error, using:

Code: QB64: [Select]

1.     _MEMGET m, m.OFFSET + writeit, colors  

trying a 400x333 something image.

full program:

Code: QB64: [Select]

1. DIM fil$(255)
2. DIM colors AS _UNSIGNED LONG, m AS _MEM
3. 'DIM m AS _MEM
4. CLS
5. SHELL _HIDE "dir/b *.jpg > list.txt"
6. SHELL _HIDE "dir/b *.png >> list.txt"
7. SHELL _HIDE "dir/b *.bmp >> list.txt"
8. SHELL _HIDE "dir/b *.gif >> list.txt"
9. OPEN "list.txt" FOR INPUT AS #1
10. a = 0
11. DO
12.     a = a + 1
13.     IF NOT (EOF(1)) THEN INPUT #1, fil$(a) ELSE SYSTEM
14.     list$ = list$ + fil$(a) + "|"
15. LOOP UNTIL EOF(1)
16. CLOSE #1
17. '
18. ' Originally: COUNTRY.BAS
19. ' This program asks the user to select his country from a list.
20. ' The user may press the UP and DOWN arrows or PAGE UP/PAGE DOWN
21. ' or HOME/END keys to navigate the menu. The user may also start
22. ' typing the name of his country to find it faster.
23. '
24. ' Written by Zsolt Nagy-Perge in October 2018, Pensacola, Fla.
25. ' <zsolt500n@gmail.com>
26. '
27. ' Code adapted in file selector for loadimg.bas by Jason Page
28. ' December 2018. This program generates a file containing
29. ' all the pset commands needed to generate any image you put
30. ' in the program. This is ideal to generate images using for
31. ' example wwwbasic. This program will only work and compile
32. ' using QB64. Visit QB64.org to use the free compiler/IDE
33. ' <pagetelegram@gmail.com>
34. '
35. ' QBasic 1.1 source code:
36. '
37. DEFINT A-Z
38. DECLARE SUB CENTER (TEXTCOLOR, ROW, TEXT$)
39. DECLARE SUB MENU (S, TITLE$, L$, TEXT$)
40. DECLARE FUNCTION GETWORD$ (L$, N, S)
41.  
42. SELECTED = 3
43. 'list$ = "United States of America|Mexico|Canada|United Kingdom|Australia|Afghanistan|Albania|Algeria|Andorra|Angola|Anguilla|Antigua and Barbuda|Argentina|Armenia|Aruba|Austria|Azerbaijan|Bahamas|Bahrain|Bangladesh|Barbados|Belarus|Belgium|Belize|Benin|Bermuda|Bhutan|Bolivia|Bonaire|Bosnia and Herzegovina|Botswana|Brazil|British Virgin Islands|Brunei|Bulgaria|Burkina Faso|Burundi|Cabo Verde|Cambodia|Cameroon|Cayman Islands|Central African Republic|Chad|Chile|China|Clipperton Island|Colombia|Comoros|Costa Rica|Cote d'Ivoire|Croatia|Cuba|Curacao|Cyprus|Czech Republic|Democratic Republic of the Congo|Denmark|Djibouti|Dominica|Dominican Republic|Ecuador|Egypt|El Salvador|Equatorial Guinea|Eritrea|Estonia|Ethiopia|Fiji|Finland|France|French Polynesia|Gabon|Gambia|Georgia|Germany|Ghana|Greece|Greenland|Grenada|Guadeloupe|Guatemala|Guinea|Guinea-Bissau|Guyana|Haiti|Honduras|Hungary|Iceland|India|Indonesia|Iran|Iraq|Ireland|Israel|Italy|Jamaica|Japan|Jordan|Kazakhstan|Kenya|Kiribati|Kosovo|Kuwait|Kyrgyzstan|Laos|Latvia|Lebanon|Lesotho|Liberia|Libya|Liechtenstein|Lithuania|Luxembourg|Macedonia (FYROM)|Madagascar|Malawi|Malaysia|Maldives|Mali|Malta|Marshall Islands|Martinique|Mauritania|Mauritius|Micronesia|Moldova|Monaco|Mongolia|Montenegro|Montserrat|Morocco|Mozambique|Myanmar (Burma)|Namibia|Nauru|Navassa Island|Nepal|Netherlands|New Zealand|Nicaragua|Niger|Nigeria|North Korea|Norway|Oman|Pakistan|Palau|Palestine|Panama|Papua New Guinea|Paraguay|Peru|Philippines|Poland|Portugal|Puerto Rico|Qatar|Republic of the Congo|Romania|Russia|Rwanda|Saba|Saint Barthelemy|Saint Kitts and Nevis|Saint Lucia|Saint Martin|Saint Pierre and Miquelon|Saint Vincent and the Grenadines|Samoa|San Marino|Sao Tome and Principe|Saudi Arabia|Senegal|Serbia|Seychelles|Sierra Leone|Singapore|Sint Eustatius|Sint Maarten|Slovakia|Slovenia|Solomon Islands|Somalia|South Africa|South Korea|South Sudan|Spain|Sri Lanka|Sudan|Suriname|Swaziland|Sweden|Switzerland|Syria|Taiwan|Tajikistan|Tanzania|Thailand|Timor-Leste|Togo|Tonga|Trinidad and Tobago|Tunisia|Turkey|Turkmenistan|Turks and Caicos Islands|Tuvalu|Uganda|Ukraine|United Arab Emirates|Uruguay|US Virgin Islands|Uzbekistan|Vanuatu|Vatican City|Venezuela|Vietnam|Yemen|Zambia|Zimbabwe"
44. MENU SELECTED, "Files", list$, "Please select your image file from the list below:"
45.  
46. CENTER 15, 10, "You picked :    " + GETWORD$(list$, SELECTED, 124)
47. fle$ = GETWORD$(list$, SELECTED, 124)
48.  
49. SCREEN _NEWIMAGE(640, 480, 32)
50.  
51. 'img& = _LOADIMAGE(fle$, 32) 'load the image file to be drawn
52.  
53. n = _LOADIMAGE(fle$, 32)
54. m = _MEMIMAGE(n) 'screen memory of image
55.  
56. 'wide% = _WIDTH(img&): deep% = _HEIGHT(img&)
57. 'TLC$ = "BL" + STR$(wide% \ 2) + "BU" + STR$(deep% \ 2) 'start draw at top left corner
58. 'RET$ = "BD BL" + STR$(wide%) 'return to left side of image
59. '_SOURCE img&
60. '_DEST 0
61. 'SHELL "echo. > pset.txt"
62. 'OPEN "pset.txt" FOR OUTPUT AS #2
63. 'CLS
64. 'Tmp& = _NEWIMAGE(32, 32, 256)
65. 'DO
66. '    x = x + 1
67. 'IF x > wide% THEN
68. 'x = 0: y = y + 1
69. 'END IF
70. 'DRAW "C" + STR$(POINT(x, y)) + "R1" 'color and DRAW each pixel
71. '
72. 'colour~& = POINT(x, y)
73. 'c% = _RGB(_RED32(colour~&), _GREEN32(colour~&), _BLUE32(colour~&), Tmp&)
74. 'clr = (c%) 'POINT(x, y) / (16553 * 256 * 16 * 8)
75. 'x$ = STR$(x)
76. 'y$ = STR$(y)
77. 'clr$ = STR$(clr)
78. 'PRINT #2, "pset(" + x$ + CHR$(44) + y$ + ")" + CHR$(44) + clr$
79. 'LOCATE 2, 1: PRINT x, y
80. 'PSET (x, y), clr
81.  
82. 'LOOP UNTIL y >= deep%
83. 'CLOSE #2
84. 'LOCATE 22, 1
85. 'PRINT "Saved as pset.txt"
86. 'SLEEP 1
87.  
88. ' Steve Contrib (SMcNeill):
89.  
90. 'DIM c AS _UNSIGNED LONG 'color value of the pixels
91. 'DIM ShortByte AS _UNSIGNED _BYTE, LongData AS _UNSIGNED LONG
92. 'ShortByte = 0
93. SHELL _HIDE "echo. > databas.txt"
94. ''open  a file for saving
95. 'OPEN "databas.txt" FOR OUTPUT AS #1
96.  
97.  
98. 'DO UNTIL finished
99. 'count = 1 'count is the count of repetitive times a color appears in a row
100. '_MEMGET m, m.OFFSET + p * 4, c 'p is the current point
101. 'IF p >= m.SIZE THEN
102. '    finished = -1
103. 'ELSE
104. '    IF (p + count) * 4 >= m.SIZE THEN
105. '    finished = -1
106. 'ELSE
107. '    DO UNTIL _MEMGET(m, m.OFFSET + (p + count) * 4, _UNSIGNED LONG) <> c
108. '    count = count + 1
109. '    IF (p + count) * 4 >= m.SIZE THEN finished = -1: count = count - 1: EXIT DO
110. 'LOOP
111. 'END IF
112. 'END IF
113. 'p = p + count
114. 'r = _RED32(c): g = _GREEN32(c): b = _BLUE32(c)
115. 'PRINT #1, "DATA "; r; ","; g; ","; b; ",";
116. 'IF count > 255 THEN
117. '    LongData = count
118. 'PRINT #1, ShortByte; ","; LongData
119. 'ELSE
120. '    ShortByte = count
121. 'PRINT #1, ShortByte
122. 'END IF
123. 'ShortByte = 0 'reset the default count to 0
124. 'LOOP
125.  
126. 'free resources
127. 'CLOSE #1
128. '_MEMFREE m
129. ' Example by Petr
130.  
131. image = n '_LOADIMAGE(fle$, 32)
132. outfile$ = "databas.txt"
133. chan = FREEFILE
134. OPEN outfile$ FOR OUTPUT AS #chan 'but binary access is much faster than input / output mode
135. head$ = "DATA " + STR$(_WIDTH(image)) + "," + STR$(_HEIGHT(image))
136. PRINT #chan, head$
137.  
138.  
139. m = _MEMIMAGE(image)
140.  
141. FOR writeit = 0 TO _WIDTH(image) * _HEIGHT(image) * 4 - 4 STEP 4
142.     _MEMGET m, m.OFFSET + writeit, colors
143.     R = _RED32(colors): G = _GREEN32(colors): B = _BLUE32(colors)
144.     d$ = "DATA " + STR$(R) + "," + STR$(G) + "," + STR$(B)
145.     PRINT #chan, d$ '
146. NEXT
147. CLOSE #chan
148.  
149. LOCATE 23, 1
150. PRINT "Image saved as database.txt"
151.  
152. SUB MENU (S, TITLE$, L$, TEXT$)
153.  
154.     C0 = 0 ' Main window background pick:0-7
155.     C1 = 7 ' Color 2 (FG) pick:0-7
156.     C2 = 0 ' Color 1 (BG) pick:0-7
157.     C3 = 15 ' Typing color pick:0-15
158.     C4 = 12 ' Mistyped item color pick:0-15
159.     C5 = 9 ' Title color (TITLE$) pick:0-15
160.     C6 = 14 ' Description color (TEXT$) pick:0-15
161.  
162.     ORIGINAL = S
163.     SCREEN 0
164.     WIDTH 80, 25
165.     COLOR C1, C0
166.     CLS
167.  
168.     ' Display title.
169.     CENTER C5, 2, TITLE$
170.  
171.     ' Display description text.
172.     CENTER C6, 4, TEXT$
173.  
174.     REDIM C$(1 TO 250) ' <<< Array size may need to be modified.
175.  
176.     ' Split list into string array
177.     P = 1
178.     LL = 0 ' Longest line
179.     FOR I = 1 TO UBOUND(C$)
180.         F = P
181.         P = INSTR(P, L$, "|")
182.         IF P < 1 THEN P = 9999
183.         C$(I) = MID$(L$, F, P - F)
184.         IF LL < LEN(C$(I)) THEN LL = LEN(C$(I))
185.         IF P = 9999 THEN EXIT FOR
186.         P = P + 1
187.     NEXT I
188.  
189.     ' S   = Selected Item
190.     ' LL  = Longest line length
191.     MM = I ' MM  = Number of menu items
192.     W$ = "" ' W$  = User typed search text
193.     N = 0 ' N   = User typed search text found?
194.     F = 0 ' F   = Vertical Display Offset
195.     M = 8 ' M   = Number of menu items to display on screen
196.     TOP = 5 ' TOP = Top row where menu starts Y
197.     ' X   = Start printing menu at pos X
198.     X = 33 - FIX(LL / 2)
199.  
200.  
201.     ' Displays a menu on the screen, and allows the user to select
202.     ' one item from the list. L$ should contain the list of menu items
203.     ' separated by the | character. S will hold the number of the
204.     ' selected menu item. If S is 5 at the beginning, this means the
205.     ' 5th item on the list is selected by default. If the user picks
206.     ' a different menu item and presses Enter, then S will change.
207.     ' If the user presses ESC, ALT+X or ALT+F4, S will be -1.
208.     '
209.  
210.  
211.     DO
212.         ' Print menu items
213.         FOR I = 1 TO M
214.             Y = I * 2 + TOP
215.             IF S = I + F THEN
216.                 COLOR C2, C1
217.             ELSE
218.                 COLOR C1, C2
219.             END IF
220.             T$ = C$(I + F)
221.             LOCATE Y, X: PRINT SPACE$(5); T$; SPACE$(LL - LEN(T$) + 10);
222.         NEXT I
223.  
224.         ' Put lines or spaces among menu items
225.         FOR I = 1 TO M + 1
226.             IF S = I + F THEN
227.                 COLOR C1, C2
228.             ELSEIF S = I + F - 1 THEN
229.                 COLOR C2, C1
230.             ELSE
231.                 COLOR C2, C2
232.             END IF
233.             LOCATE I * 2 + TOP - 1, X: PRINT STRING$(LL + 15, CHR$(220));
234.         NEXT I
235.  
236.         ' Print search text
237.         IF N THEN COLOR C3, C2 ELSE COLOR C4, C2
238.         Z$ = LEFT$(W$, 40)
239.         LOCATE 24, 20: PRINT Z$; SPACE$(40 - LEN(Z$));
240.         IF LEN(W$) THEN LOCATE 24, 20 + LEN(Z$), 1, 12, 13 ELSE LOCATE 1, 1, 0
241.  
242.         K$ = "": WHILE K$ = "": K$ = INKEY$: WEND
243.  
244.         LOCATE 1, 1, 0 ' Turn off cursor
245.  
246.         ' Process search text
247.         N = 0
248.         IF LEN(K$) = 1 THEN
249.             U = ASC(UCASE$(K$))
250.             IF LEN(W$) AND K$ = CHR$(8) THEN ' BACKSPACE
251.                 W$ = LEFT$(W$, LEN(W$) - 1)
252.             ELSEIF U = 32 OR U > 64 AND U < 91 OR (U > 47 AND U < 58) THEN ' TYPING
253.                 W$ = W$ + K$
254.             END IF
255.             IF LEN(W$) THEN
256.                 FOR G = 1 TO UBOUND(C$) ' FIND ITEM
257.                     IF UCASE$(LEFT$(C$(G), LEN(W$))) = UCASE$(W$) THEN
258.                         N = 1
259.                         S = G
260.                         IF S < F OR S > F + M THEN
261.                             F = S - FIX(M / 2)
262.                             IF F < 0 THEN F = 0
263.                             IF F > MM - M THEN F = MM - M
264.                         END IF
265.                         EXIT FOR
266.                     END IF
267.                 NEXT G
268.             END IF
269.         END IF
270.  
271.         SELECT CASE K$
272.             CASE CHR$(0) + "G": ' HOME
273.                 W$ = ""
274.                 S = 1
275.                 F = 0
276.             CASE CHR$(0) + "O": ' END
277.                 W$ = ""
278.                 S = MM
279.                 F = MM - M
280.                 IF F < 0 THEN F = 0
281.             CASE CHR$(0) + "I": ' PGUP
282.                 W$ = ""
283.                 S = S - M
284.                 F = F - M
285.                 IF S < 1 THEN S = 1
286.                 IF F < 0 THEN F = 0
287.             CASE CHR$(0) + "Q": ' PGDN
288.                 W$ = ""
289.                 S = S + M
290.                 F = F + M
291.                 IF S > MM THEN S = MM
292.                 IF F > MM - M THEN F = MM - M
293.                 IF F < 0 THEN F = 0
294.             CASE CHR$(0) + "H": ' UP ARROW
295.                 W$ = ""
296.                 IF S > 1 THEN
297.                     S = S - 1
298.                     IF S <= F THEN F = F - 1
299.                 END IF
300.             CASE CHR$(0) + "P": ' DOWN ARROW
301.                 W$ = ""
302.                 IF S < MM THEN
303.                     S = S + 1
304.                     IF S >= F + I - 1 THEN F = F + 1
305.                 END IF
306.             CASE CHR$(13): EXIT DO ' ENTER
307.             CASE CHR$(0) + "K": EXIT DO ' LEFT ARROW
308.             CASE CHR$(0) + "M": EXIT DO ' RIGHT ARROW
309.             CASE CHR$(0) + "-": S = -1: EXIT DO ' ALT-X
310.             CASE CHR$(0) + "k": S = -1: EXIT DO ' ALT-F4
311.             CASE CHR$(27): S = -1: EXIT DO ' ESC
312.         END SELECT
313.     LOOP
314.  
315.     ERASE C$
316.     COLOR 7, 0
317.     CLS
318.  
319. END SUB
320.  
321. ' Prints some text in the middle of the screen.
322. ' We're assuming 80x25 color text mode.
323. SUB CENTER (TEXTCOLOR, ROW, TEXT$)
324.     COLOR TEXTCOLOR
325.     LOCATE ROW, 40 - FIX(LEN(TEXT$) / 2): PRINT TEXT$;
326. END SUB
327.  
328. ' This function returns the Nth word from a list.
329. ' Words must be separated by the separator character S.
330. ' S must hold the ASCII value of the character to be
331. ' used as a separator character. i.e. S=32 means space
332. ' Example:
333. '    GETWORD$("apples peaches kiwi grapes", 1, 32) -> "apples"
334. '    GETWORD$("apples/peaches/kiwi/grapes", 3, 47) -> "kiwi"
335. '    GETWORD$("apples+peaches+kiwi+grapes", 9, 43) -> "" (out of range)
336. '
337. FUNCTION GETWORD$ (L$, N, S)
338.     LL = LEN(L$)
339.     IF N < 1 OR N > LL / 2 + 2 THEN GETWORD$ = "": EXIT FUNCTION
340.     W = 0
341.     F = 0
342.     FOR I = 1 TO LL + 1
343.         IF I > LL THEN C = S ELSE C = ASC(MID$(L$, I, 1))
344.         IF C = S THEN
345.             IF F AND W = N THEN
346.                 GETWORD$ = MID$(L$, F, I - F)
347.                 EXIT FUNCTION
348.             END IF
349.             F = 0
350.         ELSE
351.             IF F = 0 THEN F = I: W = W + 1
352.         END IF
353.     NEXT I
354.     GETWORD$ = ""
355. END FUNCTION
356.  
357.  

[Petr]

Try it. Memory out of range occured because writeit was not declared as long (or unsigned long) type:

I test not output file, if all pixels are writed correctly.

Code: QB64: [Select]

1.  
2. DIM fil$(255)
3. DIM colors AS _UNSIGNED LONG, m AS _MEM
4. 'DIM m AS _MEM
5. CLS
6. SHELL _HIDE "dir/b *.jpg > list.txt"
7. SHELL _HIDE "dir/b *.png >> list.txt"
8. SHELL _HIDE "dir/b *.bmp >> list.txt"
9. SHELL _HIDE "dir/b *.gif >> list.txt"
10. OPEN "list.txt" FOR INPUT AS #1
11. a = 0
12. DO
13.     a = a + 1
14.     IF NOT (EOF(1)) THEN INPUT #1, fil$(a) ELSE SYSTEM
15.     list$ = list$ + fil$(a) + "|"
16. LOOP UNTIL EOF(1)
17. CLOSE #1
18. '
19. ' Originally: COUNTRY.BAS
20. ' This program asks the user to select his country from a list.
21. ' The user may press the UP and DOWN arrows or PAGE UP/PAGE DOWN
22. ' or HOME/END keys to navigate the menu. The user may also start
23. ' typing the name of his country to find it faster.
24. '
25. ' Written by Zsolt Nagy-Perge in October 2018, Pensacola, Fla.
26. ' <zsolt500n@gmail.com>
27. '
28. ' Code adapted in file selector for loadimg.bas by Jason Page
29. ' December 2018. This program generates a file containing
30. ' all the pset commands needed to generate any image you put
31. ' in the program. This is ideal to generate images using for
32. ' example wwwbasic. This program will only work and compile
33. ' using QB64. Visit QB64.org to use the free compiler/IDE
34. ' <pagetelegram@gmail.com>
35. '
36. ' QBasic 1.1 source code:
37. '
38. DEFINT A-Z
39. DECLARE SUB CENTER (TEXTCOLOR, ROW, TEXT$)
40. DECLARE SUB MENU (S, TITLE$, L$, TEXT$)
41. DECLARE FUNCTION GETWORD$ (L$, N, S)
42.  
43. SELECTED = 3
44. 'list$ = "United States of America|Mexico|Canada|United Kingdom|Australia|Afghanistan|Albania|Algeria|Andorra|Angola|Anguilla|Antigua and Barbuda|Argentina|Armenia|Aruba|Austria|Azerbaijan|Bahamas|Bahrain|Bangladesh|Barbados|Belarus|Belgium|Belize|Benin|Bermuda|Bhutan|Bolivia|Bonaire|Bosnia and Herzegovina|Botswana|Brazil|British Virgin Islands|Brunei|Bulgaria|Burkina Faso|Burundi|Cabo Verde|Cambodia|Cameroon|Cayman Islands|Central African Republic|Chad|Chile|China|Clipperton Island|Colombia|Comoros|Costa Rica|Cote d'Ivoire|Croatia|Cuba|Curacao|Cyprus|Czech Republic|Democratic Republic of the Congo|Denmark|Djibouti|Dominica|Dominican Republic|Ecuador|Egypt|El Salvador|Equatorial Guinea|Eritrea|Estonia|Ethiopia|Fiji|Finland|France|French Polynesia|Gabon|Gambia|Georgia|Germany|Ghana|Greece|Greenland|Grenada|Guadeloupe|Guatemala|Guinea|Guinea-Bissau|Guyana|Haiti|Honduras|Hungary|Iceland|India|Indonesia|Iran|Iraq|Ireland|Israel|Italy|Jamaica|Japan|Jordan|Kazakhstan|Kenya|Kiribati|Kosovo|Kuwait|Kyrgyzstan|Laos|Latvia|Lebanon|Lesotho|Liberia|Libya|Liechtenstein|Lithuania|Luxembourg|Macedonia (FYROM)|Madagascar|Malawi|Malaysia|Maldives|Mali|Malta|Marshall Islands|Martinique|Mauritania|Mauritius|Micronesia|Moldova|Monaco|Mongolia|Montenegro|Montserrat|Morocco|Mozambique|Myanmar (Burma)|Namibia|Nauru|Navassa Island|Nepal|Netherlands|New Zealand|Nicaragua|Niger|Nigeria|North Korea|Norway|Oman|Pakistan|Palau|Palestine|Panama|Papua New Guinea|Paraguay|Peru|Philippines|Poland|Portugal|Puerto Rico|Qatar|Republic of the Congo|Romania|Russia|Rwanda|Saba|Saint Barthelemy|Saint Kitts and Nevis|Saint Lucia|Saint Martin|Saint Pierre and Miquelon|Saint Vincent and the Grenadines|Samoa|San Marino|Sao Tome and Principe|Saudi Arabia|Senegal|Serbia|Seychelles|Sierra Leone|Singapore|Sint Eustatius|Sint Maarten|Slovakia|Slovenia|Solomon Islands|Somalia|South Africa|South Korea|South Sudan|Spain|Sri Lanka|Sudan|Suriname|Swaziland|Sweden|Switzerland|Syria|Taiwan|Tajikistan|Tanzania|Thailand|Timor-Leste|Togo|Tonga|Trinidad and Tobago|Tunisia|Turkey|Turkmenistan|Turks and Caicos Islands|Tuvalu|Uganda|Ukraine|United Arab Emirates|Uruguay|US Virgin Islands|Uzbekistan|Vanuatu|Vatican City|Venezuela|Vietnam|Yemen|Zambia|Zimbabwe"
45. MENU SELECTED, "Files", list$, "Please select your image file from the list below:"
46.  
47. CENTER 15, 10, "You picked :    " + GETWORD$(list$, SELECTED, 124)
48. fle$ = GETWORD$(list$, SELECTED, 124)
49.  
50. SCREEN _NEWIMAGE(640, 480, 32)
51.  
52. 'img& = _LOADIMAGE(fle$, 32) 'load the image file to be drawn
53.  
54. n = _LOADIMAGE(fle$, 32)
55. m = _MEMIMAGE(n) 'screen memory of image
56.  
57. 'wide% = _WIDTH(img&): deep% = _HEIGHT(img&)
58. 'TLC$ = "BL" + STR$(wide% \ 2) + "BU" + STR$(deep% \ 2) 'start draw at top left corner
59. 'RET$ = "BD BL" + STR$(wide%) 'return to left side of image
60. '_SOURCE img&
61. '_DEST 0
62. 'SHELL "echo. > pset.txt"
63. 'OPEN "pset.txt" FOR OUTPUT AS #2
64. 'CLS
65. 'Tmp& = _NEWIMAGE(32, 32, 256)
66. 'DO
67. '    x = x + 1
68. 'IF x > wide% THEN
69. 'x = 0: y = y + 1
70. 'END IF
71. 'DRAW "C" + STR$(POINT(x, y)) + "R1" 'color and DRAW each pixel
72. '
73. 'colour~& = POINT(x, y)
74. 'c% = _RGB(_RED32(colour~&), _GREEN32(colour~&), _BLUE32(colour~&), Tmp&)
75. 'clr = (c%) 'POINT(x, y) / (16553 * 256 * 16 * 8)
76. 'x$ = STR$(x)
77. 'y$ = STR$(y)
78. 'clr$ = STR$(clr)
79. 'PRINT #2, "pset(" + x$ + CHR$(44) + y$ + ")" + CHR$(44) + clr$
80. 'LOCATE 2, 1: PRINT x, y
81. 'PSET (x, y), clr
82.  
83. 'LOOP UNTIL y >= deep%
84. 'CLOSE #2
85. 'LOCATE 22, 1
86. 'PRINT "Saved as pset.txt"
87. 'SLEEP 1
88.  
89. ' Steve Contrib (SMcNeill):
90.  
91. 'DIM c AS _UNSIGNED LONG 'color value of the pixels
92. 'DIM ShortByte AS _UNSIGNED _BYTE, LongData AS _UNSIGNED LONG
93. 'ShortByte = 0
94. SHELL _HIDE "echo. > databas.txt"
95. ''open  a file for saving
96. 'OPEN "databas.txt" FOR OUTPUT AS #1
97.  
98.  
99. 'DO UNTIL finished
100. 'count = 1 'count is the count of repetitive times a color appears in a row
101. '_MEMGET m, m.OFFSET + p * 4, c 'p is the current point
102. 'IF p >= m.SIZE THEN
103. '    finished = -1
104. 'ELSE
105. '    IF (p + count) * 4 >= m.SIZE THEN
106. '    finished = -1
107. 'ELSE
108. '    DO UNTIL _MEMGET(m, m.OFFSET + (p + count) * 4, _UNSIGNED LONG) <> c
109. '    count = count + 1
110. '    IF (p + count) * 4 >= m.SIZE THEN finished = -1: count = count - 1: EXIT DO
111. 'LOOP
112. 'END IF
113. 'END IF
114. 'p = p + count
115. 'r = _RED32(c): g = _GREEN32(c): b = _BLUE32(c)
116. 'PRINT #1, "DATA "; r; ","; g; ","; b; ",";
117. 'IF count > 255 THEN
118. '    LongData = count
119. 'PRINT #1, ShortByte; ","; LongData
120. 'ELSE
121. '    ShortByte = count
122. 'PRINT #1, ShortByte
123. 'END IF
124. 'ShortByte = 0 'reset the default count to 0
125. 'LOOP
126.  
127. 'free resources
128. 'CLOSE #1
129. '_MEMFREE m
130. ' Example by Petr
131.  
132. REM image = n '_LOADIMAGE(fle$, 32)
133. outfile$ = "databas.txt"
134. chan = FREEFILE
135. OPEN outfile$ FOR OUTPUT AS #chan 'but binary access is much faster than input / output mode
136. head$ = "DATA " + STR$(_WIDTH(image)) + "," + STR$(_HEIGHT(image))
137. PRINT #chan, head$
138.  
139.  
140. m = _MEMIMAGE(n) '                                                            repaired
141. DIM writeit AS LONG '                                                         repaired
142. FOR writeit = 0 TO _WIDTH(n) * _HEIGHT(n) * 4 - 4 STEP 4 '                    repaired
143.     _MEMGET m, m.OFFSET + writeit, colors
144.     R = _RED32(colors): G = _GREEN32(colors): B = _BLUE32(colors)
145.     d$ = "DATA " + STR$(R) + "," + STR$(G) + "," + STR$(B)
146.     PRINT #chan, d$ '
147. NEXT
148. CLOSE #chan
149.  
150. LOCATE 23, 1
151. PRINT "Image saved as database.txt"
152.  
153. SUB MENU (S, TITLE$, L$, TEXT$)
154.  
155.     C0 = 0 ' Main window background pick:0-7
156.     C1 = 7 ' Color 2 (FG) pick:0-7
157.     C2 = 0 ' Color 1 (BG) pick:0-7
158.     C3 = 15 ' Typing color pick:0-15
159.     C4 = 12 ' Mistyped item color pick:0-15
160.     C5 = 9 ' Title color (TITLE$) pick:0-15
161.     C6 = 14 ' Description color (TEXT$) pick:0-15
162.  
163.     ORIGINAL = S
164.     SCREEN 0
165.     WIDTH 80, 25
166.     COLOR C1, C0
167.     CLS
168.  
169.     ' Display title.
170.     CENTER C5, 2, TITLE$
171.  
172.     ' Display description text.
173.     CENTER C6, 4, TEXT$
174.  
175.     REDIM C$(1 TO 250) ' <<< Array size may need to be modified.
176.  
177.     ' Split list into string array
178.     P = 1
179.     LL = 0 ' Longest line
180.     FOR I = 1 TO UBOUND(C$)
181.         F = P
182.         P = INSTR(P, L$, "|")
183.         IF P < 1 THEN P = 9999
184.         C$(I) = MID$(L$, F, P - F)
185.         IF LL < LEN(C$(I)) THEN LL = LEN(C$(I))
186.         IF P = 9999 THEN EXIT FOR
187.         P = P + 1
188.     NEXT I
189.  
190.     ' S   = Selected Item
191.     ' LL  = Longest line length
192.     MM = I ' MM  = Number of menu items
193.     W$ = "" ' W$  = User typed search text
194.     N = 0 ' N   = User typed search text found?
195.     F = 0 ' F   = Vertical Display Offset
196.     M = 8 ' M   = Number of menu items to display on screen
197.     TOP = 5 ' TOP = Top row where menu starts Y
198.     ' X   = Start printing menu at pos X
199.     X = 33 - FIX(LL / 2)
200.  
201.  
202.     ' Displays a menu on the screen, and allows the user to select
203.     ' one item from the list. L$ should contain the list of menu items
204.     ' separated by the | character. S will hold the number of the
205.     ' selected menu item. If S is 5 at the beginning, this means the
206.     ' 5th item on the list is selected by default. If the user picks
207.     ' a different menu item and presses Enter, then S will change.
208.     ' If the user presses ESC, ALT+X or ALT+F4, S will be -1.
209.     '
210.  
211.  
212.     DO
213.         ' Print menu items
214.         FOR I = 1 TO M
215.             Y = I * 2 + TOP
216.             IF S = I + F THEN
217.                 COLOR C2, C1
218.             ELSE
219.                 COLOR C1, C2
220.             END IF
221.             T$ = C$(I + F)
222.             LOCATE Y, X: PRINT SPACE$(5); T$; SPACE$(LL - LEN(T$) + 10);
223.         NEXT I
224.  
225.         ' Put lines or spaces among menu items
226.         FOR I = 1 TO M + 1
227.             IF S = I + F THEN
228.                 COLOR C1, C2
229.             ELSEIF S = I + F - 1 THEN
230.                 COLOR C2, C1
231.             ELSE
232.                 COLOR C2, C2
233.             END IF
234.             LOCATE I * 2 + TOP - 1, X: PRINT STRING$(LL + 15, CHR$(220));
235.         NEXT I
236.  
237.         ' Print search text
238.         IF N THEN COLOR C3, C2 ELSE COLOR C4, C2
239.         Z$ = LEFT$(W$, 40)
240.         LOCATE 24, 20: PRINT Z$; SPACE$(40 - LEN(Z$));
241.         IF LEN(W$) THEN LOCATE 24, 20 + LEN(Z$), 1, 12, 13 ELSE LOCATE 1, 1, 0
242.  
243.         K$ = "": WHILE K$ = "": K$ = INKEY$: WEND
244.  
245.         LOCATE 1, 1, 0 ' Turn off cursor
246.  
247.         ' Process search text
248.         N = 0
249.         IF LEN(K$) = 1 THEN
250.             U = ASC(UCASE$(K$))
251.             IF LEN(W$) AND K$ = CHR$(8) THEN ' BACKSPACE
252.                 W$ = LEFT$(W$, LEN(W$) - 1)
253.             ELSEIF U = 32 OR U > 64 AND U < 91 OR (U > 47 AND U < 58) THEN ' TYPING
254.                 W$ = W$ + K$
255.             END IF
256.             IF LEN(W$) THEN
257.                 FOR G = 1 TO UBOUND(C$) ' FIND ITEM
258.                     IF UCASE$(LEFT$(C$(G), LEN(W$))) = UCASE$(W$) THEN
259.                         N = 1
260.                         S = G
261.                         IF S < F OR S > F + M THEN
262.                             F = S - FIX(M / 2)
263.                             IF F < 0 THEN F = 0
264.                             IF F > MM - M THEN F = MM - M
265.                         END IF
266.                         EXIT FOR
267.                     END IF
268.                 NEXT G
269.             END IF
270.         END IF
271.  
272.         SELECT CASE K$
273.             CASE CHR$(0) + "G": ' HOME
274.                 W$ = ""
275.                 S = 1
276.                 F = 0
277.             CASE CHR$(0) + "O": ' END
278.                 W$ = ""
279.                 S = MM
280.                 F = MM - M
281.                 IF F < 0 THEN F = 0
282.             CASE CHR$(0) + "I": ' PGUP
283.                 W$ = ""
284.                 S = S - M
285.                 F = F - M
286.                 IF S < 1 THEN S = 1
287.                 IF F < 0 THEN F = 0
288.             CASE CHR$(0) + "Q": ' PGDN
289.                 W$ = ""
290.                 S = S + M
291.                 F = F + M
292.                 IF S > MM THEN S = MM
293.                 IF F > MM - M THEN F = MM - M
294.                 IF F < 0 THEN F = 0
295.             CASE CHR$(0) + "H": ' UP ARROW
296.                 W$ = ""
297.                 IF S > 1 THEN
298.                     S = S - 1
299.                     IF S <= F THEN F = F - 1
300.                 END IF
301.             CASE CHR$(0) + "P": ' DOWN ARROW
302.                 W$ = ""
303.                 IF S < MM THEN
304.                     S = S + 1
305.                     IF S >= F + I - 1 THEN F = F + 1
306.                 END IF
307.             CASE CHR$(13): EXIT DO ' ENTER
308.             CASE CHR$(0) + "K": EXIT DO ' LEFT ARROW
309.             CASE CHR$(0) + "M": EXIT DO ' RIGHT ARROW
310.             CASE CHR$(0) + "-": S = -1: EXIT DO ' ALT-X
311.             CASE CHR$(0) + "k": S = -1: EXIT DO ' ALT-F4
312.             CASE CHR$(27): S = -1: EXIT DO ' ESC
313.         END SELECT
314.     LOOP
315.  
316.     ERASE C$
317.     COLOR 7, 0
318.     CLS
319.  
320. END SUB
321.  
322. ' Prints some text in the middle of the screen.
323. ' We're assuming 80x25 color text mode.
324. SUB CENTER (TEXTCOLOR, ROW, TEXT$)
325.     COLOR TEXTCOLOR
326.     LOCATE ROW, 40 - FIX(LEN(TEXT$) / 2): PRINT TEXT$;
327. END SUB
328.  
329. ' This function returns the Nth word from a list.
330. ' Words must be separated by the separator character S.
331. ' S must hold the ASCII value of the character to be
332. ' used as a separator character. i.e. S=32 means space
333. ' Example:
334. '    GETWORD$("apples peaches kiwi grapes", 1, 32) -> "apples"
335. '    GETWORD$("apples/peaches/kiwi/grapes", 3, 47) -> "kiwi"
336. '    GETWORD$("apples+peaches+kiwi+grapes", 9, 43) -> "" (out of range)
337. '
338. FUNCTION GETWORD$ (L$, N, S)
339.     LL = LEN(L$)
340.     IF N < 1 OR N > LL / 2 + 2 THEN GETWORD$ = "": EXIT FUNCTION
341.     W = 0
342.     F = 0
343.     FOR I = 1 TO LL + 1
344.         IF I > LL THEN C = S ELSE C = ASC(MID$(L$, I, 1))
345.         IF C = S THEN
346.             IF F AND W = N THEN
347.                 GETWORD$ = MID$(L$, F, I - F)
348.                 EXIT FUNCTION
349.             END IF
350.             F = 0
351.         ELSE
352.             IF F = 0 THEN F = I: W = W + 1
353.         END IF
354.     NEXT I
355.     GETWORD$ = ""
356. END FUNCTION
357.  
358.  

[SMcNeill]

And, if _MEMGET is being too big a PITA to deal with, you can use POINT for the end same result in this case.

DIM m AS _MEM
m = _MEMIMAGE(imagehandle)

All this does is give us direct access to the image as it’s stored in memory.  Work with it just the same as you would a BINARY FILE...

Imagine us doing this, instead:

OPEN “Internal_Image_Memory” FOR BINARY AS #1
DO UNTIL EOF(1)
    GET #1, ,Sequential_Color_Values
    ‘Do stuff with those values
LOOP

And that’s basically all we do with MEM.

DIM m AS _MEM ‘declare a variable for memory reference
m = _MEMIMAGE(imagehandle) ‘point it at the spot in memory where the image resides

Now, look at _MEMGET: _MEMGET (which MEM variable, what starting byte, what type)

And to compare to GET:  GET (which file, what starting byte, what type)


If you can use a file OPEN... FOR BINARY, you already know how to use MEM.


BUT.... You don’t *have* to.  It’s just faster.

_MEMGET (m, m.OFFSET, color_variable) is the exact same as color_variable = POINT 0,0)

_MEMGET (m, m.OFFSET + pixelsize, color_variable) is the same as color_variable = POINT(0, 0 + 1) — It’s just the next pixel to the right.

MEMGET (m, m.OFFSET + pixelsize * 10, color_variable) is the same as color_variable = POINT(0, 0 + 10)


We’re just using _MEMGET for the speed of direct memory access, but POINT can do the same job easily enough.  Just a little slower.  ;)

[_vince]

I think the most compact way of storing an image in code without any compression, DATA, base64, - anything requiring loading code is a 64bit integer array defined with hex numbers: a(342)=&hfafadbdb5555111 to be used with a single PUT statement