Diagonal snake filling array qb64 qbasic: witty task

[DANILIN]

Diagonal snake filling array: witty task

01 02 06 07
03 05 08 13
04 09 12 14
10 11 15 16

It is allowed to peek on Internet in other languages

I only get 1st corner so far

There are no universal solutions for all configurations anywhere

[Pete]

Is this like connect the dots or what? It's a simple enough to read and connect pattern, so what's the deal?

Pete

[SMcNeill]

Make a 2d array.
Start at 0,0.

DO
   Move right one.
   Fill diagonal left/down.
   Move down one.
   Fill diagonal up/roght.
LOOP until all is filled.

[Pete]

Honestly Steve, I don't know if I'd even fiddle with it if I wasn't working on a current project, because in theory, it seems so freakin' easy.

Pete

[NOVARSEG]

is that some kinda matrix?

[FellippeHeitor]

Some cheating involved, but looks good.

Code: QB64: [Select]

1. TYPE pos
2.     x AS INTEGER
3.     y AS INTEGER
4.     c AS _UNSIGNED LONG
5.     state AS _BYTE
6. END TYPE
7.  
8. size = 20
9.  
10. SCREEN _NEWIMAGE(size * 40, size * 40, 32)
11. PRINT "Hit a key..."
12. SLEEP
13.  
14. DIM map(1 TO 1639) AS pos
15.  
16. direction = -1
17.  
18. map(1).x = 0
19. map(1).y = 0
20. map(1).c = _RGB32(255)
21.  
22. map(2).x = size
23. map(2).y = 0
24. map(2).c = _RGB32(250)
25.  
26. x = size
27. y = 0
28. c = 250
29.  
30. FOR i = 1 TO UBOUND(map)
31.     IF i < 3 THEN GOTO drawIt
32.     IF direction = 1 THEN
33.         x = x + size - (skip * size)
34.         y = y - size + ((skip * 2) * size)
35.         skip = 0
36.         IF y <= 0 OR x >= size * 40 - size THEN
37.             direction = -1
38.             c = c - 5
39.             skip = 1
40.         END IF
41.     ELSEIF direction = -1 THEN
42.         x = x - size + ((skip * 2) * size)
43.         y = y + size - (skip * size)
44.         skip = 0
45.         IF x <= 0 OR y >= size * 40 - size THEN
46.             direction = 1
47.             c = c - 5
48.             skip = 1
49.         END IF
50.     END IF
51.  
52.     map(i).x = x
53.     map(i).y = y
54.     map(i).c = _RGB32(c)
55.  
56.     drawIt:
57.     'PSET (map(i).x, map(i).y)
58.     LINE (map(i).x, map(i).y)-STEP(size - 1, size - 1), map(i).c, BF
59.     LINE (map(i).x, map(i).y)-STEP(size - 1, size - 1), _RGB32(255, 40), B
60.     _LIMIT 60
61.     _DISPLAY
62. NEXT
63.  
64. SLEEP

[Pete]

Just think outside the box...

00 00 01 02 06 07 00 00 00
00 00 03 05 08 13 00 00 00
00 00 04 09 12 14 00 00 00
00 00 10 11 15 16 00 00 00

Now from 01 go right 1, diagonal down 3. Right 1, diagonal up 3... and keep repeating the pattern until the numbered elements are all filled in.

And I see Fell came up with some code, as well.

Pete

[NOVARSEG]

Looked on the net and there is some info on this.  Not sure what this algorithm does.

[bplus]

Well I guess you could say it's too easy to do, ha! lazy ways...

Code: QB64: [Select]

