Text Only | Text with Attachments

QB64.org Forum

Active Forums => Programs => Topic started by: Dav on January 24, 2021, 11:18:16 pm

Title: Unscramble the picture puzzle
Post by: Dav on January 24, 2021, 11:18:16 pm
Had some extra time today to play around with this.  It's a simple picture unscramble puzzle.  It's coded so that you can use your own image instead easily.  Also, you can easily change the number of puzzle pieces to make it harder, just change row & col values.

Code uses the image attached.

- Dav

EDIT: New picture.  Added press SPACE key for a quick cheat look...

Code: QB64: [Select]
  1. '=================
  2. 'UNSCRAMBLE.BAS
  3. '=================
  4. 'Unscramble the picture puzzle
  5. 'Coded by Dav, JAN/2021
  6.  
  7. 'Use mouse, click on squares to swap them.
  8. 'SPACE key gives a little half second cheat look.
  9.  
  10. 'korea.jpg picture was taken by Dav at an outdoor
  11. 'market located in Nonsan, South Korea.
  12.  
  14.  
  15. SCREEN _LOADIMAGE("korea.jpg", 32) 'You can use your own picture
  16.  
  17. SLEEP 2 'show picture couple of secs
  18.  
  19. row = 6: col = 6 '6x6 grid of pieces - increase for more pieces
  20. xsize = _WIDTH / row: ysize = _HEIGHT / col
  21. DIM tile&(row * col), tile.x(row * col), tile.y(row * col)
  22. DIM tilepuz(row * col)
  23.  
  24. '=== split picture up into tile pieces
  25. bc = 1
  26. FOR c = 1 TO col
  27.     FOR r = 1 TO row
  28.         x1 = (r * xsize) - xsize: x2 = x1 + xsize
  29.         y1 = (c * ysize) - ysize: y2 = y1 + ysize
  30.         tile.x(bc) = x1: tile.y(bc) = y1
  31.         'make pieces images
  32.         tile&(bc) = _NEWIMAGE(ABS(x2 - x1) + 1, ABS(y2 - y1) + 1, 32)
  33.         _PUTIMAGE (0, 0), _DEST, tile&(bc), (x1, y1)-(x2, y2)
  34.  
  35.         tilepuz(bc) = bc
  36.         bc = bc + 1
  37.     NEXT
  39.  
  40. '=== swap the tilepuz array (shuffle)
  41. FOR p = 1 TO UBOUND(tilepuz)
  42.     new = INT(RND * p) + 1
  43.     IF new <> p THEN SWAP tilepuz(new), tilepuz(p)
  45.  
  46.  
  47. '=====
  48. main:
  49. '=====
  50.  
  51. '=== show current puzzle
  52. FOR t = 1 TO row * col
  53.     _PUTIMAGE (tile.x(t), tile.y(t)), tile&(tilepuz(t))
  54.     'LINE (tile.x(t), tile.y(t))-(tile.x(t) + xsize, tile.y(t) + ysize), _RGB(100, 100, 100), B
  56.  
  57. '=== check if puzzle done
  58. done = 1
  59. FOR t = 1 TO row * col
  60.     IF tilepuz(t) <> t THEN done = 0
  62. IF done = 1 THEN
  63.     PLAY "mbl16cdefgfedc": _DELAY 4
  64.     END 'Solved!
  66.  
  67.  
  68. selected = 0
  69.  
  70. second:
  71.  
  73.     'wait until mouse button up to continue
  74.     WHILE _MOUSEBUTTON(1) <> 0: n = _MOUSEINPUT: WEND
  75.  
  76.     trap = _MOUSEINPUT 'Poll mouse data
  77.  
  78.     'If user clicked mouse
  80.         'see where they clicked
  81.         mx = _MOUSEX: my = _MOUSEY
  82.  
  83.         FOR t = 1 TO row * col
  84.             tx = tile.x(t): tx2 = tile.x(t) + xsize
  85.             ty = tile.y(t): ty2 = tile.y(t) + ysize
  86.  
  87.             IF mx >= tx AND mx <= tx2 THEN
  88.                 IF my >= ty AND my <= ty2 THEN
  89.  
  90.                     IF selected = 0 THEN
  91.                         selected = 1
  92.                         'highlight piece
  93.                         LINE (tile.x(t), tile.y(t))-(tile.x(t) + xsize, tile.y(t) + ysize), _RGB(255, 255, 255), B
  94.                         SOUND 5000, .1
  95.                         sel = t 'save picked piece
  96.                         GOTO second 'now get second choice
  97.                     ELSE
  98.                         'swap pieces
  99.                         SWAP tilepuz(t), tilepuz(sel)
  100.                         GOTO main
  101.                     END IF
  102.  
  103.                 END IF
  104.             END IF
  105.  
  106.         NEXT
  107.     END IF
  108.  
  109.     'Space give a little cheat look
  110.     IF INKEY$ = CHR$(32) THEN
  111.         FOR t = 1 TO row * col
  112.             _PUTIMAGE (tile.x(t), tile.y(t)), tile&(t)
  113.         NEXT
  114.         _DELAY .5: _KEYCLEAR
  115.         GOTO main
  116.     END IF
  117.  
  119.  
  121.  

