Hypnotic polygon orbits

[FellippeHeitor]

Inspired by this post: https://www.reddit.com/r/gifs/comments/f91c99/every_addtional_shape_adds_one_more_corner_and/

Code: QB64: [Select]

1. OPTION _EXPLICIT
2. SCREEN _NEWIMAGE(300, 300, 32)
3. _TITLE "Polygon orbits"
4. TYPE shapeType
5.     n AS INTEGER
6.     c AS _UNSIGNED LONG
7.     x AS SINGLE
8.     y AS SINGLE
9. END TYPE
10.  
11. DIM SHARED shape(1 TO 13, 1 TO 15) AS shapeType
12. DIM s AS LONG, i AS LONG
13.  
14. 'draw shapes and fill shape() array with vertices
15. FOR s = 3 TO 12
16.     drawShape _WIDTH / 2, _HEIGHT / 2, s * 10, s, s - 2
17. NEXT s
18.  
19. 'save shapes image
20. PCOPY 0, 1
21.  
22. 'have circles follow shapes' paths
23. DO
24.     FOR s = 1 TO 10
25.         shape(s, 1).n = shape(s, 1).n + 1
26.         IF shape(s, 1).n > s + 2 THEN
27.             shape(s, 1).n = 1
28.         END IF
29.     NEXT
30.     FOR i = 1 TO 100 STEP 5
31.         PCOPY 1, 0 'restore background
32.         DIM ret AS shapeType
33.         FOR s = 1 TO 10
34.             IF shape(s, 1).n < s + 2 THEN
35.                 followPath shape(s, shape(s, 1).n).x, shape(s, shape(s, 1).n).y, shape(s, shape(s, 1).n + 1).x, shape(s, shape(s, 1).n + 1).y, i, ret
36.             ELSE
37.                 followPath shape(s, shape(s, 1).n).x, shape(s, shape(s, 1).n).y, shape(s, 1).x, shape(s, 1).y, i, ret
38.             END IF
39.             CircleFill ret.x, ret.y, 5, shape(s, 1).c
40.         NEXT
41.         _DISPLAY
42.         _LIMIT 60
43.     NEXT
44. LOOP
45. SLEEP
46.  
47. SUB drawShape (x AS SINGLE, y AS SINGLE, size AS INTEGER, sides AS INTEGER, arrayIndex AS INTEGER)
48.     'Thanks to Ashish for contributing to this sub
49.     DIM i AS SINGLE, vertex AS INTEGER
50.     DIM x0 AS SINGLE, y0 AS SINGLE, theta AS SINGLE
51.     DIM thisColor AS _UNSIGNED LONG
52.  
53.     IF sides <> 4 THEN theta = -_PI(0.5) ELSE theta = _PI(0.25)
54.  
55.     thisColor = hsb(map(sides, 3, 12, 0, 360), 255, 127, 255)
56.     shape(arrayIndex, 1).c = thisColor
57.     FOR i = theta TO _PI(2) + theta STEP _PI(2 / sides)
58.         x0 = x + size * COS(i)
59.         y0 = y + size * SIN(i)
60.         LINE (x0, y0)-(x + size * COS(i + _PI(2 / sides)), y + size * SIN(i + _PI(2 / sides))), thisColor
61.  
62.         vertex = vertex + 1
63.         shape(arrayIndex, vertex).x = x0
64.         shape(arrayIndex, vertex).y = y0
65.     NEXT
66. END SUB
67.  
68. SUB followPath (X AS INTEGER, Y AS INTEGER, X2 AS INTEGER, Y2 AS INTEGER, atStep AS INTEGER, position AS shapeType)
69.     'This sub adapted from http://www.antonis.de/faq/progs/bline.bas
70.     '---------
71.     'This implementation returns position.x and position.y as coordinates
72.     'to a point across the path between X,Y and X2,Y2
73.     'Uses atStep to determine how far along the path the returned point stands
74.     DIM I AS INTEGER
75.     DIM Steep AS INTEGER
76.     DIM E AS INTEGER
77.     DIM SX AS INTEGER
78.     DIM SY AS INTEGER
79.     DIM DX AS INTEGER
80.     DIM DY AS INTEGER
81.     I = 0
82.     Steep% = 0
83.     E = 0
84.     IF (X2 - X) > 0 THEN
85.         SX = 1
86.     ELSE
87.         SX = -1
88.     END IF
89.     DX = ABS(X2 - X)
90.     IF (Y2 - Y) > 0 THEN
91.         SY = 1
92.     ELSE
93.         SY = -1
94.     END IF
95.     DY = ABS(Y2 - Y)
96.     IF (DY > DX) THEN
97.         Steep = 1
98.         SWAP X, Y
99.         SWAP DX, DY
100.         SWAP SX, SY
101.     END IF
102.     E = 2 * DY - DX
103.     FOR I = 0 TO (INT(map(atStep, 0, 100, 0, DX))) - 1
104.         WHILE E >= 0
105.             Y = Y + SY
106.             E = E - 2 * DX
107.         WEND
108.         X = X + SX
109.         E = E + 2 * DY
110.     NEXT
111.     IF Steep% = 1 THEN
112.         position.x = Y
113.         position.y = X
114.     ELSE
115.         position.x = X
116.         position.y = Y
117.     END IF
118. END SUB
119.  
120. FUNCTION map! (value!, minRange!, maxRange!, newMinRange!, newMaxRange!)
121.     map! = ((value! - minRange!) / (maxRange! - minRange!)) * (newMaxRange! - newMinRange!) + newMinRange!
122. END FUNCTION
123.  
124. SUB CircleFill (CX AS INTEGER, CY AS INTEGER, R AS INTEGER, C AS _UNSIGNED LONG)
125.     'This sub from https://www.qb64.org/forum/index.php?topic=1069.0
126.     ' CX = center x coordinate
127.     ' CY = center y coordinate
128.     '  R = radius
129.     '  C = fill color
130.     DIM Radius AS INTEGER, RadiusError AS INTEGER
131.     DIM X AS INTEGER, Y AS INTEGER
132.     Radius = ABS(R)
133.     RadiusError = -Radius
134.     X = Radius
135.     Y = 0
136.     IF Radius = 0 THEN PSET (CX, CY), C: EXIT SUB
137.     LINE (CX - X, CY)-(CX + X, CY), C, BF
138.     WHILE X > Y
139.         RadiusError = RadiusError + Y * 2 + 1
140.         IF RadiusError >= 0 THEN
141.             IF X <> Y + 1 THEN
142.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
143.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
144.             END IF
145.             X = X - 1
146.             RadiusError = RadiusError - X * 2
147.         END IF
148.         Y = Y + 1
149.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
150.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
151.     WEND
152. END SUB
153.  
154. FUNCTION hsb~& (__H AS _FLOAT, __S AS _FLOAT, __B AS _FLOAT, A AS _FLOAT)
155.     DIM H AS _FLOAT, S AS _FLOAT, B AS _FLOAT
156.  
157.     H = __H
158.     S = map(__S, 0, 255, 0, 1)
159.     B = map(__B, 0, 255, 0, 1)
160.  
161.     IF S = 0 THEN
162.         hsb~& = _RGBA32(B * 255, B * 255, B * 255, A)
163.         EXIT FUNCTION
164.     END IF
165.  
166.     DIM fmx AS _FLOAT, fmn AS _FLOAT
167.     DIM fmd AS _FLOAT, iSextant AS INTEGER
168.     DIM imx AS INTEGER, imd AS INTEGER, imn AS INTEGER
169.  
170.     IF B > .5 THEN
171.         fmx = B - (B * S) + S
172.         fmn = B + (B * S) - S
173.     ELSE
174.         fmx = B + (B * S)
175.         fmn = B - (B * S)
176.     END IF
177.  
178.     iSextant = INT(H / 60)
179.  
180.     IF H >= 300 THEN
181.         H = H - 360
182.     END IF
183.  
184.     H = H / 60
185.     H = H - (2 * INT(((iSextant + 1) MOD 6) / 2))
186.  
187.     IF iSextant MOD 2 = 0 THEN
188.         fmd = (H * (fmx - fmn)) + fmn
189.     ELSE
190.         fmd = fmn - (H * (fmx - fmn))
191.     END IF
192.  
193.     imx = _ROUND(fmx * 255)
194.     imd = _ROUND(fmd * 255)
195.     imn = _ROUND(fmn * 255)
196.  
197.     SELECT CASE INT(iSextant)
198.         CASE 1
199.             hsb~& = _RGBA32(imd, imx, imn, A)
200.         CASE 2
201.             hsb~& = _RGBA32(imn, imx, imd, A)
202.         CASE 3
203.             hsb~& = _RGBA32(imn, imd, imx, A)
204.         CASE 4
205.             hsb~& = _RGBA32(imd, imn, imx, A)
206.         CASE 5
207.             hsb~& = _RGBA32(imx, imn, imd, A)
208.         CASE ELSE
209.             hsb~& = _RGBA32(imx, imd, imn, A)
210.     END SELECT
211.  
212. END FUNCTION
213.  