1. _TITLE "N x N Matrix Diagonal Snake" ' b+ 2021-01-25
2. n = 19 '<<<<  plug in here  19 is limit for screen 0
3. FOR i = 1 TO n * n ' make our string of numbers
4.     s$ = s$ + RIGHT$("   " + _TRIM$(STR$(i)), 4)
5. NEXT
6. place = 1: cnt = 1: dc = 1: startx = 1: starty = 1 ' init
7. anotherDiagonal:
8. slice$ = MID$(s$, place * 4 - 3, cnt * 4): toggle = 1 - toggle
9. IF toggle THEN '  reverse the numbers in slice$
10.     b$ = ""
11.     FOR i = 1 TO cnt
12.         b$ = MID$(slice$, i * 4 - 3, 4) + b$
13.     NEXT
14.     slice$ = b$
15. END IF
16. x = startx: y = starty
17. FOR i = 1 TO cnt
18.     LOCATE y + 1, (x - 1) * 4 + 1: PRINT MID$(slice$, i * 4 - 3, 4)
19.     x = x + 1: y = y - 1
20. NEXT
21. IF starty + 1 > n THEN startx = startx + 1: starty = n ELSE starty = starty + 1: startx = 1
22. IF startx > n THEN SLEEP: END
23. place = place + cnt
24. IF cnt + dc > n THEN cnt = cnt - 1: dc = -1 ELSE cnt = cnt + dc
25. GOTO anotherDiagonal
26.  
27.  

Oh in case you insist on putting 2 to the right of 1 then:

Code: QB64: [Select]

1. _TITLE "N x N Matrix Diagonal Snake" ' b+ 2021-01-25
2. n = 19 '<<<<  plug in here  19 is limit for screen 0
3. FOR i = 1 TO n * n ' make our string of numbers
4.     s$ = s$ + RIGHT$("   " + _TRIM$(STR$(i)), 4)
5. NEXT
6. place = 1: cnt = 1: dc = 1: startx = 1: starty = 1 ' init
7. anotherDiagonal:
8. slice$ = MID$(s$, place * 4 - 3, cnt * 4): toggle = 1 - toggle
9. IF toggle = 0 THEN '  reverse the numbers in slice$
10.     b$ = ""
11.     FOR i = 1 TO cnt
12.         b$ = MID$(slice$, i * 4 - 3, 4) + b$
13.     NEXT
14.     slice$ = b$
15. END IF
16. x = startx: y = starty
17. FOR i = 1 TO cnt
18.     LOCATE y + 1, (x - 1) * 4 + 1: PRINT MID$(slice$, i * 4 - 3, 4)
19.     x = x + 1: y = y - 1
20. NEXT
21. IF starty + 1 > n THEN startx = startx + 1: starty = n ELSE starty = starty + 1: startx = 1
22. IF startx > n THEN SLEEP: END
23. place = place + cnt
24. IF cnt + dc > n THEN cnt = cnt - 1: dc = -1 ELSE cnt = cnt + dc
25. GOTO anotherDiagonal
26.  
27.  

[SMcNeill]

The simple solution, as I mentioned above -- represented here, graphically:

Code: QB64: [Select]

1. SCREEN _NEWIMAGE(640, 480, 32)
2. $COLOR:32
3. MinX = 0: MaxX = _WIDTH
4. MinY = 0: MaxY = _HEIGHT
5. PSET (0, 0), Yellow
6. DO
7.     'go right
8.     IF X < MaxX THEN X = X + 1 ELSE Y = Y + 1 'move right or down
9.     IF Y > MaxY THEN EXIT DO
10.     PSET (X, Y), Yellow
11.     'fill diagional down
12.     DO UNTIL X = MinX OR Y = MaxY
13.         X = X - 1: Y = Y + 1
14.         PSET (X, Y), Yellow
15.     LOOP
16.     IF Y < MaxY THEN Y = Y + 1 ELSE X = X + 1 'move right or down
17.     IF X > MaxX THEN EXIT DO
18.     PSET (X, Y), Yellow
19.     'fill diagional down
20.     DO UNTIL X = MaxX OR Y = MinY
21.         X = X + 1: Y = Y - 1
22.         PSET (X, Y), Yellow
23.     LOOP
24.     _LIMIT 30
25. LOOP UNTIL _KEYHIT

[SMcNeill]

And a slower SCREEN 0 version so you can watch each step of the process at work:

Code: QB64: [Select]