Title: Re: Unscramble the picture puzzle
Post by: NOVARSEG on January 24, 2021, 11:55:52 pm
I had to cheat.

This could also be a picture viewer.
Title: Re: Unscramble the picture puzzle
Post by: Pete on January 25, 2021, 12:40:55 am
I don't have a foggy idea, which is probably why I completed it.

Nice, but I like TheBOB's puzzle a bit more... because it's got boobs. I think there's a face that goes with it, but I didn't up to that level.

Pete
Title: Re: Unscramble the picture puzzle
Post by: Dav on January 25, 2021, 11:32:28 am
Thanks for trying it out, @NOVARSEG.  I had to take a look or two myself at first.

Lol, @Pete.  I didn't know TheBob used TheBoob.  I had a picture of a big egg at first, thinking it would be fun to unscamble an egg, but there where too many all white sguares that make it too hard to get in the right places.  Pictures need to be kind of busy, large space of solid colors don't work very well.

Updated the code and picture.  I added SPACE for a half sec cheat look at the picture.  Also, I replaced the image with one I took in South Korea a number of years ago.

- Dav
Title: Re: Unscramble the picture puzzle
Post by: Pete on January 25, 2021, 12:03:38 pm
Oh, cheat means you had to go back to look at the original pic. Yeah, I did that when I was about 60% finished. I worked the cent out, first, but that fog was hard to put together without seeing the original photo.

TheBob hadn't coded anything in what, maybe 5 years? All of a sudden, he popped this up on the forum: https://www.tapatalk.com/groups/qbasic/anna-chlumsky-jigsaw-puzzle-t39631-s10.html#p213399

I'm not sure what it would take to make those puzzle pieces randomly rotate, but that would definitely up the level of difficulty.

Fun stuff, for as little code that can produce it. I say that because it takes thousands of lines of code to get any bells and whistles out of text apps. No instant gratification there. Dammit, now I want pudding.

Pete
Title: Re: Unscramble the picture puzzle
Post by: Dav on January 26, 2021, 07:33:50 pm
Quote from: Pete on January 25, 2021, 12:03:38 pm
I'm not sure what it would take to make those puzzle pieces randomly rotate, but that would definitely up the level of difficulty.

I liked that idea, @Pete, so I made a new version that does that using the ultra-cool RotoZoom SUB (who made that, btw?  @bplus?).  With the right picture, it could be kind of difficult.

This new version you click on the pieces to rotate them in place.  It's animated.  This requires a squared screen resolution/image to work well, so I've used a new image of another picture I took in South Korea.  I was walking up a mountain somewhere and this beautiful gazebo was sitting by a stream. (photography is kind of a hobby sometimes...).

- Dav

