Author Topic: Diagonal snake filling array qb64 qbasic: witty task  (Read 491 times)

0 Members and 1 Guest are viewing this topic.

Offline DANILIN

  • Forum Regular
  • Posts: 140
    • Danilin youtube
Diagonal snake filling array qb64 qbasic: witty task
« 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
Russia looks world from future. big data is peace data.
i never recommend anything to anyone and always write only about myself

Offline Pete

  • Forum Resident
  • Posts: 2554
  • Cuz I sez so, varmint!
Re: Diagonal snake filling array qb64 qbasic: witty task
« Reply #1 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

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3513
    • Steve’s QB64 Archive Forum
Re: Diagonal snake filling array qb64 qbasic: witty task
« Reply #2 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.
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline Pete

  • Forum Resident
  • Posts: 2554
  • Cuz I sez so, varmint!
Re: Diagonal snake filling array qb64 qbasic: witty task
« Reply #3 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

Offline NOVARSEG

  • Seasoned Forum Regular
  • Posts: 388
Re: Diagonal snake filling array qb64 qbasic: witty task
« Reply #4 on: January 24, 2021, 09:55:59 PM »
is that some kinda matrix?

Offline FellippeHeitor

  • QB64 Developer
  • Forum Resident
  • Posts: 2887
  • Let it go, this too shall pass.
    • QB64.org
Re: Diagonal snake filling array qb64 qbasic: witty task
« Reply #5 on: January 24, 2021, 10:03:44 PM »
Some cheating involved, but looks good.

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

Offline Pete

  • Forum Resident
  • Posts: 2554
  • Cuz I sez so, varmint!
Re: Diagonal snake filling array qb64 qbasic: witty task
« Reply #6 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

Offline NOVARSEG

  • Seasoned Forum Regular
  • Posts: 388
Re: Diagonal snake filling array qb64 qbasic: witty task
« Reply #7 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.

Offline bplus

  • Forum Resident
  • Posts: 6674
  • b = b + ...
Re: Diagonal snake filling array qb64 qbasic: witty task
« Reply #8 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.     NEXT
  13.     slice$ = b$
  14. x = startx: y = starty
  15. FOR i = 1 TO cnt
  16.     LOCATE y + 1, (x - 1) * 4 + 1: PRINT MID$(slice$, i * 4 - 3, 4)
  17.     x = x + 1: y = y - 1
  18. IF starty + 1 > n THEN startx = startx + 1: starty = n ELSE starty = starty + 1: startx = 1
  19. IF startx > n THEN SLEEP: END
  20. place = place + cnt
  21. IF cnt + dc > n THEN cnt = cnt - 1: dc = -1 ELSE cnt = cnt + dc
  22. GOTO anotherDiagonal
  23.  
  24.  

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.     NEXT
  13.     slice$ = b$
  14. x = startx: y = starty
  15. FOR i = 1 TO cnt
  16.     LOCATE y + 1, (x - 1) * 4 + 1: PRINT MID$(slice$, i * 4 - 3, 4)
  17.     x = x + 1: y = y - 1
  18. IF starty + 1 > n THEN startx = startx + 1: starty = n ELSE starty = starty + 1: startx = 1
  19. IF startx > n THEN SLEEP: END
  20. place = place + cnt
  21. IF cnt + dc > n THEN cnt = cnt - 1: dc = -1 ELSE cnt = cnt + dc
  22. GOTO anotherDiagonal
  23.  
  24.  
« Last Edit: January 25, 2021, 12:48:58 AM by bplus »

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3513
    • Steve’s QB64 Archive Forum
