Author Topic: Convert image content to PSET expressions....  (Read 10497 times)

0 Members and 1 Guest are viewing this topic.

Offline pagetelegram

  • Newbie
  • Posts: 24
  • "werd" - meaning mutual consensus or understanding
    • View Profile
    • Page Telegram
Re: Convert image content to PSET expressions....
« Reply #15 on: December 17, 2018, 10:06:58 pm »
Thank you!

I'll post final code and wwwbasic template example once I get it all working.
Page Telegram
<PageTelegram.com>
Document Writing
Author and Philanthropist
BBM: PT0433
Books at https://www.amazon.com/Jason-S-Page/e/B071RS8C2F/

Offline pagetelegram

  • Newbie
  • Posts: 24
  • "werd" - meaning mutual consensus or understanding
    • View Profile
    • Page Telegram
Re: Convert image content to PSET expressions....
« Reply #16 on: December 17, 2018, 10:59:35 pm »
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 m AS _MEM
  3. SHELL _HIDE "dir/b *.jpg > list.txt"
  4. SHELL _HIDE "dir/b *.png >> list.txt"
  5. SHELL _HIDE "dir/b *.bmp >> list.txt"
  6. SHELL _HIDE "dir/b *.gif >> list.txt"
  7. OPEN "list.txt" FOR INPUT AS #1
  8. a = 0
  9.     a = a + 1
  10.     IF NOT (EOF(1)) THEN INPUT #1, fil$(a) ELSE SYSTEM
  11.     list$ = list$ + fil$(a) + "|"
  12. '
  13. ' Originally: COUNTRY.BAS
  14. ' This program asks the user to select his country from a list.
  15. ' The user may press the UP and DOWN arrows or PAGE UP/PAGE DOWN
  16. ' or HOME/END keys to navigate the menu. The user may also start
  17. ' typing the name of his country to find it faster.
  18. '
  19. ' Written by Zsolt Nagy-Perge in October 2018, Pensacola, Fla.
  20. ' <zsolt500n@gmail.com>
  21. '
  22. ' Code adapted in file selector for loadimg.bas by Jason Page
  23. ' December 2018. This program generates a file containing
  24. ' all the pset commands needed to generate any image you put
  25. ' in the program. This is ideal to generate images using for
  26. ' example wwwbasic. This program will only work and compile
  27. ' using QB64. Visit QB64.org to use the free compiler/IDE
  28. ' <pagetelegram@gmail.com>
  29. '
  30. ' QBasic 1.1 source code:
  31. '
  32. DEFINT A-Z
  33. DECLARE SUB CENTER (TEXTCOLOR, ROW, TEXT$)
  34. DECLARE SUB MENU (S, TITLE$, L$, TEXT$)
  35. DECLARE FUNCTION GETWORD$ (L$, N, S)
  36.  
  37. SELECTED = 3
  38. '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"
  39. MENU SELECTED, "Files", list$, "Please select your image file from the list below:"
  40.  
  41. CENTER 15, 10, "You picked :    " + GETWORD$(list$, SELECTED, 124)
  42. fle$ = GETWORD$(list$, SELECTED, 124)
  43.  
  44. SCREEN _NEWIMAGE(640, 480, 32)
  45.  
  46. 'img& = _LOADIMAGE(fle$, 32) 'load the image file to be drawn
  47.  
  48. n = _LOADIMAGE(fle$, 32)
  49. m = _MEMIMAGE(n) 'screen memory of image
  50.  
  51. 'wide% = _WIDTH(img&): deep% = _HEIGHT(img&)
  52. 'TLC$ = "BL" + STR$(wide% \ 2) + "BU" + STR$(deep% \ 2) 'start draw at top left corner
  53. 'RET$ = "BD BL" + STR$(wide%) 'return to left side of image
  54. '_SOURCE img&
  55. '_DEST 0
  56. 'SHELL "echo. > pset.txt"
  57. 'OPEN "pset.txt" FOR OUTPUT AS #2
  58. 'CLS
  59. 'Tmp& = _NEWIMAGE(32, 32, 256)
  60. 'DO
  61. '    x = x + 1
  62. 'IF x > wide% THEN
  63. 'x = 0: y = y + 1
  64. 'END IF
  65. 'DRAW "C" + STR$(POINT(x, y)) + "R1" 'color and DRAW each pixel
  66. '
  67. 'colour~& = POINT(x, y)
  68. 'c% = _RGB(_RED32(colour~&), _GREEN32(colour~&), _BLUE32(colour~&), Tmp&)
  69. 'clr = (c%) 'POINT(x, y) / (16553 * 256 * 16 * 8)
  70. 'x$ = STR$(x)
  71. 'y$ = STR$(y)
  72. 'clr$ = STR$(clr)
  73. 'PRINT #2, "pset(" + x$ + CHR$(44) + y$ + ")" + CHR$(44) + clr$
  74. 'LOCATE 2, 1: PRINT x, y
  75. 'PSET (x, y), clr
  76.  
  77. 'LOOP UNTIL y >= deep%
  78. 'CLOSE #2
  79. 'LOCATE 22, 1
  80. 'PRINT "Saved as pset.txt"
  81. 'SLEEP 1
  82.  
  83. ' Steve Contrib (SMcNeill):
  84.  
  85. 'DIM c AS _UNSIGNED LONG 'color value of the pixels
  86. 'DIM ShortByte AS _UNSIGNED _BYTE, LongData AS _UNSIGNED LONG
  87. 'ShortByte = 0
  88. SHELL _HIDE "echo. > databas.txt"
  89. ''open  a file for saving
  90. 'OPEN "databas.txt" FOR OUTPUT AS #1
  91.  
  92.  
  93. 'DO UNTIL finished
  94. 'count = 1 'count is the count of repetitive times a color appears in a row
  95. '_MEMGET m, m.OFFSET + p * 4, c 'p is the current point
  96. 'IF p >= m.SIZE THEN
  97. '    finished = -1
  98. 'ELSE
  99. '    IF (p + count) * 4 >= m.SIZE THEN
  100. '    finished = -1
  101. 'ELSE
  102. '    DO UNTIL _MEMGET(m, m.OFFSET + (p + count) * 4, _UNSIGNED LONG) <> c
  103. '    count = count + 1
  104. '    IF (p + count) * 4 >= m.SIZE THEN finished = -1: count = count - 1: EXIT DO
  105. 'LOOP
  106. 'END IF
  107. 'END IF
  108. 'p = p + count
  109. 'r = _RED32(c): g = _GREEN32(c): b = _BLUE32(c)
  110. 'PRINT #1, "DATA "; r; ","; g; ","; b; ",";
  111. 'IF count > 255 THEN
  112. '    LongData = count
  113. 'PRINT #1, ShortByte; ","; LongData
  114. 'ELSE
  115. '    ShortByte = count
  116. 'PRINT #1, ShortByte
  117. 'END IF
  118. 'ShortByte = 0 'reset the default count to 0
  119. 'LOOP
  120.  
  121. 'free resources
  122. 'CLOSE #1
  123. '_MEMFREE m
  124. ' Example by Petr
  125.  
  126. image = n '_LOADIMAGE(fle$, 32)
  127. outfile$ = "databas.txt"
  128. chan = FREEFILE
  129. OPEN outfile$ FOR OUTPUT AS #chan 'but binary access is much faster than input / output mode
  130. head$ = "DATA " + STR$(_WIDTH(image)) + "," + STR$(_HEIGHT(image))
  131. PRINT #chan, head$
  132.  
  133.  
  134. m = _MEMIMAGE(image)
  135.  
  136. FOR writeit = 0 TO _WIDTH(image) * _HEIGHT(image) * 4 - 4 STEP 4
  137.     _MEMGET m, m.OFFSET + writeit, colors
  138.     R = _RED32(colors): G = _GREEN32(colors): B = _BLUE32(colors)
  139.     d$ = "DATA " + STR$(R) + "," + STR$(G) + "," + STR$(B)
  140.     PRINT #chan, d$ '
  141. CLOSE #chan
  142.  
  143. LOCATE 23, 1
  144. PRINT "Image saved as database.txt"
  145.  
  146. SUB MENU (S, TITLE$, L$, TEXT$)
  147.  
  148.     C0 = 0 ' Main window background pick:0-7
  149.     C1 = 7 ' Color 2 (FG) pick:0-7
  150.     C2 = 0 ' Color 1 (BG) pick:0-7
  151.     C3 = 15 ' Typing color pick:0-15
  152.     C4 = 12 ' Mistyped item color pick:0-15
  153.     C5 = 9 ' Title color (TITLE$) pick:0-15
  154.     C6 = 14 ' Description color (TEXT$) pick:0-15
  155.  
  156.     ORIGINAL = S
  157.     SCREEN 0
  158.     WIDTH 80, 25
  159.     COLOR C1, C0
  160.     CLS
  161.  
  162.     ' Display title.
  163.     CENTER C5, 2, TITLE$
  164.  
  165.     ' Display description text.
  166.     CENTER C6, 4, TEXT$
  167.  
  168.     REDIM C$(1 TO 250) ' <<< Array size may need to be modified.
  169.  
  170.     ' Split list into string array
  171.     P = 1
  172.     LL = 0 ' Longest line
  173.     FOR I = 1 TO UBOUND(C$)
  174.         F = P
  175.         P = INSTR(P, L$, "|")
  176.         IF P < 1 THEN P = 9999
  177.         C$(I) = MID$(L$, F, P - F)
  178.         IF LL < LEN(C$(I)) THEN LL = LEN(C$(I))
  179.         IF P = 9999 THEN EXIT FOR
  180.         P = P + 1
  181.     NEXT I
  182.  
  183.     ' S   = Selected Item
  184.     ' LL  = Longest line length
  185.     MM = I ' MM  = Number of menu items
  186.     W$ = "" ' W$  = User typed search text
  187.     N = 0 ' N   = User typed search text found?
  188.     F = 0 ' F   = Vertical Display Offset
  189.     M = 8 ' M   = Number of menu items to display on screen
  190.     TOP = 5 ' TOP = Top row where menu starts Y
  191.     ' X   = Start printing menu at pos X
  192.     X = 33 - FIX(LL / 2)
  193.  
  194.  
  195.     ' Displays a menu on the screen, and allows the user to select
  196.     ' one item from the list. L$ should contain the list of menu items
  197.     ' separated by the | character. S will hold the number of the
  198.     ' selected menu item. If S is 5 at the beginning, this means the
  199.     ' 5th item on the list is selected by default. If the user picks
  200.     ' a different menu item and presses Enter, then S will change.
  201.     ' If the user presses ESC, ALT+X or ALT+F4, S will be -1.
  202.     '
  203.  
  204.  
  205.     DO
  206.         ' Print menu items
  207.         FOR I = 1 TO M
  208.             Y = I * 2 + TOP
  209.             IF S = I + F THEN
  210.                 COLOR C2, C1
  211.             ELSE
  212.                 COLOR C1, C2
  213.             END IF
  214.             T$ = C$(I + F)
  215.             LOCATE Y, X: PRINT SPACE$(5); T$; SPACE$(LL - LEN(T$) + 10);
  216.         NEXT I
  217.  
  218.         ' Put lines or spaces among menu items
  219.         FOR I = 1 TO M + 1
  220.             IF S = I + F THEN
  221.                 COLOR C1, C2
  222.             ELSEIF S = I + F - 1 THEN
  223.                 COLOR C2, C1
  224.             ELSE
  225.                 COLOR C2, C2
  226.             END IF
  227.             LOCATE I * 2 + TOP - 1, X: PRINT STRING$(LL + 15, CHR$(220));
  228.         NEXT I
  229.  
  230.         ' Print search text
  231.         IF N THEN COLOR C3, C2 ELSE COLOR C4, C2
  232.         Z$ = LEFT$(W$, 40)
  233.         LOCATE 24, 20: PRINT Z$; SPACE$(40 - LEN(Z$));
  234.         IF LEN(W$) THEN LOCATE 24, 20 + LEN(Z$), 1, 12, 13 ELSE LOCATE 1, 1, 0
  235.  
  236.         K$ = "": WHILE K$ = "": K$ = INKEY$: WEND
  237.  
  238.         LOCATE 1, 1, 0 ' Turn off cursor
  239.  
  240.         ' Process search text
  241.         N = 0
  242.         IF LEN(K$) = 1 THEN
  243.             U = ASC(UCASE$(K$))
  244.             IF LEN(W$) AND K$ = CHR$(8) THEN ' BACKSPACE
  245.                 W$ = LEFT$(W$, LEN(W$) - 1)
  246.             ELSEIF U = 32 OR U > 64 AND U < 91 OR (U > 47 AND U < 58) THEN ' TYPING
  247.                 W$ = W$ + K$
  248.             END IF
  249.             IF LEN(W$) THEN
  250.                 FOR G = 1 TO UBOUND(C$) ' FIND ITEM
  251.                     IF UCASE$(LEFT$(C$(G), LEN(W$))) = UCASE$(W$) THEN
  252.                         N = 1
  253.                         S = G
  254.                         IF S < F OR S > F + M THEN
  255.                             F = S - FIX(M / 2)
  256.                             IF F < 0 THEN F = 0
  257.                             IF F > MM - M THEN F = MM - M
  258.                         END IF
  259.                         EXIT FOR
  260.                     END IF
  261.                 NEXT G
  262.             END IF
  263.         END IF
  264.  
  265.         SELECT CASE K$
  266.             CASE CHR$(0) + "G": ' HOME
  267.                 W$ = ""
  268.                 S = 1
  269.                 F = 0
  270.             CASE CHR$(0) + "O": ' END
  271.                 W$ = ""
  272.                 S = MM
  273.                 F = MM - M
  274.                 IF F < 0 THEN F = 0
  275.             CASE CHR$(0) + "I": ' PGUP
  276.                 W$ = ""
  277.                 S = S - M
  278.                 F = F - M
  279.                 IF S < 1 THEN S = 1
  280.                 IF F < 0 THEN F = 0
  281.             CASE CHR$(0) + "Q": ' PGDN
  282.                 W$ = ""
  283.                 S = S + M
  284.                 F = F + M
  285.                 IF S > MM THEN S = MM
  286.                 IF F > MM - M THEN F = MM - M
  287.                 IF F < 0 THEN F = 0
  288.             CASE CHR$(0) + "H": ' UP ARROW
  289.                 W$ = ""
  290.                 IF S > 1 THEN
  291.                     S = S - 1
  292.                     IF S <= F THEN F = F - 1
  293.                 END IF
  294.             CASE CHR$(0) + "P": ' DOWN ARROW
  295.                 W$ = ""
  296.                 IF S < MM THEN
  297.                     S = S + 1
  298.                     IF S >= F + I - 1 THEN F = F + 1
  299.                 END IF
  300.             CASE CHR$(13): EXIT DO ' ENTER
  301.             CASE CHR$(0) + "K": EXIT DO ' LEFT ARROW
  302.             CASE CHR$(0) + "M": EXIT DO ' RIGHT ARROW
  303.             CASE CHR$(0) + "-": S = -1: EXIT DO ' ALT-X
  304.             CASE CHR$(0) + "k": S = -1: EXIT DO ' ALT-F4
  305.             CASE CHR$(27): S = -1: EXIT DO ' ESC
  306.         END SELECT
  307.     LOOP
  308.  
  309.     ERASE C$
  310.     COLOR 7, 0
  311.     CLS
  312.  
  313.  
  314. ' Prints some text in the middle of the screen.
  315. ' We're assuming 80x25 color text mode.
  316. SUB CENTER (TEXTCOLOR, ROW, TEXT$)
  317.     COLOR TEXTCOLOR
  318.     LOCATE ROW, 40 - FIX(LEN(TEXT$) / 2): PRINT TEXT$;
  319.  
  320. ' This function returns the Nth word from a list.
  321. ' Words must be separated by the separator character S.
  322. ' S must hold the ASCII value of the character to be
  323. ' used as a separator character. i.e. S=32 means space
  324. ' Example:
  325. '    GETWORD$("apples peaches kiwi grapes", 1, 32) -> "apples"
  326. '    GETWORD$("apples/peaches/kiwi/grapes", 3, 47) -> "kiwi"
  327. '    GETWORD$("apples+peaches+kiwi+grapes", 9, 43) -> "" (out of range)
  328. '
  329. FUNCTION GETWORD$ (L$, N, S)
  330.     LL = LEN(L$)
  331.     IF N < 1 OR N > LL / 2 + 2 THEN GETWORD$ = "": EXIT FUNCTION
  332.     W = 0
  333.     F = 0
  334.     FOR I = 1 TO LL + 1
  335.         IF I > LL THEN C = S ELSE C = ASC(MID$(L$, I, 1))
  336.         IF C = S THEN
  337.             IF F AND W = N THEN
  338.                 GETWORD$ = MID$(L$, F, I - F)
  339.                 EXIT FUNCTION
  340.             END IF
  341.             F = 0
  342.         ELSE
  343.             IF F = 0 THEN F = I: W = W + 1
  344.         END IF
  345.     NEXT I
  346.     GETWORD$ = ""
  347.  
  348.  