Code: QB64: [Select]
  1. '==================
  2. 'UNSCRAMBLE-ROT.BAS
  3. '==================
  4. 'Unscramble the picture puzzle
  5. 'Rotate pieces until they fit.
  6. 'Coded by Dav, JAN/2021
  7.  
  8. 'Use mouse, click on squares to rotate them.
  9. 'SPACE key gives a little half second cheat look.
  10.  
  11. 'korea2.jpg picture was taken by Dav in South Korea
  12.  
  13. 'CREDITS: Thanks to whoever made and shared the RotoZoom SUB.
  14.  
  16.  
  17. SCREEN _NEWIMAGE(650, 650, 32)
  18.  
  19. 'Use your own image here....
  20. 'NOTE: USE A SQUARED IMAGE (ie: 600x600, 700x700, etc...)
  21. pic& = _LOADIMAGE("korea2.jpg", 32)
  22. _PUTIMAGE (0, 0)-(_WIDTH, _HEIGHT), pic&
  24.  
  25. SLEEP 2 'show picture couple of secs
  26.  
  27. row = 6: col = 6 '6x6 grid of pieces - increase for more pieces
  28. xsize = _WIDTH / row: ysize = _HEIGHT / col
  29. DIM SHARED tile&(row * col), tile.x(row * col), tile.y(row * col)
  30. DIM tilepuz(row * col)
  31.  
  32. '=== split picture up into tile pieces
  33. bc = 1
  34. FOR c = 1 TO col
  35.     FOR r = 1 TO row
  36.         x1 = (r * xsize) - xsize: x2 = x1 + xsize
  37.         y1 = (c * ysize) - ysize: y2 = y1 + ysize
  38.         tile.x(bc) = x1: tile.y(bc) = y1
  39.         'make pieces images
  40.         tile&(bc) = _NEWIMAGE(ABS(x2 - x1) + 1, ABS(y2 - y1) + 1, 32)
  41.         _PUTIMAGE (0, 0), _DEST, tile&(bc), (x1, y1)-(x2, y2)
  42.         tilepuz(bc) = bc
  43.         bc = bc + 1
  44.     NEXT
  46.  
  47. FOR p = 1 TO UBOUND(tilepuz)
  48.     tilepuz(p) = INT(RND * 4) + 1
  50.  
  51.  
  52. '=====
  53. main:
  54. '=====
  55.  
  56. '=== show current puzzle
  57. FOR t = 1 TO row * col
  58.     SELECT CASE tilepuz(t)
  59.         CASE 1: angle = 0
  60.         CASE 2: angle = 90
  61.         CASE 3: angle = 180
  62.         CASE 4: angle = 270
  63.     END SELECT
  64.     RotoZoom tile.x(t) + (xsize / 2), tile.y(t) + (ysize / 2), tile&(t), 1, angle
  65.  
  67.  
  69.  
  70. '=== check if puzzle done
  71. done = 1
  72. FOR t = 1 TO row * col
  73.     IF tilepuz(t) <> 1 THEN done = 0
  75. IF done = 1 THEN
  76.     PLAY "mbl16cdefgfedc": _DELAY 4
  77.     END 'Solved!
  79.  
  80.  
  81.  
  83.     'wait until mouse button up to continue
  84.     WHILE _MOUSEBUTTON(1) <> 0: n = _MOUSEINPUT: WEND
  85.  
  86.     trap = _MOUSEINPUT 'Poll mouse data
  87.  
  88.     'If user clicked mouse
  90.         'see where they clicked
  91.         mx = _MOUSEX: my = _MOUSEY
  92.  
  93.         FOR t = 1 TO row * col
  94.             tx = tile.x(t): tx2 = tile.x(t) + xsize
  95.             ty = tile.y(t): ty2 = tile.y(t) + ysize
  96.  
  97.             IF mx >= tx AND mx <= tx2 THEN
  98.                 IF my >= ty AND my <= ty2 THEN
  99.                     LINE (tx, ty)-(tx2, ty2), _RGB(0, 0, 0), BF
  100.                     temp& = _COPYIMAGE(_DISPLAY)
  101.                     SELECT CASE tilepuz(t)
  102.                         CASE 1: tilepuz(t) = 2
  103.                             FOR angle = 0 TO 90
  104.                                 _PUTIMAGE (0, 0), temp&
  105.                                 RotoZoom tile.x(t) + (xsize / 2), tile.y(t) + (ysize / 2), tile&(t), 1, angle
  106.                                 _DELAY .005
  107.                                 _DISPLAY
  108.                             NEXT
  109.                         CASE 2: tilepuz(t) = 3
  110.                             FOR angle = 90 TO 180
  111.                                 _PUTIMAGE (0, 0), temp&
  112.                                 RotoZoom tile.x(t) + (xsize / 2), tile.y(t) + (ysize / 2), tile&(t), 1, angle
  113.                                 _DELAY .005
  114.                                 _DISPLAY
  115.                             NEXT
  116.                         CASE 3: tilepuz(t) = 4
  117.                             FOR angle = 180 TO 270
  118.                                 _PUTIMAGE (0, 0), temp&
  119.                                 RotoZoom tile.x(t) + (xsize / 2), tile.y(t) + (ysize / 2), tile&(t), 1, angle
  120.                                 _DELAY .005
  121.                                 _DISPLAY
  122.                             NEXT
  123.                         CASE 4: tilepuz(t) = 1
  124.                             FOR angle = 270 TO 360
  125.                                 _PUTIMAGE (0, 0), temp&
  126.                                 RotoZoom tile.x(t) + (xsize / 2), tile.y(t) + (ysize / 2), tile&(t), 1, angle
  127.                                 _DELAY .005
  128.                                 _DISPLAY
  129.                             NEXT
  130.                     END SELECT
  131.                     _DISPLAY
  132.                     _FREEIMAGE temp&
  133.                     GOTO main
  134.                 END IF
  135.             END IF
  136.  
  137.         NEXT
  138.     END IF
  139.  
  140.     'Space give a little cheat look
  141.     IF INKEY$ = CHR$(32) THEN
  142.         FOR t = 1 TO row * col
  143.             _PUTIMAGE (tile.x(t), tile.y(t)), tile&(t)
  144.         NEXT
  145.         _DISPLAY
  146.         _DELAY .5: _KEYCLEAR
  147.         GOTO main
  148.     END IF
  149.  
  151.  
  153.  
  154.  
  155. SUB RotoZoom (X AS LONG, Y AS LONG, Image AS LONG, Scale AS SINGLE, Rotation AS SINGLE)
  156.     DIM px(3) AS SINGLE: DIM py(3) AS SINGLE
  157.     W& = _WIDTH(Image&): H& = _HEIGHT(Image&)
  158.     px(0) = -W& / 2: py(0) = -H& / 2: px(1) = -W& / 2: py(1) = H& / 2
  159.     px(2) = W& / 2: py(2) = H& / 2: px(3) = W& / 2: py(3) = -H& / 2
  160.     sinr! = SIN(-Rotation / 57.2957795131): cosr! = COS(-Rotation / 57.2957795131)
  161.     FOR i& = 0 TO 3
  162.         x2& = (px(i&) * cosr! + sinr! * py(i&)) * Scale + X: y2& = (py(i&) * cosr! - px(i&) * sinr!) * Scale + Y
  163.         px(i&) = x2&: py(i&) = y2&
  164.     NEXT
  165.     _MAPTRIANGLE _SEAMLESS(0, 0)-(0, H& - 1)-(W& - 1, H& - 1), Image& TO(px(0), py(0))-(px(1), py(1))-(px(2), py(2))
  166.     _MAPTRIANGLE _SEAMLESS(0, 0)-(W& - 1, 0)-(W& - 1, H& - 1), Image& TO(px(0), py(0))-(px(3), py(3))-(px(2), py(2))
  168.  