[Ashish]

Hi.. here my version

Code: QB64: [Select]

1. SCREEN _NEWIMAGE(700, 700, 32)
2.  
3. TYPE vec2
4.     x AS SINGLE
5.     y AS SINGLE
6. END TYPE
7.  
8. TYPE part
9.     pos AS vec2
10.     src AS INTEGER
11.     dest AS INTEGER
12. END TYPE
13.  
14. DIM SHARED particle_path(11, 13) AS vec2
15. DIM SHARED particle(10) AS part
16.  
17. FOR i = 3 TO 13
18.     COLOR hsb~&((i - 3) * 17, 255, 128, 255)
19.     drawShape 350, 350, 60 + 25 * (i - 3), i
20.     particle(i - 3).pos = particle_path(i - 3, 0)
21.     particle(i - 3).src = 0
22.     particle(i - 3).dest = 1
23. NEXT
24. pic& = _COPYIMAGE(0)
25. speed = 0.04
26. v = 0
27. w~& = _RGB(255, 255, 255)
28. DO
29.     CLS
30.     _PUTIMAGE , pic&
31.     v = v + speed
32.     FOR i = 0 TO UBOUND(particle)
33.         CircleFill particle(i).pos.x, particle(i).pos.y, 5, w~&
34.         particle(i).pos.x = map(v, 0, 1, particle_path(i, particle(i).src).x, particle_path(i, particle(i).dest).x)
35.         particle(i).pos.y = map(v, 0, 1, particle_path(i, particle(i).src).y, particle_path(i, particle(i).dest).y)
36.         IF v >= 1 THEN
37.             particle(i).src = particle(i).dest
38.             IF particle(i).dest = (i + 3) - 1 THEN
39.                 particle(i).dest = 0
40.             ELSE
41.                 particle(i).dest = particle(i).dest + 1
42.             END IF
43.         END IF
44.     NEXT
45.     IF v >= 1 THEN v = 0
46.     _LIMIT 60
47.     _DISPLAY
48. LOOP
49.  
50. SUB drawShape (x, y, s, n)
51.     IF n <> 4 THEN theta = -_PI(0.5) ELSE theta = _PI(0.25)
52.     c = 0
53.     FOR i = theta TO _PI(2) + theta STEP _PI(2 / n)
54.         x0 = x + s * COS(i)
55.         y0 = y + s * SIN(i)
56.         particle_path((n - 3), c).x = x0
57.         particle_path((n - 3), c).y = y0
58.         LINE (x0, y0)-(x + s * COS(i + _PI(2 / n)), y + s * SIN(i + _PI(2 / n)))
59.         c = c + 1
60.     NEXT
61. END SUB
62.  
63.  
64. 'method adapted form http://stackoverflow.com/questions/4106363/converting-rgb-to-hsb-colors
65. FUNCTION hsb~& (__H AS _FLOAT, __S AS _FLOAT, __B AS _FLOAT, A AS _FLOAT)
66.     DIM H AS _FLOAT, S AS _FLOAT, B AS _FLOAT
67.  
68.     H = map(__H, 0, 255, 0, 360)
69.     S = map(__S, 0, 255, 0, 1)
70.     B = map(__B, 0, 255, 0, 1)
71.  
72.     IF S = 0 THEN
73.         hsb~& = _RGBA32(B * 255, B * 255, B * 255, A)
74.         EXIT FUNCTION
75.     END IF
76.  
77.     DIM fmx AS _FLOAT, fmn AS _FLOAT
78.     DIM fmd AS _FLOAT, iSextant AS INTEGER
79.     DIM imx AS INTEGER, imd AS INTEGER, imn AS INTEGER
80.  
81.     IF B > .5 THEN
82.         fmx = B - (B * S) + S
83.         fmn = B + (B * S) - S
84.     ELSE
85.         fmx = B + (B * S)
86.         fmn = B - (B * S)
87.     END IF
88.  
89.     iSextant = INT(H / 60)
90.  
91.     IF H >= 300 THEN
92.         H = H - 360
93.     END IF
94.  
95.     H = H / 60
96.     H = H - (2 * INT(((iSextant + 1) MOD 6) / 2))
97.  
98.     IF iSextant MOD 2 = 0 THEN
99.         fmd = (H * (fmx - fmn)) + fmn
100.     ELSE
101.         fmd = fmn - (H * (fmx - fmn))
102.     END IF
103.  
104.     imx = _ROUND(fmx * 255)
105.     imd = _ROUND(fmd * 255)
106.     imn = _ROUND(fmn * 255)
107.  
108.     SELECT CASE INT(iSextant)
109.         CASE 1
110.             hsb~& = _RGBA32(imd, imx, imn, A)
111.         CASE 2
112.             hsb~& = _RGBA32(imn, imx, imd, A)
113.         CASE 3
114.             hsb~& = _RGBA32(imn, imd, imx, A)
115.         CASE 4
116.             hsb~& = _RGBA32(imd, imn, imx, A)
117.         CASE 5
118.             hsb~& = _RGBA32(imx, imn, imd, A)
119.         CASE ELSE
120.             hsb~& = _RGBA32(imx, imd, imn, A)
121.     END SELECT
122.  
123. END FUNCTION
124.  
125.  
126. FUNCTION map! (value!, minRange!, maxRange!, newMinRange!, newMaxRange!)
127.     map! = ((value! - minRange!) / (maxRange! - minRange!)) * (newMaxRange! - newMinRange!) + newMinRange!
128. END FUNCTION
129.  
130. SUB CircleFill (x AS LONG, y AS LONG, R AS LONG, C AS _UNSIGNED LONG)
131.     DIM x0 AS SINGLE, y0 AS SINGLE
132.     DIM e AS SINGLE
133.  
134.     x0 = R
135.     y0 = 0
136.     e = -R
137.     DO WHILE y0 < x0
138.         IF e <= 0 THEN
139.             y0 = y0 + 1
140.             LINE (x - x0, y + y0)-(x + x0, y + y0), C, BF
141.             LINE (x - x0, y - y0)-(x + x0, y - y0), C, BF
142.             e = e + 2 * y0
143.         ELSE
144.             LINE (x - y0, y - x0)-(x + y0, y - x0), C, BF
145.             LINE (x - y0, y + x0)-(x + y0, y + x0), C, BF
146.             x0 = x0 - 1
147.             e = e - 2 * x0
148.         END IF
149.     LOOP
150.     LINE (x - R, y)-(x + R, y), C, BF
151. END SUB
152.  
153.  