1. $COLOR:0
2. MinX = 35: MaxX = 45
3. MinY = 5: MaxY = 20
4. COLOR Yellow
5. x = MinX: y = MinY
6. PSET0 x, y
7. DO
8.     'go right
9.     IF x < MaxX THEN x = x + 1 ELSE y = y + 1 'move right or down
10.     IF y > MaxY THEN EXIT DO
11.     PSET0 x, y
12.     _DELAY .1
13.     'fill diagional down
14.     DO UNTIL x = MinX OR y = MaxY
15.         x = x - 1: y = y + 1
16.         PSET0 x, y
17.         _DELAY .1
18.     LOOP
19.     IF y < MaxY THEN y = y + 1 ELSE x = x + 1 'move right or down
20.     IF x > MaxX THEN EXIT DO
21.     PSET0 x, y
22.     _DELAY .1
23.     'fill diagional down
24.     DO UNTIL x = MaxX OR y = MinY
25.         x = x + 1: y = y - 1
26.         PSET0 x, y
27.         _DELAY .1
28.     LOOP
29.  
30. LOOP UNTIL _KEYHIT
31.  
32. SUB PSET0 (x, y)
33.     LOCATE y, x
34.     PRINT "Û";
35. END SUB

[DANILIN]

2010 year program for qb64 & qbasic & quick basic

Code: QB64: [Select]

1. 'zmeyrus.bas
2. n = 5: DIM a(n, n)
3. x = n: y = 1: s = -1
4. DO
5.     DO
6.         k = k + 1
7.         a(x, y) = k
8.         x = x + s: y = y + s
9.     LOOP UNTIL x > n OR y > n OR x < 1 OR y < 1
10.     IF x < 1 AND y < 1 THEN x = 1: y = 2
11.     IF x > n AND y > n THEN x = n - 1: y = n
12.     IF y < 1 THEN y = 1
13.     IF x < 1 THEN x = 1: y = y + 2
14.     IF x > n THEN x = n:
15.     IF y > n THEN x = x - 2: y = n
16.     s = -s
17. LOOP UNTIL k = n * n
18. FOR x = 1 TO n: FOR y = 1 TO n
19.         PRINT a(x, y),
20. NEXT: PRINT: NEXT
21. END

Code: [Select]

15 16 22 23 25
7 14 17 21 24
6 8 13 18 20
2 5 9 12 19
1 3 4 10 11

[bplus]

Well I guess we could snake from any corner, I was considering from opposite corners both!

[bplus]

@DANILIN I modified your code so:
1. you can do more than n = 5, I've got a test run with 40 x 40
2. you see the snake slither it's way from one corner to the opposite
3. I drew the snake path with thick line and then after a pause drew in the letters.

I see you have all your x, y backwards, that was confusing for a moment. ;-))

You probably won't like all the LOC but you might like the results :)

Code: QB64: [Select]