Re: Diagonal snake filling array qb64 qbasic: witty task
« Reply #9 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.     LOOP
  14.     IF Y < MaxY THEN Y = Y + 1 ELSE X = X + 1 'move right or down
  15.     IF X > MaxX THEN EXIT DO
  16.     PSET (X, Y), Yellow
  17.     'fill diagional down
  18.     DO UNTIL X = MaxX OR Y = MinY
  19.         X = X + 1: Y = Y - 1
  20.         PSET (X, Y), Yellow
  21.     LOOP
  22.     _LIMIT 30
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3513
    • Steve’s QB64 Archive Forum
Re: Diagonal snake filling array qb64 qbasic: witty task
« Reply #10 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.     LOOP
  17.     IF y < MaxY THEN y = y + 1 ELSE x = x + 1 'move right or down
  18.     IF x > MaxX THEN EXIT DO
  19.     PSET0 x, y
  20.     _DELAY .1
  21.     'fill diagional down
  22.     DO UNTIL x = MaxX OR y = MinY
  23.         x = x + 1: y = y - 1
  24.         PSET0 x, y
  25.         _DELAY .1
  26.     LOOP
  27.  
  28.  
  29. SUB PSET0 (x, y)
  30.     LOCATE y, x
  31.     PRINT "Û";
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline DANILIN

  • Forum Regular
  • Posts: 140
    • Danilin youtube
Re: Diagonal snake filling array qb64 qbasic: witty task
« Reply #11 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.     DO
  5.         k = k + 1
  6.         a(x, y) = k
  7.         x = x + s: y = y + s
  8.     LOOP UNTIL x > n OR y > n OR x < 1 OR y < 1
  9.     IF x < 1 AND y < 1 THEN x = 1: y = 2
  10.     IF x > n AND y > n THEN x = n - 1: y = n
  11.     IF y < 1 THEN y = 1
  12.     IF x < 1 THEN x = 1: y = y + 2
  13.     IF x > n THEN x = n:
  14.     IF y > n THEN x = x - 2: y = n
  15.     s = -s
  16. LOOP UNTIL k = n * n
  17. FOR x = 1 TO n: FOR y = 1 TO n
  18.         PRINT a(x, y),

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
Russia looks world from future. big data is peace data.
i never recommend anything to anyone and always write only about myself

Offline bplus

  • Forum Resident
  • Posts: 6674
  • b = b + ...
Re: Diagonal snake filling array qb64 qbasic: witty task
« Reply #12 on: January 25, 2021, 07:02:28 PM »
Well I guess we could snake from any corner, I was considering from opposite corners both!


Offline bplus

  • Forum Resident
  • Posts: 6674
  • b = b + ...