[bplus]

Wow! They are also spiral and turn into n-perpeller like, oh that's only in the link to video.

Fellippe your lineup of regular polys is off, yours too neat ;-) in link notice how all polys lineup at the bottom segment and the triangle overlaps the square at top point... that might help keep colored disks in pattern. They also start lineup straight down.

Still pretty cool.

[FellippeHeitor]

Just "fixed" the square to be hacky too.

To fix the rest I'd probably need an adaptive theta in drawShape() for each number of sides.

[bplus]

This might help get your alignment started on the right foot.

Code: QB64: [Select]

1. _TITLE "Polygon Orbits" 'b+ 2020-02-25
2. ' Fellippe's post 2020-02-25 https://www.qb64.org/forum/index.php?topic=2234.msg114766#msg114766
3. ' Inspired by this post: https://www.reddit.com/r/gifs/comments/f91c99/every_addtional_shape_adds_one_more_corner_and/
4.  
5. CONST xmax = 700, ymax = 700, side = 100, center = 350, P1 = _PI: P2 = _PI(2): PD2 = _PI(.5)
6.  
7. SCREEN _NEWIMAGE(xmax, ymax, 32)
8. _SCREENMOVE 300, 20
9. PSET (center, center)
10. FOR n = 3 TO 12
11.     a = P2 / n
12.     ' 1/2 *side = r*sin(1/2*a)
13.     r = .5 * side / SIN(a / 2)
14.     x1 = center + r * COS(a / 2 + PD2)
15.     y1 = center + r * SIN(a / 2 + PD2)
16.     'PSET (x1, y1)   'OK ?
17.     x2 = x1 + side * COS(0)
18.     y2 = y1 + side * SIN(0)
19.     'PSET (x2, y2) ' OK?
20.     LINE (x1, y1)-(x2, y2) 'OK!
21. NEXT
22.  