Title: Re: Unscramble the picture puzzle
Post by: bplus on January 26, 2021, 08:08:51 pm
Quote
the ultra-cool RotoZoom SUB (who made that, btw?  @bplus?).

I wish, I did a mod that made the x scale independent of the y scale but Rotozoom can be found in Wiki possibly under _MAPTRIANGLE.  Confirmed, example #1

@Dav did you happen to catch MasterGy's puzzle maker?
 https://www.qb64.org/forum/index.php?topic=3261.msg125613#msg125613

But I know very well, more fun to roll your own :)
Title: Re: Unscramble the picture puzzle
Post by: Dav on January 26, 2021, 08:38:12 pm
Quote from: bplus on January 26, 2021, 08:08:51 pm
@Dav did you happen to catch MasterGy's puzzle maker?
 https://www.qb64.org/forum/index.php?topic=3261.msg125613#msg125613

I think so, sounds familiar. Im trying to search for it, but the forum search function doesn't seem to be working for me at the moment.  I'll find it...

Edit: Woah! Found it. That is really cool.

Edit#2: i see now you gave a link! Sorry i didn't notice it at first.

- Dav
Title: Re: Unscramble the picture puzzle
Post by: Dav on January 26, 2021, 11:00:35 pm
Quote from: bplus on January 26, 2021, 08:08:51 pm
... I did a mod that made the x scale independent of the y scale ...

Yes, I think I found it - RotoZoom2. Well done fiuguring out RotoZoom.

RotoZoom is such a handy thing.  I'm having fun making little screen effects with it.  Here's a desktop blender...

Code: QB64: [Select]
  1. IF INSTR(1, _OS$, "LINUX") THEN
  2.     PRINT "Sorry, Windows only.": END
  4.  
  5. SCREEN _NEWIMAGE(600, 600, 32)
  6.  
  9.     s& = _SCREENIMAGE
  10.     RotoZoom _WIDTH / 2, _HEIGHT / 2, s&, .89, a
  11.     a = a + 1: IF a >= 360 THEN a = a - 360
  12.     _FREEIMAGE s&
  13.     _DISPLAY: _LIMIT 60
  15.  
  16.  
  17. SUB RotoZoom (X AS LONG, Y AS LONG, Image AS LONG, Scale AS SINGLE, Rotation AS SINGLE)
  18.     DIM px(3) AS SINGLE: DIM py(3) AS SINGLE
  19.     W& = _WIDTH(Image&): H& = _HEIGHT(Image&)
  20.     px(0) = -W& / 2: py(0) = -H& / 2: px(1) = -W& / 2: py(1) = H& / 2
  21.     px(2) = W& / 2: py(2) = H& / 2: px(3) = W& / 2: py(3) = -H& / 2
  22.     sinr! = SIN(-Rotation / 57.2957795131): cosr! = COS(-Rotation / 57.2957795131)
  23.     FOR i& = 0 TO 3
  24.         x2& = (px(i&) * cosr! + sinr! * py(i&)) * Scale + X: y2& = (py(i&) * cosr! - px(i&) * sinr!) * Scale + Y
  25.         px(i&) = x2&: py(i&) = y2&
  26.     NEXT
  27.     _MAPTRIANGLE _SEAMLESS(0, 0)-(0, H& - 1)-(W& - 1, H& - 1), Image& TO(px(0), py(0))-(px(1), py(1))-(px(2), py(2))
  28.     _MAPTRIANGLE _SEAMLESS(0, 0)-(W& - 1, 0)-(W& - 1, H& - 1), Image& TO(px(0), py(0))-(px(3), py(3))-(px(2), py(2))
  30.  
