# QB64.org Forum

## Active Forums => Programs => Topic started by: DANILIN on January 24, 2021, 06:40:55 PM

Title: Diagonal snake filling array qb64 qbasic: witty task
Post by: DANILIN on January 24, 2021, 06:40:55 PM
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
Title: Re: Diagonal snake filling array qb64 qbasic: witty task
Post by: Pete on January 24, 2021, 06:46:40 PM
Is this like connect the dots or what? It's a simple enough to read and connect pattern, so what's the deal?

Pete
Title: Re: Diagonal snake filling array qb64 qbasic: witty task
Post by: SMcNeill on January 24, 2021, 08:40:05 PM
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.
Title: Re: Diagonal snake filling array qb64 qbasic: witty task
Post by: Pete on January 24, 2021, 08:46:22 PM
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
Title: Re: Diagonal snake filling array qb64 qbasic: witty task
Post by: NOVARSEG on January 24, 2021, 09:55:59 PM
is that some kinda matrix?
Title: Re: Diagonal snake filling array qb64 qbasic: witty task
Post by: FellippeHeitor on January 24, 2021, 10:03:44 PM
Some cheating involved, but looks good.

Code: QB64: [Select]
1.     state AS _BYTE
2.
3. size = 20
4.
5. SCREEN _NEWIMAGE(size * 40, size * 40, 32)
6. PRINT "Hit a key..."
7.
8. DIM map(1 TO 1639) AS pos
9.
10. direction = -1
11.
12. map(1).x = 0
13. map(1).y = 0
14. map(1).c = _RGB32(255)
15.
16. map(2).x = size
17. map(2).y = 0
18. map(2).c = _RGB32(250)
19.
20. x = size
21. y = 0
22. c = 250
23.
24. FOR i = 1 TO UBOUND(map)
25.     IF i < 3 THEN GOTO drawIt
26.     IF direction = 1 THEN
27.         x = x + size - (skip * size)
28.         y = y - size + ((skip * 2) * size)
29.         skip = 0
30.         IF y <= 0 OR x >= size * 40 - size THEN
31.             direction = -1
32.             c = c - 5
33.             skip = 1
34.     ELSEIF direction = -1 THEN
35.         x = x - size + ((skip * 2) * size)
36.         y = y + size - (skip * size)
37.         skip = 0
38.         IF x <= 0 OR y >= size * 40 - size THEN
39.             direction = 1
40.             c = c - 5
41.             skip = 1
42.
43.     map(i).x = x
44.     map(i).y = y
45.     map(i).c = _RGB32(c)
46.
47.     drawIt:
48.     'PSET (map(i).x, map(i).y)
49.     LINE (map(i).x, map(i).y)-STEP(size - 1, size - 1), map(i).c, BF
50.     LINE (map(i).x, map(i).y)-STEP(size - 1, size - 1), _RGB32(255, 40), B
51.     _LIMIT 60
52.
Title: Re: Diagonal snake filling array qb64 qbasic: witty task
Post by: Pete on January 24, 2021, 10:24:35 PM
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
Title: Re: Diagonal snake filling array qb64 qbasic: witty task
Post by: NOVARSEG on January 25, 2021, 12:00:49 AM
Looked on the net and there is some info on this.  Not sure what this algorithm does.
Title: Re: Diagonal snake filling array qb64 qbasic: witty task
Post by: bplus on January 25, 2021, 12:37:39 AM
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. place = 1: cnt = 1: dc = 1: startx = 1: starty = 1 ' init
6. anotherDiagonal:
7. slice\$ = MID\$(s\$, place * 4 - 3, cnt * 4): toggle = 1 - toggle
8. IF toggle THEN '  reverse the numbers in slice\$
9.     b\$ = ""
10.     FOR i = 1 TO cnt
11.         b\$ = MID\$(slice\$, i * 4 - 3, 4) + b\$
12.     slice\$ = b\$
13. x = startx: y = starty
14. FOR i = 1 TO cnt
15.     LOCATE y + 1, (x - 1) * 4 + 1: PRINT MID\$(slice\$, i * 4 - 3, 4)
16.     x = x + 1: y = y - 1
17. IF starty + 1 > n THEN startx = startx + 1: starty = n ELSE starty = starty + 1: startx = 1
18. IF startx > n THEN SLEEP: END
19. place = place + cnt
20. IF cnt + dc > n THEN cnt = cnt - 1: dc = -1 ELSE cnt = cnt + dc
21. GOTO anotherDiagonal
22.
23.

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. place = 1: cnt = 1: dc = 1: startx = 1: starty = 1 ' init
6. anotherDiagonal:
7. slice\$ = MID\$(s\$, place * 4 - 3, cnt * 4): toggle = 1 - toggle
8. IF toggle = 0 THEN '  reverse the numbers in slice\$
9.     b\$ = ""
10.     FOR i = 1 TO cnt
11.         b\$ = MID\$(slice\$, i * 4 - 3, 4) + b\$
12.     slice\$ = b\$
13. x = startx: y = starty
14. FOR i = 1 TO cnt
15.     LOCATE y + 1, (x - 1) * 4 + 1: PRINT MID\$(slice\$, i * 4 - 3, 4)
16.     x = x + 1: y = y - 1
17. IF starty + 1 > n THEN startx = startx + 1: starty = n ELSE starty = starty + 1: startx = 1
18. IF startx > n THEN SLEEP: END
19. place = place + cnt
20. IF cnt + dc > n THEN cnt = cnt - 1: dc = -1 ELSE cnt = cnt + dc
21. GOTO anotherDiagonal
22.
23.
Title: Re: Diagonal snake filling array qb64 qbasic: witty task
Post by: SMcNeill on January 25, 2021, 12:53:23 AM
The simple solution, as I mentioned above -- represented here, graphically:

Code: QB64: [Select]
1. SCREEN _NEWIMAGE(640, 480, 32)
2. MinX = 0: MaxX = _WIDTH
3. MinY = 0: MaxY = _HEIGHT
4. PSET (0, 0), Yellow
5.     'go right
6.     IF X < MaxX THEN X = X + 1 ELSE Y = Y + 1 'move right or down
7.     IF Y > MaxY THEN EXIT DO
8.     PSET (X, Y), Yellow
9.     'fill diagional down
10.     DO UNTIL X = MinX OR Y = MaxY
11.         X = X - 1: Y = Y + 1
12.         PSET (X, Y), Yellow
13.     IF Y < MaxY THEN Y = Y + 1 ELSE X = X + 1 'move right or down
14.     IF X > MaxX THEN EXIT DO
15.     PSET (X, Y), Yellow
16.     'fill diagional down
17.     DO UNTIL X = MaxX OR Y = MinY
18.         X = X + 1: Y = Y - 1
19.         PSET (X, Y), Yellow
20.     _LIMIT 30
Title: Re: Diagonal snake filling array qb64 qbasic: witty task
Post by: SMcNeill on January 25, 2021, 01:10:45 AM
And a slower SCREEN 0 version so you can watch each step of the process at work:

Code: QB64: [Select]
1. MinX = 35: MaxX = 45
2. MinY = 5: MaxY = 20
3. COLOR Yellow
4. x = MinX: y = MinY
5. PSET0 x, y
6.     'go right
7.     IF x < MaxX THEN x = x + 1 ELSE y = y + 1 'move right or down
8.     IF y > MaxY THEN EXIT DO
9.     PSET0 x, y
10.     _DELAY .1
11.     'fill diagional down
12.     DO UNTIL x = MinX OR y = MaxY
13.         x = x - 1: y = y + 1
14.         PSET0 x, y
15.         _DELAY .1
16.     IF y < MaxY THEN y = y + 1 ELSE x = x + 1 'move right or down
17.     IF x > MaxX THEN EXIT DO
18.     PSET0 x, y
19.     _DELAY .1
20.     'fill diagional down
21.     DO UNTIL x = MaxX OR y = MinY
22.         x = x + 1: y = y - 1
23.         PSET0 x, y
24.         _DELAY .1
25.
26.
27. SUB PSET0 (x, y)
28.     LOCATE y, x
29.     PRINT "Ã›";
Title: Re: Diagonal snake filling array qb64 qbasic: witty task
Post by: DANILIN on January 25, 2021, 03:22:38 PM
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.         k = k + 1
5.         a(x, y) = k
6.         x = x + s: y = y + s
7.     LOOP UNTIL x > n OR y > n OR x < 1 OR y < 1
8.     IF x < 1 AND y < 1 THEN x = 1: y = 2
9.     IF x > n AND y > n THEN x = n - 1: y = n
10.     IF y < 1 THEN y = 1
11.     IF x < 1 THEN x = 1: y = y + 2
12.     IF x > n THEN x = n:
13.     IF y > n THEN x = x - 2: y = n
14.     s = -s
15. LOOP UNTIL k = n * n
16. FOR x = 1 TO n: FOR y = 1 TO n
17.         PRINT a(x, y),

Code: [Select]
`15 16 22 23 257 14 17 21 246 8 13 18 202 5 9 12 191 3 4 10 11`
Title: Re: Diagonal snake filling array qb64 qbasic: witty task
Post by: bplus on January 25, 2021, 07:02:28 PM
Well I guess we could snake from any corner, I was considering from opposite corners both!