The bottom segments are all aligned and parallel to bottom of screen.

[bplus]

Use turtle drawing to finish the polys and save the point positions:

Code: QB64: [Select]

1. 'OPTION _EXPLICIT
2. _TITLE "Polygon Orbits" 'b+ 2020-02-25
3. ' Fellippe's post 2020-02-25 https://www.qb64.org/forum/index.php?topic=2234.msg114766#msg114766
4. ' Inspired by this post: https://www.reddit.com/r/gifs/comments/f91c99/every_addtional_shape_adds_one_more_corner_and/
5.  
6. CONST xmax = 700, ymax = 700, side = 170, center = 350, P1 = _PI: P2 = _PI(2): PD2 = _PI(.5)
7.  
8. SCREEN _NEWIMAGE(xmax, ymax, 32)
9. _SCREENMOVE 300, 20
10.  
11. DIM SHARED poly$(3 TO 12) 'point strings we will turn into arrays as needed
12. PSET (center, center)
13. FOR n = 3 TO 12
14.     a = P2 / n
15.     isoA = (P1 - a) / 2
16.     isoA2 = isoA * 2
17.     turn = P1 - isoA2 'for turtle drawing
18.  
19.     ' 1/2 *side = r*sin(1/2*a)
20.     r = .5 * side / SIN(a / 2)
21.     x1 = center + r * COS(a / 2 + PD2)
22.     y1 = center + r * SIN(a / 2 + PD2)
23.     'PSET (x1, y1)   'OK ?
24.     'x2 = x1 + side * COS(0)
25.     'y2 = y1 + side * SIN(0)
26.     'PSET (x2, y2) ' OK?
27.     'LINE (x1, y1)-(x2, y2) 'OK!
28.     poly$(n) = STR$(x1) + "," + STR$(y1) 'our first point for polygon
29.     currA = P1 'turtle draw the rest of the poly and save the points
30.     FOR ring = 2 TO n + 1
31.         currA = currA + turn
32.         x2 = x1 + side * COS(currA)
33.         y2 = y1 + side * SIN(currA)
34.         LINE (x1, y1)-(x2, y2)
35.         x1 = x2: y1 = y2
36.         poly$(n) = poly$(n) + STR$(x1) + "," + STR$(y1)
37.     NEXT
38. NEXT
39.  