1. 'zmeyrus.bas  Danilin copy 2021-01-25  and b+ mod
2. _TITLE "b+ mod of Danilin Matrix Diagonal Snake"
3. SCREEN _NEWIMAGE(640, 640, 32)
4. _DELAY .25
5. _SCREENMOVE _MIDDLE
6.  
7. COLOR , &H00000000
8. n = 40 ' change as needed
9. DIM a(n, n) AS STRING * 1
10. b$ = "SNAKE,"
11. FOR i = 1 TO 500
12.     s$ = s$ + b$
13. NEXT
14. x = n: y = 1: s = -1 ' <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< oh dang! you do x,y backwards!!!
15. lastx = (y - 1) * 16 + 4: lasty = (x - 1) * 16 + 8
16. DO
17.     DO
18.         k = k + 1
19.         a(x, y) = MID$(s$, k, 1)
20.         thic lastx, lasty, (y - 1) * 16 + 4, (x - 1) * 16 + 8, 4, &HAAFFFF00
21.         lastx = (y - 1) * 16 + 4: lasty = (x - 1) * 16 + 8
22.         x = x + s: y = y + s
23.     LOOP UNTIL x > n OR y > n OR x < 1 OR y < 1
24.     IF x < 1 AND y < 1 THEN x = 1: y = 2
25.     IF x > n AND y > n THEN x = n - 1: y = n
26.     IF y < 1 THEN y = 1
27.     IF x < 1 THEN x = 1: y = y + 2
28.     IF x > n THEN x = n:
29.     IF y > n THEN x = x - 2: y = n
30.     s = -s
31. LOOP UNTIL k = n * n
32. _DELAY 3
33. FOR x = 1 TO n
34.     FOR y = 1 TO n
35.         _PRINTSTRING ((y - 1) * 16, (x - 1) * 16), a(x, y)
36.     NEXT
37. NEXT
38. SLEEP
39. END
40.  
41.  
42. SUB thic (x1, y1, x2, y2, thick, K AS _UNSIGNED LONG)
43.     DIM PD2 AS DOUBLE, t2 AS SINGLE, a AS SINGLE, x3 AS SINGLE, y3 AS SINGLE, x4 AS SINGLE, y4 AS SINGLE
44.     DIM x5 AS SINGLE, y5 AS SINGLE, x6 AS SINGLE, y6 AS SINGLE
45.     PD2 = 1.570796326794897
46.     t2 = thick / 2
47.     IF t2 < 1 THEN t2 = 1
48.     a = _ATAN2(y2 - y1, x2 - x1)
49.     x3 = x1 + t2 * COS(a + PD2)
50.     y3 = y1 + t2 * SIN(a + PD2)
51.     x4 = x1 + t2 * COS(a - PD2)
52.     y4 = y1 + t2 * SIN(a - PD2)
53.     x5 = x2 + t2 * COS(a + PD2)
54.     y5 = y2 + t2 * SIN(a + PD2)
55.     x6 = x2 + t2 * COS(a - PD2)
56.     y6 = y2 + t2 * SIN(a - PD2)
57.     ftri x6, y6, x4, y4, x3, y3, K
58.     ftri x3, y3, x5, y5, x6, y6, K
59. END SUB
60.  
61. '2019-12-16 fix by Steve saves some time with STATIC and saves and restores last dest
62. SUB ftri (x1, y1, x2, y2, x3, y3, K AS _UNSIGNED LONG)
63.     DIM D AS LONG
64.     STATIC a&
65.     D = _DEST
66.     IF a& = 0 THEN a& = _NEWIMAGE(1, 1, 32)
67.     _DEST a&
68.     _DONTBLEND a& '  '<<<< new 2019-12-16 fix
69.     PSET (0, 0), K
70.     _BLEND a& '<<<< new 2019-12-16 fix
71.     _DEST D
72.     _MAPTRIANGLE _SEAMLESS(0, 0)-(0, 0)-(0, 0), a& TO(x1, y1)-(x2, y2)-(x3, y3)
73. END SUB
74.  
75.  
76.  

[bplus]

I was fooling around with this code at JB and came up with this mod:

Code: QB64: [Select]

1. _Title "Snake Diagonally to fill space" ' b+ mod 2021-04-08
2. ' ref :  https://www.qb64.org/forum/index.php?topic=3542.msg128657#msg128657
3.  
4. b$ = "SNAKE"
5. ReDim c(4), r(4)
6. x = 40: y = 1: s = -1
7. restart:
8. Do
9.     Do
10.         Cls
11.         k = k + 1
12.         c(0) = x: r(0) = y
13.         For i = 0 To 4
14.             If (c(i) > 0) And (r(i) > 0) Then Locate r(i), c(i) * 2: Print Mid$(b$, i + 1, 1);
15.         Next
16.         For i = 3 To 0 Step -1
17.             c(i + 1) = c(i): r(i + 1) = r(i)
18.         Next
19.         _Delay .05
20.         x = x + s: y = y + s
21.     Loop Until x > 40 Or y > 25 Or x < 1 Or y < 1
22.     If switch Then
23.         If x < 1 And y < 1 Then x = 2: y = 1 '
24.         If x > 40 And y > 25 Then x = 40: y = 25 - 2 '
25.         If y < 1 Then y = 1: x = x + 2 '
26.         If x < 1 Then x = 1 '
27.         If x > 40 Then x = 40: y = y - 2 '
28.         If y > 25 Then y = 25 '
29.     Else
30.         If x < 1 And y < 1 Then x = 1: y = 2
31.         If x > 40 And y > 25 Then x = 40 - 1: y = 25
32.         If y < 1 Then y = 1
33.         If x < 1 Then x = 1: y = y + 2
34.         If x > 40 Then x = 40
35.         If y > 25 Then x = x - 2: y = 25
36.     End If
37.     s = -1 * s
38. Loop Until k = 25 * 40
39. Cls
40. k = 0
41. ReDim c(4), r(4)
42. If switch Then
43.     x = 40: y = 1: s = -1
44. Else
45.     x = 1: y = 25
46. End If
47. switch = 1 - switch
48. GoTo restart
49.  
50.