Title: Re: Diagonal snake filling array qb64 qbasic: witty task
Post by: bplus on January 25, 2021, 11:02:01 PM
@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.
6. COLOR , &H00000000
7. n = 40 ' change as needed
8. DIM a(n, n) AS STRING * 1
9. b\$ = "SNAKE,"
10. FOR i = 1 TO 500
11.     s\$ = s\$ + b\$
12. x = n: y = 1: s = -1 ' <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< oh dang! you do x,y backwards!!!
13. lastx = (y - 1) * 16 + 4: lasty = (x - 1) * 16 + 8
14.         k = k + 1
15.         a(x, y) = MID\$(s\$, k, 1)
16.         thic lastx, lasty, (y - 1) * 16 + 4, (x - 1) * 16 + 8, 4, &HAAFFFF00
17.         lastx = (y - 1) * 16 + 4: lasty = (x - 1) * 16 + 8
18.         x = x + s: y = y + s
19.     LOOP UNTIL x > n OR y > n OR x < 1 OR y < 1
20.     IF x < 1 AND y < 1 THEN x = 1: y = 2
21.     IF x > n AND y > n THEN x = n - 1: y = n
22.     IF y < 1 THEN y = 1
23.     IF x < 1 THEN x = 1: y = y + 2
24.     IF x > n THEN x = n:
25.     IF y > n THEN x = x - 2: y = n
26.     s = -s
27. LOOP UNTIL k = n * n
28. FOR x = 1 TO n
29.     FOR y = 1 TO n
30.         _PRINTSTRING ((y - 1) * 16, (x - 1) * 16), a(x, y)
31.
32.
33. SUB thic (x1, y1, x2, y2, thick, K AS _UNSIGNED LONG)
34.     DIM PD2 AS DOUBLE, t2 AS SINGLE, a AS SINGLE, x3 AS SINGLE, y3 AS SINGLE, x4 AS SINGLE, y4 AS SINGLE
35.     DIM x5 AS SINGLE, y5 AS SINGLE, x6 AS SINGLE, y6 AS SINGLE
36.     PD2 = 1.570796326794897
37.     t2 = thick / 2
38.     IF t2 < 1 THEN t2 = 1
39.     a = _ATAN2(y2 - y1, x2 - x1)
40.     x3 = x1 + t2 * COS(a + PD2)
41.     y3 = y1 + t2 * SIN(a + PD2)
42.     x4 = x1 + t2 * COS(a - PD2)
43.     y4 = y1 + t2 * SIN(a - PD2)
44.     x5 = x2 + t2 * COS(a + PD2)
45.     y5 = y2 + t2 * SIN(a + PD2)
46.     x6 = x2 + t2 * COS(a - PD2)
47.     y6 = y2 + t2 * SIN(a - PD2)
48.     ftri x6, y6, x4, y4, x3, y3, K
49.     ftri x3, y3, x5, y5, x6, y6, K
50.
51. '2019-12-16 fix by Steve saves some time with STATIC and saves and restores last dest
52. SUB ftri (x1, y1, x2, y2, x3, y3, K AS _UNSIGNED LONG)
53.     STATIC a&
54.     D = _DEST
55.     IF a& = 0 THEN a& = _NEWIMAGE(1, 1, 32)
56.     _DEST a&
57.     _DONTBLEND a& '  '<<<< new 2019-12-16 fix
58.     PSET (0, 0), K
59.     _BLEND a& '<<<< new 2019-12-16 fix
60.     _MAPTRIANGLE _SEAMLESS(0, 0)-(0, 0)-(0, 0), a& TO(x1, y1)-(x2, y2)-(x3, y3)
61.
62.
63.

Title: Re: Diagonal snake filling array qb64 qbasic: witty task
Post by: bplus on April 08, 2021, 01:27:27 AM
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.         k = k + 1
9.         c(0) = x: r(0) = y
10.         For i = 0 To 4
11.             If (c(i) > 0) And (r(i) > 0) Then Locate r(i), c(i) * 2: Print Mid\$(b\$, i + 1, 1);
12.         For i = 3 To 0 Step -1
13.             c(i + 1) = c(i): r(i + 1) = r(i)
14.         _Delay .05
15.         x = x + s: y = y + s
16.     Loop Until x > 40 Or y > 25 Or x < 1 Or y < 1
17.     If switch Then
18.         If x < 1 And y < 1 Then x = 2: y = 1 '
19.         If x > 40 And y > 25 Then x = 40: y = 25 - 2 '
20.         If y < 1 Then y = 1: x = x + 2 '
21.         If x < 1 Then x = 1 '
22.         If x > 40 Then x = 40: y = y - 2 '
23.         If y > 25 Then y = 25 '
24.         If x < 1 And y < 1 Then x = 1: y = 2
25.         If x > 40 And y > 25 Then x = 40 - 1: y = 25
26.         If y < 1 Then y = 1
27.         If x < 1 Then x = 1: y = y + 2
28.         If x > 40 Then x = 40
29.         If y > 25 Then x = x - 2: y = 25
30.     s = -1 * s
31. Loop Until k = 25 * 40
32. k = 0
33. ReDim c(4), r(4)
34. If switch Then
35.     x = 40: y = 1: s = -1
36.     x = 1: y = 25
37. switch = 1 - switch
38. GoTo restart
39.
40.