Text Only | Text with Attachments

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]
  2.     x AS INTEGER
  3.     y AS INTEGER
  4.     c AS _UNSIGNED LONG
  5.     state AS _BYTE
  7.  
  8. size = 20
  9.  
  10. SCREEN _NEWIMAGE(size * 40, size * 40, 32)
  11. PRINT "Hit a key..."
  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
  63.  
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)
  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$
  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
  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)
  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$
  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
  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.  
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)
  3. MinX = 0: MaxX = _WIDTH
  4. MinY = 0: MaxY = _HEIGHT
  5. PSET (0, 0), Yellow
  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
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]
  2. MinX = 35: MaxX = 45
  3. MinY = 5: MaxY = 20
  4. COLOR Yellow
  5. x = MinX: y = MinY
  6. PSET0 x, y
  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.  
  31.  
  32. SUB PSET0 (x, y)
  33.     LOCATE y, x
  34.     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
  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),

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
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
  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$
  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
  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
  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
  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
  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)
  74.  
  75.  
  76.  

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:
  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
  40. k = 0
  41. ReDim c(4), r(4)
  42. If switch Then
  43.     x = 40: y = 1: s = -1
  45.     x = 1: y = 25
  47. switch = 1 - switch
  48. GoTo restart
  49.  
  50.  
Text Only | Text with Attachments