[bplus]

OK, just need to add the circles

Code: QB64: [Select]

1. OPTION _EXPLICIT
2. $COLOR:32
3. _TITLE "Polygon Orbits" 'b+ 2020-02-25
4. ' Fellippe's post 2020-02-25 https://www.qb64.org/forum/index.php?topic=2234.msg114766#msg114766
5. ' Inspired by this post: https://www.reddit.com/r/gifs/comments/f91c99/every_addtional_shape_adds_one_more_corner_and/
6.  
7. CONST xmax = 700, ymax = 700, side = 170, center = 350, P1 = _PI, P2 = P1 * 2, PD2 = P1 * .5
8. DIM SHARED poly$(3 TO 12) 'point strings we will turn into arrays as needed
9. DIM SHARED c(3 TO 12) AS _UNSIGNED LONG 'colors
10. c(3) = Red: c(4) = CrayolaOrange: c(5) = LaserLemon: c(6) = Lime: c(7) = MediumSpringGreen
11. c(8) = Aqua: c(9) = Periwinkle: c(10) = NavyBlue: c(11) = MediumBlue: c(12) = RedViolet
12.  
13. SCREEN _NEWIMAGE(xmax, ymax, 32)
14. _SCREENMOVE 300, 20
15. DIM n, a, isoA, isoA2, turn, r, x1, y1, currA, ring, x2, y2
16.  
17. 'PSET (center, center)
18. FOR n = 3 TO 12
19.     a = P2 / n
20.     isoA = (P1 - a) / 2
21.     isoA2 = isoA * 2
22.     turn = P1 - isoA2 'for turtle drawing
23.  
24.     ' 1/2 *side = r*sin(1/2*a)
25.     r = .5 * side / SIN(a / 2)
26.     x1 = center + r * COS(a / 2 + PD2)
27.     y1 = center + r * SIN(a / 2 + PD2)
28.     'PSET (x1, y1)   'OK ?
29.     'x2 = x1 + side * COS(0)
30.     'y2 = y1 + side * SIN(0)
31.     'PSET (x2, y2) ' OK?
32.     'LINE (x1, y1)-(x2, y2) 'OK!
33.     poly$(n) = STR$(x1) + "," + STR$(y1) 'our first point for polygon
34.     currA = P1 'turtle draw the rest of the poly and save the points
35.     FOR ring = 2 TO n + 1
36.         currA = currA + turn
37.         x2 = x1 + side * COS(currA)
38.         y2 = y1 + side * SIN(currA)
39.         LINE (x1, y1)-(x2, y2)
40.         x1 = x2: y1 = y2
41.         poly$(n) = poly$(n) + "," + STR$(x1) + "," + STR$(y1)
42.     NEXT
43. NEXT
44. CLS
45. drawPolys
46.  
47. SUB drawPolys
48.     DIM n, i, x1, y1, x2, y2, w$
49.     FOR n = 3 TO 12
50.         REDIM pts$(0)
51.         Split poly$(n), ",", pts$()
52.         'FOR i = 0 TO UBOUND(pts$) - 1 STEP 2
53.         '    PRINT pts$(i), pts$(i + 1)
54.         'NEXT
55.         PSET (VAL(pts$(0)), VAL(pts$(1))), c(n)
56.         FOR i = 2 TO UBOUND(pts$) STEP 2
57.             x1 = VAL(pts$(i)): y1 = VAL(pts$((i + 1)))
58.             LINE -(x1, y1), c(n)
59.         NEXT
60.     NEXT
61. END SUB
62.  
63. SUB Split (SplitMeString AS STRING, delim AS STRING, loadMeArray() AS STRING)
64.     DIM curpos AS LONG, arrpos AS LONG, LD AS LONG, dpos AS LONG 'fix use the Lbound the array already has
65.     curpos = 1: arrpos = LBOUND(loadMeArray): LD = LEN(delim)
66.     dpos = INSTR(curpos, SplitMeString, delim)
67.     DO UNTIL dpos = 0
68.         loadMeArray(arrpos) = MID$(SplitMeString, curpos, dpos - curpos)
69.         arrpos = arrpos + 1
70.         IF arrpos > UBOUND(loadMeArray) THEN REDIM _PRESERVE loadMeArray(LBOUND(loadMeArray) TO UBOUND(loadMeArray) + 1000) AS STRING
71.         curpos = dpos + LD
72.         dpos = INSTR(curpos, SplitMeString, delim)
73.     LOOP
74.     loadMeArray(arrpos) = MID$(SplitMeString, curpos)
75.     REDIM _PRESERVE loadMeArray(LBOUND(loadMeArray) TO arrpos) AS STRING 'get the ubound correct
76. END SUB
77.  
78.  
79. SUB fcirc (CX AS INTEGER, CY AS INTEGER, R AS INTEGER, C AS _UNSIGNED LONG)
80.     DIM Radius AS INTEGER, RadiusError AS INTEGER
81.     DIM X AS INTEGER, Y AS INTEGER
82.     Radius = ABS(R): RadiusError = -Radius: X = Radius: Y = 0
83.     IF Radius = 0 THEN PSET (CX, CY), C: EXIT SUB
84.     LINE (CX - X, CY)-(CX + X, CY), C, BF
85.     WHILE X > Y
86.         RadiusError = RadiusError + Y * 2 + 1
87.         IF RadiusError >= 0 THEN
88.             IF X <> Y + 1 THEN
89.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
90.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
91.             END IF
92.             X = X - 1
93.             RadiusError = RadiusError - X * 2
94.         END IF
95.         Y = Y + 1
96.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
97.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
98.     WEND
99. END SUB
100.  
101.  
102.  