« Last Edit: December 17, 2018, 11:00:49 pm by pagetelegram »
Page Telegram
<PageTelegram.com>
Document Writing
Author and Philanthropist
BBM: PT0433
Books at https://www.amazon.com/Jason-S-Page/e/B071RS8C2F/

Offline Petr

  • Forum Resident
  • Posts: 1720
  • The best code is the DNA of the hops.
    • View Profile
Re: Convert image content to PSET expressions....
« Reply #17 on: December 18, 2018, 09:30:50 am »
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 m AS _MEM
  4. SHELL _HIDE "dir/b *.jpg > list.txt"
  5. SHELL _HIDE "dir/b *.png >> list.txt"
  6. SHELL _HIDE "dir/b *.bmp >> list.txt"
  7. SHELL _HIDE "dir/b *.gif >> list.txt"
  8. OPEN "list.txt" FOR INPUT AS #1
  9. a = 0
  10.     a = a + 1
  11.     IF NOT (EOF(1)) THEN INPUT #1, fil$(a) ELSE SYSTEM
  12.     list$ = list$ + fil$(a) + "|"
  13. '
  14. ' Originally: COUNTRY.BAS
  15. ' This program asks the user to select his country from a list.
  16. ' The user may press the UP and DOWN arrows or PAGE UP/PAGE DOWN
  17. ' or HOME/END keys to navigate the menu. The user may also start
  18. ' typing the name of his country to find it faster.
  19. '
  20. ' Written by Zsolt Nagy-Perge in October 2018, Pensacola, Fla.
  21. ' <zsolt500n@gmail.com>
  22. '
  23. ' Code adapted in file selector for loadimg.bas by Jason Page
  24. ' December 2018. This program generates a file containing
  25. ' all the pset commands needed to generate any image you put
  26. ' in the program. This is ideal to generate images using for
  27. ' example wwwbasic. This program will only work and compile
  28. ' using QB64. Visit QB64.org to use the free compiler/IDE
  29. ' <pagetelegram@gmail.com>
  30. '
  31. ' QBasic 1.1 source code:
  32. '
  33. DEFINT A-Z
  34. DECLARE SUB CENTER (TEXTCOLOR, ROW, TEXT$)
  35. DECLARE SUB MENU (S, TITLE$, L$, TEXT$)
  36. DECLARE FUNCTION GETWORD$ (L$, N, S)
  37.  
  38. SELECTED = 3
  39. '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"
  40. MENU SELECTED, "Files", list$, "Please select your image file from the list below:"
  41.  
  42. CENTER 15, 10, "You picked :    " + GETWORD$(list$, SELECTED, 124)
  43. fle$ = GETWORD$(list$, SELECTED, 124)
  44.  
  45. SCREEN _NEWIMAGE(640, 480, 32)
  46.  
  47. 'img& = _LOADIMAGE(fle$, 32) 'load the image file to be drawn
  48.  
  49. n = _LOADIMAGE(fle$, 32)
  50. m = _MEMIMAGE(n) 'screen memory of image
  51.  
  52. 'wide% = _WIDTH(img&): deep% = _HEIGHT(img&)
  53. 'TLC$ = "BL" + STR$(wide% \ 2) + "BU" + STR$(deep% \ 2) 'start draw at top left corner
  54. 'RET$ = "BD BL" + STR$(wide%) 'return to left side of image
  55. '_SOURCE img&
  56. '_DEST 0
  57. 'SHELL "echo. > pset.txt"
  58. 'OPEN "pset.txt" FOR OUTPUT AS #2
  59. 'CLS
  60. 'Tmp& = _NEWIMAGE(32, 32, 256)
  61. 'DO
  62. '    x = x + 1
  63. 'IF x > wide% THEN
  64. 'x = 0: y = y + 1
  65. 'END IF
  66. 'DRAW "C" + STR$(POINT(x, y)) + "R1" 'color and DRAW each pixel
  67. '
  68. 'colour~& = POINT(x, y)
  69. 'c% = _RGB(_RED32(colour~&), _GREEN32(colour~&), _BLUE32(colour~&), Tmp&)
  70. 'clr = (c%) 'POINT(x, y) / (16553 * 256 * 16 * 8)
  71. 'x$ = STR$(x)
  72. 'y$ = STR$(y)
  73. 'clr$ = STR$(clr)
  74. 'PRINT #2, "pset(" + x$ + CHR$(44) + y$ + ")" + CHR$(44) + clr$
  75. 'LOCATE 2, 1: PRINT x, y
  76. 'PSET (x, y), clr
  77.  
  78. 'LOOP UNTIL y >= deep%
  79. 'CLOSE #2
  80. 'LOCATE 22, 1
  81. 'PRINT "Saved as pset.txt"
  82. 'SLEEP 1
  83.  
  84. ' Steve Contrib (SMcNeill):
  85.  
  86. 'DIM c AS _UNSIGNED LONG 'color value of the pixels
  87. 'DIM ShortByte AS _UNSIGNED _BYTE, LongData AS _UNSIGNED LONG
  88. 'ShortByte = 0
  89. SHELL _HIDE "echo. > databas.txt"
  90. ''open  a file for saving
  91. 'OPEN "databas.txt" FOR OUTPUT AS #1
  92.  
  93.  
  94. 'DO UNTIL finished
  95. 'count = 1 'count is the count of repetitive times a color appears in a row
  96. '_MEMGET m, m.OFFSET + p * 4, c 'p is the current point
  97. 'IF p >= m.SIZE THEN
  98. '    finished = -1
  99. 'ELSE
  100. '    IF (p + count) * 4 >= m.SIZE THEN
  101. '    finished = -1
  102. 'ELSE
  103. '    DO UNTIL _MEMGET(m, m.OFFSET + (p + count) * 4, _UNSIGNED LONG) <> c
  104. '    count = count + 1
  105. '    IF (p + count) * 4 >= m.SIZE THEN finished = -1: count = count - 1: EXIT DO
  106. 'LOOP
  107. 'END IF
  108. 'END IF
  109. 'p = p + count
  110. 'r = _RED32(c): g = _GREEN32(c): b = _BLUE32(c)
  111. 'PRINT #1, "DATA "; r; ","; g; ","; b; ",";
  112. 'IF count > 255 THEN
  113. '    LongData = count
  114. 'PRINT #1, ShortByte; ","; LongData
  115. 'ELSE
  116. '    ShortByte = count
  117. 'PRINT #1, ShortByte
  118. 'END IF
  119. 'ShortByte = 0 'reset the default count to 0
  120. 'LOOP
  121.  
  122. 'free resources
  123. 'CLOSE #1
  124. '_MEMFREE m
  125. ' Example by Petr
  126.  
  127. REM image = n '_LOADIMAGE(fle$, 32)
  128. outfile$ = "databas.txt"
  129. chan = FREEFILE
  130. OPEN outfile$ FOR OUTPUT AS #chan 'but binary access is much faster than input / output mode
  131. head$ = "DATA " + STR$(_WIDTH(image)) + "," + STR$(_HEIGHT(image))
  132. PRINT #chan, head$
  133.  
  134.  
  135. m = _MEMIMAGE(n) '                                                            repaired
  136. DIM writeit AS LONG '                                                         repaired
  137. FOR writeit = 0 TO _WIDTH(n) * _HEIGHT(n) * 4 - 4 STEP 4 '                    repaired
  138.     _MEMGET m, m.OFFSET + writeit, colors
  139.     R = _RED32(colors): G = _GREEN32(colors): B = _BLUE32(colors)
  140.     d$ = "DATA " + STR$(R) + "," + STR$(G) + "," + STR$(B)
  141.     PRINT #chan, d$ '
  142. CLOSE #chan
  143.  
  144. LOCATE 23, 1
  145. PRINT "Image saved as database.txt"
  146.  
  147. SUB MENU (S, TITLE$, L$, TEXT$)
  148.  
  149.     C0 = 0 ' Main window background pick:0-7
  150.     C1 = 7 ' Color 2 (FG) pick:0-7
  151.     C2 = 0 ' Color 1 (BG) pick:0-7
  152.     C3 = 15 ' Typing color pick:0-15
  153.     C4 = 12 ' Mistyped item color pick:0-15
  154.     C5 = 9 ' Title color (TITLE$) pick:0-15
  155.     C6 = 14 ' Description color (TEXT$) pick:0-15
  156.  
  157.     ORIGINAL = S
  158.     SCREEN 0
  159.     WIDTH 80, 25
  160.     COLOR C1, C0
  161.     CLS
  162.  
  163.     ' Display title.
  164.     CENTER C5, 2, TITLE$
  165.  
  166.     ' Display description text.
  167.     CENTER C6, 4, TEXT$
  168.  
  169.     REDIM C$(1 TO 250) ' <<< Array size may need to be modified.
  170.  
  171.     ' Split list into string array
  172.     P = 1
  173.     LL = 0 ' Longest line
  174.     FOR I = 1 TO UBOUND(C$)
  175.         F = P
  176.         P = INSTR(P, L$, "|")
  177.         IF P < 1 THEN P = 9999
  178.         C$(I) = MID$(L$, F, P - F)
  179.         IF LL < LEN(C$(I)) THEN LL = LEN(C$(I))
  180.         IF P = 9999 THEN EXIT FOR
  181.         P = P + 1
  182.     NEXT I
  183.  
  184.     ' S   = Selected Item
  185.     ' LL  = Longest line length
  186.     MM = I ' MM  = Number of menu items
  187.     W$ = "" ' W$  = User typed search text
  188.     N = 0 ' N   = User typed search text found?
  189.     F = 0 ' F   = Vertical Display Offset
  190.     M = 8 ' M   = Number of menu items to display on screen
  191.     TOP = 5 ' TOP = Top row where menu starts Y
  192.     ' X   = Start printing menu at pos X
  193.     X = 33 - FIX(LL / 2)
  194.  
  195.  
  196.     ' Displays a menu on the screen, and allows the user to select
  197.     ' one item from the list. L$ should contain the list of menu items
  198.     ' separated by the | character. S will hold the number of the
  199.     ' selected menu item. If S is 5 at the beginning, this means the
  200.     ' 5th item on the list is selected by default. If the user picks
  201.     ' a different menu item and presses Enter, then S will change.
  202.     ' If the user presses ESC, ALT+X or ALT+F4, S will be -1.
  203.     '
  204.  
  205.  
  206.     DO
  207.         ' Print menu items
  208.         FOR I = 1 TO M
  209.             Y = I * 2 + TOP
  210.             IF S = I + F THEN
  211.                 COLOR C2, C1
  212.             ELSE
  213.                 COLOR C1, C2
  214.             END IF
  215.             T$ = C$(I + F)
  216.             LOCATE Y, X: PRINT SPACE$(5); T$; SPACE$(LL - LEN(T$) + 10);
  217.         NEXT I
  218.  
  219.         ' Put lines or spaces among menu items
  220.         FOR I = 1 TO M + 1
  221.             IF S = I + F THEN
  222.                 COLOR C1, C2
  223.             ELSEIF S = I + F - 1 THEN
  224.                 COLOR C2, C1
  225.             ELSE
  226.                 COLOR C2, C2
  227.             END IF
  228.             LOCATE I * 2 + TOP - 1, X: PRINT STRING$(LL + 15, CHR$(220));
  229.         NEXT I
  230.  
  231.         ' Print search text
  232.         IF N THEN COLOR C3, C2 ELSE COLOR C4, C2
  233.         Z$ = LEFT$(W$, 40)
  234.         LOCATE 24, 20: PRINT Z$; SPACE$(40 - LEN(Z$));
  235.         IF LEN(W$) THEN LOCATE 24, 20 + LEN(Z$), 1, 12, 13 ELSE LOCATE 1, 1, 0
  236.  
  237.         K$ = "": WHILE K$ = "": K$ = INKEY$: WEND
  238.  
  239.         LOCATE 1, 1, 0 ' Turn off cursor
  240.  
  241.         ' Process search text
  242.         N = 0
  243.         IF LEN(K$) = 1 THEN
  244.             U = ASC(UCASE$(K$))
  245.             IF LEN(W$) AND K$ = CHR$(8) THEN ' BACKSPACE
  246.                 W$ = LEFT$(W$, LEN(W$) - 1)
  247.             ELSEIF U = 32 OR U > 64 AND U < 91 OR (U > 47 AND U < 58) THEN ' TYPING
  248.                 W$ = W$ + K$
  249.             END IF
  250.             IF LEN(W$) THEN
  251.                 FOR G = 1 TO UBOUND(C$) ' FIND ITEM
  252.                     IF UCASE$(LEFT$(C$(G), LEN(W$))) = UCASE$(W$) THEN
  253.                         N = 1
  254.                         S = G
  255.                         IF S < F OR S > F + M THEN
  256.                             F = S - FIX(M / 2)
  257.                             IF F < 0 THEN F = 0
  258.                             IF F > MM - M THEN F = MM - M
  259.                         END IF
  260.                         EXIT FOR
  261.                     END IF
  262.                 NEXT G
  263.             END IF
  264.         END IF
  265.  
  266.         SELECT CASE K$
  267.             CASE CHR$(0) + "G": ' HOME
  268.                 W$ = ""
  269.                 S = 1
  270.                 F = 0
  271.             CASE CHR$(0) + "O": ' END
  272.                 W$ = ""
  273.                 S = MM
  274.                 F = MM - M
  275.                 IF F < 0 THEN F = 0
  276.             CASE CHR$(0) + "I": ' PGUP
  277.                 W$ = ""
  278.                 S = S - M
  279.                 F = F - M
  280.                 IF S < 1 THEN S = 1
  281.                 IF F < 0 THEN F = 0
  282.             CASE CHR$(0) + "Q": ' PGDN
  283.                 W$ = ""
  284.                 S = S + M
  285.                 F = F + M
  286.                 IF S > MM THEN S = MM
  287.                 IF F > MM - M THEN F = MM - M
  288.                 IF F < 0 THEN F = 0
  289.             CASE CHR$(0) + "H": ' UP ARROW
  290.                 W$ = ""
  291.                 IF S > 1 THEN
  292.                     S = S - 1
  293.                     IF S <= F THEN F = F - 1
  294.                 END IF
  295.             CASE CHR$(0) + "P": ' DOWN ARROW
  296.                 W$ = ""
  297.                 IF S < MM THEN
  298.                     S = S + 1
  299.                     IF S >= F + I - 1 THEN F = F + 1
  300.                 END IF
  301.             CASE CHR$(13): EXIT DO ' ENTER
  302.             CASE CHR$(0) + "K": EXIT DO ' LEFT ARROW
  303.             CASE CHR$(0) + "M": EXIT DO ' RIGHT ARROW
  304.             CASE CHR$(0) + "-": S = -1: EXIT DO ' ALT-X
  305.             CASE CHR$(0) + "k": S = -1: EXIT DO ' ALT-F4
  306.             CASE CHR$(27): S = -1: EXIT DO ' ESC
  307.         END SELECT
  308.     LOOP
  309.  
  310.     ERASE C$
  311.     COLOR 7, 0
  312.     CLS
  313.  
  314.  
  315. ' Prints some text in the middle of the screen.
  316. ' We're assuming 80x25 color text mode.
  317. SUB CENTER (TEXTCOLOR, ROW, TEXT$)
  318.     COLOR TEXTCOLOR
  319.     LOCATE ROW, 40 - FIX(LEN(TEXT$) / 2): PRINT TEXT$;
  320.  
  321. ' This function returns the Nth word from a list.
  322. ' Words must be separated by the separator character S.
  323. ' S must hold the ASCII value of the character to be
  324. ' used as a separator character. i.e. S=32 means space
  325. ' Example:
  326. '    GETWORD$("apples peaches kiwi grapes", 1, 32) -> "apples"
  327. '    GETWORD$("apples/peaches/kiwi/grapes", 3, 47) -> "kiwi"
  328. '    GETWORD$("apples+peaches+kiwi+grapes", 9, 43) -> "" (out of range)
  329. '
  330. FUNCTION GETWORD$ (L$, N, S)
  331.     LL = LEN(L$)
  332.     IF N < 1 OR N > LL / 2 + 2 THEN GETWORD$ = "": EXIT FUNCTION
  333.     W = 0
  334.     F = 0
  335.     FOR I = 1 TO LL + 1
  336.         IF I > LL THEN C = S ELSE C = ASC(MID$(L$, I, 1))
  337.         IF C = S THEN
  338.             IF F AND W = N THEN
  339.                 GETWORD$ = MID$(L$, F, I - F)
  340.                 EXIT FUNCTION
  341.             END IF
  342.             F = 0
  343.         ELSE
  344.             IF F = 0 THEN F = I: W = W + 1
  345.         END IF
  346.     NEXT I
  347.     GETWORD$ = ""
  348.  
  349.  

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3972
    • View Profile
    • Steve’s QB64 Archive Forum
Re: Convert image content to PSET expressions....
« Reply #18 on: December 18, 2018, 11:36:47 am »
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.  ;)

https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline _vince

  • Seasoned Forum Regular
  • Posts: 422
    • View Profile
Re: Convert image content to PSET expressions....
« Reply #19 on: December 18, 2018, 11:48:49 pm »
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