Unscramble the picture puzzle

[Dav]

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.  
13. RANDOMIZE TIMER
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
38. 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)
44. NEXT
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
55. NEXT
56.  
57. '=== check if puzzle done
58. done = 1
59. FOR t = 1 TO row * col
60.     IF tilepuz(t) <> t THEN done = 0
61. NEXT
62. IF done = 1 THEN
63.     PLAY "mbl16cdefgfedc": _DELAY 4
64.     END 'Solved!
65. END IF
66.  
67.  
68. selected = 0
69.  
70. second:
71.  
72. DO
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
79.     IF _MOUSEBUTTON(1) THEN
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.  
118. LOOP
119.  
120. END
121.  

[NOVARSEG]

I had to cheat.

This could also be a picture viewer.

[Pete]

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

[Dav]

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

[Pete]

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

[Dav]

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.  
15. RANDOMIZE TIMER
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&
23. _FREEIMAGE 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
45. NEXT
46.  
47. FOR p = 1 TO UBOUND(tilepuz)
48.     tilepuz(p) = INT(RND * 4) + 1
49. NEXT
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.  
66. NEXT
67.  
68. _DISPLAY
69.  
70. '=== check if puzzle done
71. done = 1
72. FOR t = 1 TO row * col
73.     IF tilepuz(t) <> 1 THEN done = 0
74. NEXT
75. IF done = 1 THEN
76.     PLAY "mbl16cdefgfedc": _DELAY 4
77.     END 'Solved!
78. END IF
79.  
80.  
81.  
82. DO
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
89.     IF _MOUSEBUTTON(1) THEN
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.  
150. LOOP
151.  
152. END
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))
167. END SUB
168.  

[bplus]

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 :)

[Dav]

@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

[Dav]

... 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
3. END IF
4.  
5. SCREEN _NEWIMAGE(600, 600, 32)
6.  
7. DO
8.     _SCREENMOVE _MIDDLE
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
14. LOOP UNTIL INKEY$ <> ""
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))
29. END SUB
30.  

[bplus]

RotoZoom is such a handy thing.

Indeed! Check this out, in demo has several demos ends with dancing spikes just follow directions.

[Dav]

Wow!  The possibilities with this is great.  I'm gonna play with that for a while!

- Dav

[SMcNeill]

I've worked up an unscrambler for you:

Code: QB64: [Select]

1. SCREEN _LOADIMAGE("korea.jpg", 32)
2. DIM m AS _MEM
3. SLEEP
4.  
5.  
6. m = _MEMIMAGE(0)
7. Sort m
8. SLEEP
9.  
10. SUB Sort (m AS _MEM)
11.     DIM i AS _UNSIGNED LONG
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
285. END SUB
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!)

[Dav]

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

[SMcNeill]

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.  ;)

[Pete]

SCREEN ZERO rides again!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

Pete