[bplus]

Piss, I get the same misalignment you guys got:

Code: QB64: [Select]

1. _TITLE "Polygon Orbits" 'b+ 2020-02-25
2. ' Fellippe's post 2020-02-25 https://www.qb64.org/forum/index.php?topic=2234.msg114766#msg114766
3. ' Inspired by this post: https://www.reddit.com/r/gifs/comments/f91c99/every_addtional_shape_adds_one_more_corner_and/
4.  
5. CONST xmax = 700, ymax = 700, side = 130, center = 350, P1 = _PI, P2 = P1 * 2, PD2 = P1 * .5
6. DIM SHARED poly$(3 TO 15) 'point strings we will turn into arrays as needed
7. DIM SHARED c(3 TO 15) AS _UNSIGNED LONG 'colors
8. c(3) = &HFF550000: c(4) = &HFFAA0000: c(5) = &HFFFF0000: c(6) = &HFFDD4400: c(7) = &HFF888800: c(8) = &HFFFF8800
9. c(9) = &HFF00FF00: c(10) = &HFF00FF88: c(11) = &HFF00FFFF: c(12) = &HFF0088FF: c(13) = &HFF0000FF: c(14) = &HF88F0088: c(15) = &HFF330033
10. DIM SHARED node, frac 'frac for moving disks between nodes
11. SCREEN _NEWIMAGE(xmax, ymax, 32)
12. _SCREENMOVE 300, 20
13. DIM n, a, isoA, isoA2, turn, r, x1, y1, currA, ring, x2, y2
14. FOR n = 3 TO 15
15.     a = P2 / n '                  central angle
16.     isoA = (P1 - a) / 2 '         angle of one iso triangle at base
17.     isoA2 = isoA * 2 '            2 iso's is interior angle at each node
18.     turn = P1 - isoA2 '           for turtle drawing, turn this much at each point
19.     r = .5 * side / SIN(a / 2) ' << so  << 1/2 * side = r * sin(1/2 * a)
20.     x1 = center + r * COS(a / 2 + PD2): y1 = center + r * SIN(a / 2 + PD2)
21.     poly$(n) = STR$(x1) + "," + STR$(y1) 'our first point for polygon
22.     currA = P1 'turtle draw the rest of the poly and save the points
23.     FOR ring = 2 TO n + 1
24.         currA = currA + turn
25.         x2 = x1 + side * COS(currA): y2 = y1 + side * SIN(currA)
26.         LINE (x1, y1)-(x2, y2)
27.         x1 = x2: y1 = y2
28.         poly$(n) = poly$(n) + "," + STR$(x1) + "," + STR$(y1)
29.     NEXT
30. NEXT
31. frac = 4
32. WHILE _KEYDOWN(27) = 0
33.     CLS
34.     frac = frac + 1
35.     IF frac = 10 THEN frac = 0: node = node + 1
36.     drawPolys
37.     _DISPLAY
38.     _LIMIT 30
39. WEND
40.  
41. SUB drawPolys
42.     DIM n, i, x1, y1, x2, y2, target, lastNode, midx, midy
43.     FOR n = 3 TO 15
44.         REDIM pts$(0)
45.         Split poly$(n), ",", pts$()
46.         PSET (VAL(pts$(0)), VAL(pts$(1))), c(n)
47.         FOR i = 2 TO UBOUND(pts$) STEP 2
48.             x1 = VAL(pts$(i)): y1 = VAL(pts$((i + 1)))
49.             LINE -(x1, y1), c(n)
50.         NEXT
51.         target = node MOD n: lastNode = target - 1
52.         IF lastNode < 0 THEN lastNode = n - 1
53.         x1 = VAL(pts$(2 * lastNode)): y1 = VAL(pts$(2 * lastNode + 1))
54.         x2 = VAL(pts$(2 * target)): y2 = VAL(pts$(2 * target + 1))
55.         midx = x1 + (x2 - x1) * frac / 10: midy = y1 + (y2 - y1) * frac / 10
56.         fcirc midx, midy, 9, c(n)
57.     NEXT
58. END SUB
59.  
60. SUB Split (SplitMeString AS STRING, delim AS STRING, loadMeArray() AS STRING)
61.     DIM curpos AS LONG, arrpos AS LONG, LD AS LONG, dpos AS LONG 'fix use the Lbound the array already has
62.     curpos = 1: arrpos = LBOUND(loadMeArray): LD = LEN(delim)
63.     dpos = INSTR(curpos, SplitMeString, delim)
64.     DO UNTIL dpos = 0
65.         loadMeArray(arrpos) = MID$(SplitMeString, curpos, dpos - curpos)
66.         arrpos = arrpos + 1
67.         IF arrpos > UBOUND(loadMeArray) THEN REDIM _PRESERVE loadMeArray(LBOUND(loadMeArray) TO UBOUND(loadMeArray) + 1000) AS STRING
68.         curpos = dpos + LD
69.         dpos = INSTR(curpos, SplitMeString, delim)
70.     LOOP
71.     loadMeArray(arrpos) = MID$(SplitMeString, curpos)
72.     REDIM _PRESERVE loadMeArray(LBOUND(loadMeArray) TO arrpos) AS STRING 'get the ubound correct
73. END SUB
74.  
75. SUB fcirc (CX AS INTEGER, CY AS INTEGER, R AS INTEGER, C AS _UNSIGNED LONG)
76.     DIM Radius AS INTEGER, RadiusError AS INTEGER
77.     DIM X AS INTEGER, Y AS INTEGER
78.     Radius = ABS(R): RadiusError = -Radius: X = Radius: Y = 0
79.     IF Radius = 0 THEN PSET (CX, CY), C: EXIT SUB
80.     LINE (CX - X, CY)-(CX + X, CY), C, BF
81.     WHILE X > Y
82.         RadiusError = RadiusError + Y * 2 + 1
83.         IF RadiusError >= 0 THEN
84.             IF X <> Y + 1 THEN
85.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
86.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
87.             END IF
88.             X = X - 1
89.             RadiusError = RadiusError - X * 2
90.         END IF
91.         Y = Y + 1
92.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
93.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
94.     WEND
95. END SUB
96.  