Title: Re: Unscramble the picture puzzle
Post by: bplus on January 26, 2021, 11:10:21 pm
Quote
RotoZoom is such a handy thing.

Indeed! Check this out, in demo has several demos ends with dancing spikes just follow directions.
Title: Re: Unscramble the picture puzzle
Post by: Dav on January 26, 2021, 11:17:19 pm
Wow!  The possibilities with this is great.  I'm gonna play with that for a while!

- Dav
Title: Re: Unscramble the picture puzzle
Post by: SMcNeill on January 27, 2021, 03:50:48 pm
I've worked up an unscrambler for you:

Code: QB64: [Select]
  1. SCREEN _LOADIMAGE("korea.jpg", 32)
  4.  
  5.  
  6. m = _MEMIMAGE(0)
  7. Sort m
  9.  
  10. SUB Sort (m AS _MEM)
  12.     $IF 64BIT THEN
  13.         DIM ES AS _INTEGER64, EC AS _INTEGER64
  14.     $ELSE
  15.         DIM ES AS LONG, EC AS LONG
  16.     $END IF
  17.  
  18.     'IF NOT m.TYPE AND 65536 THEN EXIT SUB 'We won't work without an array
  19.     IF m.TYPE AND 1024 THEN DataType = 10
  20.     IF m.TYPE AND 1 THEN DataType = DataType + 1
  21.     IF m.TYPE AND 2 THEN DataType = DataType + 2
  22.     IF m.TYPE AND 4 THEN IF m.TYPE AND 128 THEN DataType = DataType + 4 ELSE DataType = 3
  23.     IF m.TYPE AND 8 THEN IF m.TYPE AND 128 THEN DataType = DataType + 8 ELSE DataType = 5
  24.     IF m.TYPE AND 32 THEN DataType = 6
  25.     IF m.TYPE AND 512 THEN DataType = 7
  26.  
  27.     'Convert our offset data over to something we can work with
  28.     DIM m1 AS _MEM: m1 = _MEMNEW(LEN(ES))
  29.     _MEMPUT m1, m1.OFFSET, m.ELEMENTSIZE: _MEMGET m1, m1.OFFSET, ES 'Element Size
  30.     _MEMPUT m1, m1.OFFSET, m.SIZE: _MEMGET m1, m1.OFFSET, EC 'Element Count will temporily hold the WHOLE array size
  31.     _MEMFREE m1
  32.  
  33.     EC = EC / ES - 1 'Now we take the whole element size / the size of the elements and get our actual element count.  We subtract 1 so our arrays start at 0 and not 1.
  34.     'And work with it!
  35.     DIM o AS _OFFSET, o1 AS _OFFSET, counter AS _UNSIGNED LONG
  36.  
  37.     SELECT CASE DataType
  38.         CASE 1 'BYTE
  39.             DIM temp1(-128 TO 127) AS _UNSIGNED LONG
  40.             DIM t1 AS _BYTE
  41.             i = 0
  42.             DO
  43.                 _MEMGET m, m.OFFSET + i, t1
  44.                 temp1(t1) = temp1(t1) + 1
  45.                 i = i + 1
  46.             LOOP UNTIL i > EC
  47.             i1 = -128
  48.             DO
  49.                 DO UNTIL temp1(i1) = 0
  50.                     _MEMPUT m, m.OFFSET + counter, i1 AS _BYTE
  51.                     counter = counter + 1
  52.                     temp1(i1) = temp1(i1) - 1
  53.                     IF counter > EC THEN EXIT SUB
  54.                 LOOP
  55.                 i1 = i1 + 1
  56.             LOOP UNTIL i1 > 127
  57.         CASE 2: 'INTEGER
  58.             DIM temp2(-32768 TO 32767) AS _UNSIGNED LONG
  59.             DIM t2 AS INTEGER
  60.             i = 0
  61.             DO
  62.                 _MEMGET m, m.OFFSET + i * 2, t2
  63.                 temp2(t2) = temp2(t2) + 1
  64.                 i = i + 1
  65.             LOOP UNTIL i > EC
  66.             i1 = -32768
  67.             DO
  68.                 DO UNTIL temp2(i1) = 0
  69.                     _MEMPUT m, m.OFFSET + counter * 2, i1 AS INTEGER
  70.                     counter = counter + 1
  71.                     temp2(i1) = temp2(i1) - 1
  72.                     IF counter > EC THEN EXIT SUB
  73.                 LOOP
  74.                 i1 = i1 + 1
  75.             LOOP UNTIL i1 > 32767
  76.         CASE 3 'SINGLE
  77.             DIM T3a AS SINGLE, T3b AS SINGLE
  78.             gap = EC
  79.             DO
  80.                 gap = 10 * gap \ 13
  81.                 IF gap < 1 THEN gap = 1
  82.                 i = 0
  83.                 swapped = 0
  84.                 DO
  85.                     o = m.OFFSET + i * 4
  86.                     o1 = m.OFFSET + (i + gap) * 4
  87.                     IF _MEMGET(m, o, SINGLE) > _MEMGET(m, o1, SINGLE) THEN
  88.                         _MEMGET m, o1, T3a
  89.                         _MEMGET m, o, T3b
  90.                         _MEMPUT m, o1, T3b
  91.                         _MEMPUT m, o, T3a
  92.                         swapped = -1
  93.                     END IF
  94.                     i = i + 1
  95.                 LOOP UNTIL i + gap > EC
  96.             LOOP UNTIL gap = 1 AND swapped = 0
  97.         CASE 4 'LONG
  98.             DIM T4a AS LONG, T4b AS LONG
  99.             gap = EC
  100.             DO
  101.                 gap = 10 * gap \ 13
  102.                 IF gap < 1 THEN gap = 1
  103.                 i = 0
  104.                 swapped = 0
  105.                 DO
  106.                     o = m.OFFSET + i * 4
  107.                     o1 = m.OFFSET + (i + gap) * 4
  108.                     IF _MEMGET(m, o, LONG) > _MEMGET(m, o1, LONG) THEN
  109.                         _MEMGET m, o1, T4a
  110.                         _MEMGET m, o, T4b
  111.                         _MEMPUT m, o1, T4b
  112.                         _MEMPUT m, o, T4a
  113.                         swapped = -1
  114.                     END IF
  115.                     i = i + 1
  116.                 LOOP UNTIL i + gap > EC
  117.             LOOP UNTIL gap = 1 AND swapped = 0
  118.         CASE 5 'DOUBLE
  119.             DIM T5a AS DOUBLE, T5b AS DOUBLE
  120.             gap = EC
  121.             DO
  122.                 gap = 10 * gap \ 13
  123.                 IF gap < 1 THEN gap = 1
  124.                 i = 0
  125.                 swapped = 0
  126.                 DO
  127.                     o = m.OFFSET + i * 8
  128.                     o1 = m.OFFSET + (i + gap) * 8
  129.                     IF _MEMGET(m, o, DOUBLE) > _MEMGET(m, o1, DOUBLE) THEN
  130.                         _MEMGET m, o1, T5a
  131.                         _MEMGET m, o, T5b
  132.                         _MEMPUT m, o1, T5b
  133.                         _MEMPUT m, o, T5a
  134.                         swapped = -1
  135.                     END IF
  136.                     i = i + 1
  137.                 LOOP UNTIL i + gap > EC
  138.             LOOP UNTIL gap = 1 AND swapped = 0
  139.         CASE 6 ' _FLOAT
  140.             DIM T6a AS _FLOAT, T6b AS _FLOAT
  141.             gap = EC
  142.             DO
  143.                 gap = 10 * gap \ 13
  144.                 IF gap < 1 THEN gap = 1
  145.                 i = 0
  146.                 swapped = 0
  147.                 DO
  148.                     o = m.OFFSET + i * 32
  149.                     o1 = m.OFFSET + (i + gap) * 32
  150.                     IF _MEMGET(m, o, _FLOAT) > _MEMGET(m, o1, _FLOAT) THEN
  151.                         _MEMGET m, o1, T6a
  152.                         _MEMGET m, o, T6b
  153.                         _MEMPUT m, o1, T6b
  154.                         _MEMPUT m, o, T6a
  155.                         swapped = -1
  156.                     END IF
  157.                     i = i + 1
  158.                 LOOP UNTIL i + gap > EC
  159.             LOOP UNTIL gap = 1 AND swapped = 0
  160.         CASE 7 'String
  161.             DIM T7a AS STRING, T7b AS STRING, T7c AS STRING
  162.             T7a = SPACE$(ES): T7b = SPACE$(ES): T7c = SPACE$(ES)
  163.             gap = EC
  164.             DO
  165.                 gap = INT(gap / 1.247330950103979)
  166.                 IF gap < 1 THEN gap = 1
  167.                 i = 0
  168.                 swapped = 0
  169.                 DO
  170.                     o = m.OFFSET + i * ES
  171.                     o1 = m.OFFSET + (i + gap) * ES
  172.                     _MEMGET m, o, T7a
  173.                     _MEMGET m, o1, T7b
  174.                     IF T7a > T7b THEN
  175.                         T7c = T7b
  176.                         _MEMPUT m, o1, T7a
  177.                         _MEMPUT m, o, T7c
  178.                         swapped = -1
  179.                     END IF
  180.                     i = i + 1
  181.                 LOOP UNTIL i + gap > EC
  182.             LOOP UNTIL gap = 1 AND swapped = false
  183.         CASE 8 '_INTEGER64
  184.             DIM T8a AS _INTEGER64, T8b AS _INTEGER64
  185.             gap = EC
  186.             DO
  187.                 gap = 10 * gap \ 13
  188.                 IF gap < 1 THEN gap = 1
  189.                 i = 0
  190.                 swapped = 0
  191.                 DO
  192.                     o = m.OFFSET + i * 8
  193.                     o1 = m.OFFSET + (i + gap) * 8
  194.                     IF _MEMGET(m, o, _INTEGER64) > _MEMGET(m, o1, _INTEGER64) THEN
  195.                         _MEMGET m, o1, T8a
  196.                         _MEMGET m, o, T8b
  197.                         _MEMPUT m, o1, T8b
  198.                         _MEMPUT m, o, T8a
  199.                         swapped = -1
  200.                     END IF
  201.                     i = i + 1
  202.                 LOOP UNTIL i + gap > EC
  203.             LOOP UNTIL gap = 1 AND swapped = 0
  204.         CASE 11: '_UNSIGNED _BYTE
  205.             DIM temp11(0 TO 255) AS _UNSIGNED LONG
  206.             DIM t11 AS _UNSIGNED _BYTE
  207.             i = 0
  208.             DO
  209.                 _MEMGET m, m.OFFSET + i, t11
  210.                 temp11(t11) = temp11(t11) + 1
  211.                 i = i + 1
  212.             LOOP UNTIL i > EC
  213.             i1 = 0
  214.             DO
  215.                 DO UNTIL temp11(i1) = 0
  216.                     _MEMPUT m, m.OFFSET + counter, i1 AS _UNSIGNED _BYTE
  217.                     counter = counter + 1
  218.                     temp11(i1) = temp11(i1) - 1
  219.                     IF counter > EC THEN EXIT SUB
  220.                 LOOP
  221.                 i1 = i1 + 1
  222.             LOOP UNTIL i1 > 255
  223.         CASE 12 '_UNSIGNED INTEGER
  224.             DIM temp12(0 TO 65535) AS _UNSIGNED LONG
  225.             DIM t12 AS _UNSIGNED INTEGER
  226.             i = 0
  227.             DO
  228.                 _MEMGET m, m.OFFSET + i * 2, t12
  229.                 temp12(t12) = temp12(t12) + 1
  230.                 i = i + 1
  231.             LOOP UNTIL i > EC
  232.             i1 = 0
  233.             DO
  234.                 DO UNTIL temp12(i1) = 0
  235.                     _MEMPUT m, m.OFFSET + counter * 2, i1 AS _UNSIGNED INTEGER
  236.                     counter = counter + 1
  237.                     temp12(i1) = temp12(i1) - 1
  238.                     IF counter > EC THEN EXIT SUB
  239.                 LOOP
  240.                 i1 = i1 + 1
  241.             LOOP UNTIL i1 > 65535
  242.         CASE 14 '_UNSIGNED LONG
  243.             DIM T14a AS _UNSIGNED LONG, T14b AS _UNSIGNED LONG
  244.             gap = EC
  245.             DO
  246.                 gap = 10 * gap \ 13
  247.                 IF gap < 1 THEN gap = 1
  248.                 i = 0
  249.                 swapped = 0
  250.                 DO
  251.                     o = m.OFFSET + i * 4
  252.                     o1 = m.OFFSET + (i + gap) * 4
  253.                     IF _MEMGET(m, o, _UNSIGNED LONG) > _MEMGET(m, o1, _UNSIGNED LONG) THEN
  254.                         _MEMGET m, o1, T14a
  255.                         _MEMGET m, o, T14b
  256.                         _MEMPUT m, o1, T14b
  257.                         _MEMPUT m, o, T14a
  258.                         swapped = -1
  259.                     END IF
  260.                     i = i + 1
  261.                 LOOP UNTIL i + gap > EC
  262.             LOOP UNTIL gap = 1 AND swapped = 0
  263.         CASE 18: '_UNSIGNED _INTEGER64
  264.             DIM T18a AS _UNSIGNED _INTEGER64, T18b AS _UNSIGNED _INTEGER64
  265.             gap = EC
  266.             DO
  267.                 gap = 10 * gap \ 13
  268.                 IF gap < 1 THEN gap = 1
  269.                 i = 0
  270.                 swapped = 0
  271.                 DO
  272.                     o = m.OFFSET + i * 8
  273.                     o1 = m.OFFSET + (i + gap) * 8
  274.                     IF _MEMGET(m, o, _UNSIGNED _INTEGER64) > _MEMGET(m, o1, _UNSIGNED _INTEGER64) THEN
  275.                         _MEMGET m, o1, T18a
  276.                         _MEMGET m, o, T18b
  277.                         _MEMPUT m, o1, T18b
  278.                         _MEMPUT m, o, T18a
  279.                         swapped = -1
  280.                     END IF
  281.                     i = i + 1
  282.                 LOOP UNTIL i + gap > EC
  283.             LOOP UNTIL gap = 1 AND swapped = 0
  284.     END SELECT
  286.  