Re: Diagonal snake filling array qb64 qbasic: witty task
« Reply #13 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.     DO
  15.         k = k + 1
  16.         a(x, y) = MID$(s$, k, 1)
  17.         thic lastx, lasty, (y - 1) * 16 + 4, (x - 1) * 16 + 8, 4, &HAAFFFF00
  18.         lastx = (y - 1) * 16 + 4: lasty = (x - 1) * 16 + 8
  19.         x = x + s: y = y + s
  20.     LOOP UNTIL x > n OR y > n OR x < 1 OR y < 1
  21.     IF x < 1 AND y < 1 THEN x = 1: y = 2
  22.     IF x > n AND y > n THEN x = n - 1: y = n
  23.     IF y < 1 THEN y = 1
  24.     IF x < 1 THEN x = 1: y = y + 2
  25.     IF x > n THEN x = n:
  26.     IF y > n THEN x = x - 2: y = n
  27.     s = -s
  28. LOOP UNTIL k = n * n
  29. FOR x = 1 TO n
  30.     FOR y = 1 TO n
  31.         _PRINTSTRING ((y - 1) * 16, (x - 1) * 16), a(x, y)
  32.     NEXT
  33.  
  34.  
  35. SUB thic (x1, y1, x2, y2, thick, K AS _UNSIGNED LONG)
  36.     DIM PD2 AS DOUBLE, t2 AS SINGLE, a AS SINGLE, x3 AS SINGLE, y3 AS SINGLE, x4 AS SINGLE, y4 AS SINGLE
  37.     DIM x5 AS SINGLE, y5 AS SINGLE, x6 AS SINGLE, y6 AS SINGLE
  38.     PD2 = 1.570796326794897
  39.     t2 = thick / 2
  40.     IF t2 < 1 THEN t2 = 1
  41.     a = _ATAN2(y2 - y1, x2 - x1)
  42.     x3 = x1 + t2 * COS(a + PD2)
  43.     y3 = y1 + t2 * SIN(a + PD2)
  44.     x4 = x1 + t2 * COS(a - PD2)
  45.     y4 = y1 + t2 * SIN(a - PD2)
  46.     x5 = x2 + t2 * COS(a + PD2)
  47.     y5 = y2 + t2 * SIN(a + PD2)
  48.     x6 = x2 + t2 * COS(a - PD2)
  49.     y6 = y2 + t2 * SIN(a - PD2)
  50.     ftri x6, y6, x4, y4, x3, y3, K
  51.     ftri x3, y3, x5, y5, x6, y6, K
  52.  
  53. '2019-12-16 fix by Steve saves some time with STATIC and saves and restores last dest
  54. SUB ftri (x1, y1, x2, y2, x3, y3, K AS _UNSIGNED LONG)
  55.     DIM D AS LONG
  56.     STATIC a&
  57.     D = _DEST
  58.     IF a& = 0 THEN a& = _NEWIMAGE(1, 1, 32)
  59.     _DEST a&
  60.     _DONTBLEND a& '  '<<<< new 2019-12-16 fix
  61.     PSET (0, 0), K
  62.     _BLEND a& '<<<< new 2019-12-16 fix
  63.     _DEST D
  64.     _MAPTRIANGLE _SEAMLESS(0, 0)-(0, 0)-(0, 0), a& TO(x1, y1)-(x2, y2)-(x3, y3)
  65.  
  66.  
  67.  

« Last Edit: January 25, 2021, 11:07:00 PM by bplus »

Offline bplus

  • Forum Resident
  • Posts: 6674
  • b = b + ...
Re: Diagonal snake filling array qb64 qbasic: witty task
« Reply #14 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.     Do
  9.         Cls
  10.         k = k + 1
  11.         c(0) = x: r(0) = y
  12.         For i = 0 To 4
  13.             If (c(i) > 0) And (r(i) > 0) Then Locate r(i), c(i) * 2: Print Mid$(b$, i + 1, 1);
  14.         Next
  15.         For i = 3 To 0 Step -1
  16.             c(i + 1) = c(i): r(i + 1) = r(i)
  17.         Next
  18.         _Delay .05
  19.         x = x + s: y = y + s
  20.     Loop Until x > 40 Or y > 25 Or x < 1 Or y < 1
  21.     If switch Then
  22.         If x < 1 And y < 1 Then x = 2: y = 1 '
  23.         If x > 40 And y > 25 Then x = 40: y = 25 - 2 '
  24.         If y < 1 Then y = 1: x = x + 2 '
  25.         If x < 1 Then x = 1 '
  26.         If x > 40 Then x = 40: y = y - 2 '
  27.         If y > 25 Then y = 25 '
  28.     Else
  29.         If x < 1 And y < 1 Then x = 1: y = 2
  30.         If x > 40 And y > 25 Then x = 40 - 1: y = 25
  31.         If y < 1 Then y = 1
  32.         If x < 1 Then x = 1: y = y + 2
  33.         If x > 40 Then x = 40
  34.         If y > 25 Then x = x - 2: y = 25
  35.     End If
  36.     s = -1 * s
  37. Loop Until k = 25 * 40
  38. k = 0
  39. ReDim c(4), r(4)
  40. If switch Then
  41.     x = 40: y = 1: s = -1
  42.     x = 1: y = 25
  43. switch = 1 - switch
  44. GoTo restart
  45.  
  46.