And do you know why?

WE are going down each line segment at the same rate, stop the motion at any time and every dot is the same distance between the nodes:
 

 

But that's not how the code from the link is drawing the disks, stop the motion there and the disks are anywhere along each line segment between nodes:
 

We've been lied to my friends, the title in the link says the dots move at the same speed. They don't! Just watch the outside dot and the next one in and compare their speeds going round.

So... how do we change our code to have the disks move in the way to form the cool patterns that are found in the link?

[FellippeHeitor]

Lol, great investigative work, bplus. Kudos for the xtra attention to detail!

[bplus]

Thanks Fellippe, but now I want that cool pattern maker found in the link. ;-)

[FellippeHeitor]

Something tells me you’re not one to rest until it looks closer...

[bplus]

Well it shouldn't take more than the rest of the night, maybe less?


Update:
Ha! I am just now reading the comments,

Well there's definitely something fucky going on with the gif to make it look like this.

I got 27729 nodes before complete alignment again at the start line pointing down. But then I recounted the number of concentric polygons, oh 13 not 10, I had to insert 3 more rings and find 3 more colors, that's when I switched color systems from $color:32 names to hexadecimal, easier to make rainbow set. So 13 X 27720 = 360,360 nodes to cross before alignment as it starts what this guy calculates in first comment posted there.