Use with the "korea.jpg" attached to the first post.
Compile and run.
Hit a key when ready...
...and watch it unscramble all of your colors and arrange them in order from smallest RGB value to largest!

(Works in SCREEN 0 and 256-color mode as well!)
Title: Re: Unscramble the picture puzzle
Post by: Dav on January 27, 2021, 06:36:15 pm
Wow, Steve, you put a lot of work into that obviously. Thanks for sharing it with me.

The code is beyond me, ill have to put on a pot of coffee and study it (the code, not coffee).

I was thinking what a cool effect it would be to reverse that, and assemble the picture from the color order.

Thanks for posting

- Dav
Title: Re: Unscramble the picture puzzle
Post by: SMcNeill on January 27, 2021, 06:42:04 pm
Quote from: Dav on January 27, 2021, 06:36:15 pm
Wow, Steve, you put a lot of work into that obviously. Thanks for sharing it with me.

The code is beyond me, ill have to put on a pot of coffee and study it (the code, not coffee).

I was thinking what a cool effect it would be to reverse that, and assemble the picture from the color order.

Thanks for posting

- Dav

Actually, it took about 2 minutes to do.

Sort is my _MEMSORT routine which has been on the forums here forever: https://www.qb64.org/forum/index.php?topic=1601.0

I just commented out one line in it that error checks for non-array types, and then pasted it.  Here’s the actual I just wrote:

SCREEN _LOADIMAGE("korea.jpg", 32)
DIM m AS _MEM
SLEEP
 
m = _MEMIMAGE(0)
Sort m
SLEEP

************

Print some stuff on a SCREEN 0 text screen and try it.  It’s easier there to comprehend the results when it “unscrambles” the letters on the screen.  ;)
Title: Re: Unscramble the picture puzzle
Post by: Pete on January 27, 2021, 07:24:00 pm
SCREEN ZERO rides again!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

Pete
Title: Re: Unscramble the picture puzzle
Post by: SMcNeill on January 28, 2021, 07:51:23 am
You know, I was thinking about my little image sort experiment last night.  At first, I just tried it as a fun experiment...  Now I’m wondering if it might actually be useful for something — like quickly gathering the colors for a palette of an image.

Normally we’d start with a blank palette, and read pixel-by-pixel, and build and compare against our palette as we go.  By the time we go from top left to bottom right, we might be doing thousands of comparisons per pixel, if the image has a large palette...

But if we sort the image first, all we’d ever need to compare is the previous pixel’s color.

IF this_pixel_color <> last_pixel_color THEN
   increase_palette_by_one
   last_pixel_color = this_pixel_color
END IF

Seems to me that it might be a whole lot faster and more efficient manner to build a color palette index, than just the pixel-by-pixel approach! 

Isn’t it funny how even joking around and goofing off can sometimes lead to substantial improvements in things?  ;D
Title: Re: Unscramble the picture puzzle
Post by: SierraKen on February 04, 2021, 05:57:08 pm
This is awesome Dav and Steve! Good job.
Text Only | Text with Attachments