All those comments were great!

[FellippeHeitor]

❤️

[bplus]

Look familiar?

Code: QB64: [Select]

1. _TITLE "Orbit Patterns" 'b+ started 2020-02-25
2. 'can we find speeds for disks going in  orbits around center st they form patterns
3.  
4. CONST xmax = 700, ymax = 700, center = 350, P1 = _PI, P2 = P1 * 2, PD2 = P1 * .5
5. SCREEN _NEWIMAGE(xmax, ymax, 32)
6. _SCREENMOVE 300, 20
7. DIM rate(1 TO 20)
8. FOR i = 1 TO 20
9.     rate(i) = (21 - i) / 12
10. NEXT
11. WHILE _KEYDOWN(27) = 0
12.     CLS
13.     FOR r = 10 TO 200 STEP 10
14.         i = INT(r / 10)
15.         x = center + r * COS(rate(i) * a)
16.         y = center + r * SIN(rate(i) * a)
17.         CIRCLE (x, y), 5
18.     NEXT
19.     a = a + _PI(2 / 120)
20.     _DISPLAY
21.     _LIMIT 30
22. WEND
23.  
24.  

[STxAxTIC]

Phew, I was busting at the seams to just shut up for once about a math problem... But this reminds me of a riddle - lemme go from memory:

Suppose you're house-sitting for some up-tight rich people. You just go there to feed the fish, and that's it. They even turned the main circuit breaker off (fuse panel if you like), and locked the box. One day, you walk in to perform your duties, and absentmindedly pull the chain down on the ceiling fan. Oops, when the owners come back, the house power comes on, and so does the fan! But... based on your knowledge of fans, the pull-switch can change the speed of the motor a few times before turning it off. Taking it for certain that either three total pulls of the chain or four total pulls of the chain will leave it in the off-position, what do you do? Pull it 3 total times or 4 total times?

And as a bonus - how does that apply to this problem?