Text Only | Text with Attachments

QB64.org Forum

Active Forums => Programs => Topic started by: FellippeHeitor on February 25, 2020, 09:19:22 am

Title: Hypnotic polygon orbits
Post by: FellippeHeitor on February 25, 2020, 09:19:22 am
Inspired by this post: https://www.reddit.com/r/gifs/comments/f91c99/every_addtional_shape_adds_one_more_corner_and/ (https://www.reddit.com/r/gifs/comments/f91c99/every_addtional_shape_adds_one_more_corner_and/)


Code: QB64: [Select]
  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
  10.  
  11. DIM SHARED shape(1 TO 13, 1 TO 15) AS shapeType
  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
  18.  
  19. 'save shapes image
  20. PCOPY 0, 1
  21.  
  22. 'have circles follow shapes' paths
  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
  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
  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
  119.  
  120. FUNCTION map! (value!, minRange!, maxRange!, newMinRange!, newMaxRange!)
  121.     map! = ((value! - minRange!) / (maxRange! - minRange!)) * (newMaxRange! - newMinRange!) + newMinRange!
  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
  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.  
  213.  
Title: Re: Hypnotic polygon orbits
Post by: Ashish on February 25, 2020, 09:34:05 am
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
  7.  
  8. TYPE part
  9.     pos AS vec2
  10.     src AS INTEGER
  11.     dest AS INTEGER
  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
  24. pic& = _COPYIMAGE(0)
  25. speed = 0.04
  26. v = 0
  27. w~& = _RGB(255, 255, 255)
  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
  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
  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.  
  124.  
  125.  
  126. FUNCTION map! (value!, minRange!, maxRange!, newMinRange!, newMaxRange!)
  127.     map! = ((value! - minRange!) / (maxRange! - minRange!)) * (newMaxRange! - newMinRange!) + newMinRange!
  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
  152.  
  153.  
Title: Re: Hypnotic polygon orbits
Post by: bplus on February 25, 2020, 09:37:18 am
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.
Title: Re: Hypnotic polygon orbits
Post by: FellippeHeitor on February 25, 2020, 09:39:34 am
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.
Title: Re: Hypnotic polygon orbits
Post by: bplus on February 25, 2020, 03:31:54 pm
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!
  22.  

The bottom segments are all aligned and parallel to bottom of screen.
Title: Re: Hypnotic polygon orbits
Post by: bplus on February 25, 2020, 04:49:38 pm
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
  39.  
Title: Re: Hypnotic polygon orbits
Post by: bplus on February 25, 2020, 05:58:22 pm
OK, just need to add the circles
Code: QB64: [Select]
  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
  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
  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
  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
  100.  
  101.  
  102.  
Title: Re: Hypnotic polygon orbits
Post by: bplus on February 25, 2020, 08:54:39 pm
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
  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
  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
  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
  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
  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?
Title: Re: Hypnotic polygon orbits
Post by: FellippeHeitor on February 25, 2020, 08:58:23 pm
Lol, great investigative work, bplus. Kudos for the xtra attention to detail!
Title: Re: Hypnotic polygon orbits
Post by: bplus on February 25, 2020, 09:01:42 pm
Thanks Fellippe, but now I want that cool pattern maker found in the link. ;-)
Title: Re: Hypnotic polygon orbits
Post by: FellippeHeitor on February 25, 2020, 09:03:44 pm
Something tells me you’re not one to rest until it looks closer...
Title: Re: Hypnotic polygon orbits
Post by: bplus on February 25, 2020, 09:19:27 pm
Well it shouldn't take more than the rest of the night, maybe less?


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

Quote
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!

Title: Re: Hypnotic polygon orbits
Post by: FellippeHeitor on February 25, 2020, 09:26:47 pm
❤️
Title: Re: Hypnotic polygon orbits
Post by: bplus on February 25, 2020, 11:04:53 pm
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
  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
  23.  
  24.  
Title: Re: Hypnotic polygon orbits
Post by: STxAxTIC on February 25, 2020, 11:32:19 pm
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?
Title: Re: Hypnotic polygon orbits
Post by: TerryRitchie on February 26, 2020, 12:19:25 am
No extra pulls. The owners won't even notice because their fish will be dead from lack of oxygen circulating through the tank.
Title: Re: Hypnotic polygon orbits
Post by: bplus on February 26, 2020, 02:19:22 am
Quote from: STxAxTIC on February 25, 2020, 11:32:19 pm
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?

3 X 4 = 12 which is what I used as a unit rate of speed or rather 12ths as multiplier of angle.

For this:
Code: QB64: [Select]
  2. _TITLE "Polygon Orbits 2" '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 = 550, ymax = 550, side = 100, center = 275, P1 = _PI, P2 = P1 * 2, PD2 = P1 * .5
  7. DIM SHARED poly$(3 TO 15) 'point strings we will turn into arrays as needed
  8. DIM SHARED c(3 TO 15) AS _UNSIGNED LONG 'colors
  9. c(3) = &HFF550000: c(4) = &HFFAA0000: c(5) = &HFFFF0000: c(6) = &HFFDD4400: c(7) = &HFF888800: c(8) = &HFFFF8800
  10. c(9) = &HFF00FF00: c(10) = &HFF00FF88: c(11) = &HFF00FFFF: c(12) = &HFF0088FF: c(13) = &HFF0000FF: c(14) = &HF88F0088: c(15) = &HFF330033
  11. DIM SHARED rate(3 TO 15), radii(3 TO 15), a 'for dots
  12.  
  13. SCREEN _NEWIMAGE(xmax, ymax, 32)
  14. _SCREENMOVE 300, 20
  15. DIM i, n, isoA, isoA2, turn, r, x1, y1, currA, x2, y2
  16. FOR i = 3 TO 15
  17.     rate(i) = (16 - i) / 12 'rate as angle mult that disc will move in circle
  19. FOR n = 3 TO 15
  20.     a = P2 / n '                  central angle
  21.     isoA = (P1 - a) / 2 '         angle of one iso triangle at base
  22.     isoA2 = isoA * 2 '            2 iso's is interior angle at each node
  23.     turn = P1 - isoA2 '           for turtle drawing, turn this much at each point
  24.     r = .5 * side / SIN(a / 2) ' << so  << 1/2 * side = r * sin(1/2 * a)
  25.     radii(n) = r
  26.     x1 = center + r * COS(a / 2 + PD2): y1 = center + r * SIN(a / 2 + PD2)
  27.     poly$(n) = STR$(x1) + "," + STR$(y1) 'our first point for polygon
  28.     currA = P1 'turtle draw the rest of the poly and save the points
  29.     FOR i = 2 TO n + 1
  30.         currA = currA + turn
  31.         x2 = x1 + side * COS(currA): y2 = y1 + side * SIN(currA)
  32.         LINE (x1, y1)-(x2, y2)
  33.         x1 = x2: y1 = y2
  34.         poly$(n) = poly$(n) + "," + STR$(x1) + "," + STR$(y1)
  35.     NEXT
  37. WHILE _KEYDOWN(27) = 0
  38.     CLS
  39.     drawPolys
  40.     a = a + _PI(2 / 120)
  41.     _DISPLAY
  42.     _LIMIT 30
  44.  
  45. SUB drawPolys
  46.     DIM n, i, Px, Py, dist, Rx, Ry, r, g, b
  47.     FOR n = 15 TO 3 STEP -1
  48.         'here is where we want our dot but we have to place on a line segment between two closest points to Px, Py
  49.         Px = center + radii(n) * COS(rate(n) * a + PD2)
  50.         Py = center + radii(n) * SIN(rate(n) * a + PD2)
  51.         REDIM pts(0)
  52.         Split poly$(n), ",", pts()
  53.         REDIM min(1), save(1)
  54.         min(0) = 1000: min(1) = 1100: save(0) = -1: save(1) = -2 'dummy
  55.         FOR i = 0 TO UBOUND(pts) STEP 2
  56.             IF i < 2 * n - 1 THEN
  57.                 dist = SQR((Px - pts(i)) ^ 2 + (Py - pts(i + 1)) ^ 2)
  58.                 IF dist <= min(0) THEN
  59.                     min(1) = min(0): min(0) = dist: save(1) = save(0): save(0) = i
  60.                 ELSEIF dist <= min(1) THEN
  61.                     min(1) = dist: save(1) = i
  62.                 END IF
  63.             END IF
  64.             IF i = 0 THEN
  65.                 PSET (pts(0), pts(1)), c(n)
  66.             ELSE
  67.                 LINE -(pts(i), pts(i + 1)), c(n)
  68.             END IF
  69.         NEXT
  70.         'now we have the two closest points of poly to px, py find Rx, RY on that line closest to Px, Py
  71.         IF ABS(pts(save(0)) - pts(save(1))) < .001 THEN ' have perpendicular line so get Rx, RY directly
  72.             Rx = pts(save(0)): Ry = Py
  73.         ELSE
  74.             PointOnLinePerp2Point pts(save(0)), pts(save(0) + 1), pts(save(1)), pts(save(1) + 1), Px, Py, Rx, Ry
  75.         END IF
  76.         r = _RED32(c(n)): g = _GREEN32(c(n)): b = _BLUE32(c(n))
  77.         FOR i = 9 TO 0 STEP -1
  78.             fcirc Rx, Ry, i, midInk(r, g, b, 255, 255, 255, (9 - i) / 9)
  79.         NEXT
  80.     NEXT
  82.  
  83. SUB slopeYintersect (X1, Y1, X2, Y2, slope, Yintercept) ' fix for when x1 = x2
  84.     IF X1 = X2 THEN
  85.         slope = X1
  86.         Yintercept = Y2
  87.     ELSE
  88.         slope = (Y2 - Y1) / (X2 - X1)
  89.         Yintercept = slope * (0 - X1) + Y1
  90.     END IF
  92.  
  93. SUB PointOnLinePerp2Point (Lx1, Ly1, Lx2, Ly2, Px, Py, Rx, Ry)
  94.     '
  95.     'this sub needs  SUB slopeYintersect (X1, Y1, X2, Y2, slope, Yintercept) ' fix for when x1 = x2
  96.     '
  97.     'Lx1, Ly1, Lx2, Ly2     the two points that make a line
  98.     'Px, Py is point off the line
  99.     'Rx, Ry Return Point is the Point on the line perpendicular to Px, Py
  100.     DIM m, Y0, AA, B
  101.     slopeYintersect Lx1, Ly1, Lx2, Ly2, m, Y0
  102.     AA = m ^ 2 + 1
  103.     B = 2 * (m * Y0 - m * Py - Px)
  104.     Rx = -B / (2 * AA)
  105.     Ry = m * Rx + Y0
  107.  
  108. FUNCTION midInk~& (r1%, g1%, b1%, r2%, g2%, b2%, fr##)
  109.     midInk~& = _RGB32(r1% + (r2% - r1%) * fr##, g1% + (g2% - g1%) * fr##, b1% + (b2% - b1%) * fr##)
  111.  
  112. 'this sub modified for splitting into an single array!!!
  113. SUB Split (SplitMeString AS STRING, delim AS STRING, loadMeArray())
  114.     DIM curpos AS LONG, arrpos AS LONG, LD AS LONG, dpos AS LONG 'fix use the Lbound the array already has
  115.     curpos = 1: arrpos = LBOUND(loadMeArray): LD = LEN(delim)
  116.     dpos = INSTR(curpos, SplitMeString, delim)
  117.     DO UNTIL dpos = 0
  118.         loadMeArray(arrpos) = VAL(MID$(SplitMeString, curpos, dpos - curpos))
  119.         arrpos = arrpos + 1
  120.         IF arrpos > UBOUND(loadMeArray) THEN REDIM _PRESERVE loadMeArray(LBOUND(loadMeArray) TO UBOUND(loadMeArray) + 1000)
  121.         curpos = dpos + LD
  122.         dpos = INSTR(curpos, SplitMeString, delim)
  123.     LOOP
  124.     loadMeArray(arrpos) = VAL(MID$(SplitMeString, curpos))
  125.     REDIM _PRESERVE loadMeArray(LBOUND(loadMeArray) TO arrpos) 'get the ubound correct
  127.  
  128. SUB fcirc (CX AS INTEGER, CY AS INTEGER, R AS INTEGER, C AS _UNSIGNED LONG)
  129.     DIM Radius AS INTEGER, RadiusError AS INTEGER
  130.     DIM X AS INTEGER, Y AS INTEGER
  131.     Radius = ABS(R): RadiusError = -Radius: X = Radius: Y = 0
  132.     IF Radius = 0 THEN PSET (CX, CY), C: EXIT SUB
  133.     LINE (CX - X, CY)-(CX + X, CY), C, BF
  134.     WHILE X > Y
  135.         RadiusError = RadiusError + Y * 2 + 1
  136.         IF RadiusError >= 0 THEN
  137.             IF X <> Y + 1 THEN
  138.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
  139.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
  140.             END IF
  141.             X = X - 1
  142.             RadiusError = RadiusError - X * 2
  143.         END IF
  144.         Y = Y + 1
  145.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
  146.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
  147.     WEND
  149.  

 

Title: Re: Hypnotic polygon orbits
Post by: johnno56 on February 26, 2020, 02:37:07 am
Cool.

Noticed that every time the "outer" object completes a semi-orbit all the other object aligns... Cool.
Title: Re: Hypnotic polygon orbits
Post by: FellippeHeitor on February 26, 2020, 02:38:34 am
Gorgeous result, bplus! So harmonious.
Title: Re: Hypnotic polygon orbits
Post by: Ashish on February 26, 2020, 03:24:48 am
awesome bplus!
Title: Re: Hypnotic polygon orbits
Post by: Ashish on February 26, 2020, 04:30:39 am
Here's my version....It is not as good as yours bplus. ;) something buggy in angular speed...
Code: QB64: [Select]
  1. _TITLE "Hypnotic Polygon Orbits [Ashish's Version]"
  2. SCREEN _NEWIMAGE(400, 400, 32)
  3.  
  4. TYPE vec2
  5.     x AS SINGLE
  6.     y AS SINGLE
  8.  
  9. TYPE part
  10.     pos AS vec2
  11.     src AS INTEGER
  12.     dest AS INTEGER
  13.     v AS SINGLE
  14.     angSpeed AS SINGLE
  16.  
  17. DIM SHARED particle_path(11, 13) AS vec2
  18. DIM SHARED particle(10) AS part
  19.  
  20. vel = 3
  21. FOR i = 3 TO 13
  22.     COLOR hsb~&((i - 3) * 17, 255, 128, 255)
  23.     drawShape 200, 200, 30 + 15 * (i - 3), i
  24.     '   particle(i - 3).angSpeed = vel / (25 * (i - 2))  'angular speed. will calculated by v = w*r -> w = v/r and v is constant.
  25.     particle(i - 3).angSpeed = 0.05 * (ABS(i - 14) / 12)
  26.     particle(i - 3).v = 0.5 '    align at the middle
  27.     IF i MOD 2 = 1 THEN
  28.         particle(i - 3).pos = particle_path(i - 3, (i - 1) / 2) '((i+1)/2)-1
  29.         particle(i - 3).src = (i - 1) / 2
  30.         particle(i - 3).dest = particle(i - 3).src + 1
  31.     END IF
  32.     IF i MOD 4 = 0 THEN
  33.         particle(i - 3).pos = particle_path(i - 3, (i - 4) / 4) '((i)/4)-1
  34.         particle(i - 3).src = (i - 4) / 4
  35.         particle(i - 3).dest = particle(i - 3).src + 1
  36.     END IF
  38. particle(3).pos = particle_path(3, 4) 'hack, I just need to care about initial condition
  39. particle(3).src = 4
  40. particle(3).dest = 5
  41. particle(7).pos = particle_path(7, 7)
  42. particle(7).src = 7
  43. particle(7).dest = 8
  44.  
  45.  
  46. pic& = _COPYIMAGE(0)
  47. w~& = _RGB32(255)
  48.  
  50.     CLS
  51.     _PUTIMAGE , pic&
  52.     FOR i = 0 TO UBOUND(particle)
  53.         particle(i).pos.x = map(particle(i).v, 0, 1, particle_path(i, particle(i).src).x, particle_path(i, particle(i).dest).x)
  54.         particle(i).pos.y = map(particle(i).v, 0, 1, particle_path(i, particle(i).src).y, particle_path(i, particle(i).dest).y)
  55.         CircleFill particle(i).pos.x, particle(i).pos.y, 3, w~&
  56.         IF particle(i).v >= 1 THEN
  57.             particle(i).src = particle(i).dest
  58.             IF particle(i).dest = (i + 3) - 1 THEN
  59.                 particle(i).dest = 0
  60.             ELSE
  61.                 particle(i).dest = particle(i).dest + 1
  62.             END IF
  63.             particle(i).v = 0
  64.         END IF
  65.         particle(i).v = particle(i).v + particle(i).angSpeed
  66.     NEXT
  67.  
  68.     _LIMIT 60
  69.     _DISPLAY
  70.  
  72.  
  73. SUB drawShape (x, y, s, n)
  74.     IF n MOD 2 = 1 THEN theta = -_PI(0.5) ELSE theta = _PI(1 / n)
  75.     IF n = 6 OR n = 10 THEN theta = _PI(1 / 2 * n)
  76.     c = 0
  77.     FOR i = theta TO _PI(2) + theta STEP _PI(2 / n)
  78.         x0 = x + s * COS(i)
  79.         y0 = y + s * SIN(i)
  80.         particle_path((n - 3), c).x = x0
  81.         particle_path((n - 3), c).y = y0
  82.         LINE (x0, y0)-(x + s * COS(i + _PI(2 / n)), y + s * SIN(i + _PI(2 / n)))
  83.         c = c + 1
  84.     NEXT
  86.  
  87.  
  88. 'method adapted form http://stackoverflow.com/questions/4106363/converting-rgb-to-hsb-colors
  89. FUNCTION hsb~& (__H AS _FLOAT, __S AS _FLOAT, __B AS _FLOAT, A AS _FLOAT)
  90.     DIM H AS _FLOAT, S AS _FLOAT, B AS _FLOAT
  91.  
  92.     H = map(__H, 0, 255, 0, 360)
  93.     S = map(__S, 0, 255, 0, 1)
  94.     B = map(__B, 0, 255, 0, 1)
  95.  
  96.     IF S = 0 THEN
  97.         hsb~& = _RGBA32(B * 255, B * 255, B * 255, A)
  98.         EXIT FUNCTION
  99.     END IF
  100.  
  101.     DIM fmx AS _FLOAT, fmn AS _FLOAT
  102.     DIM fmd AS _FLOAT, iSextant AS INTEGER
  103.     DIM imx AS INTEGER, imd AS INTEGER, imn AS INTEGER
  104.  
  105.     IF B > .5 THEN
  106.         fmx = B - (B * S) + S
  107.         fmn = B + (B * S) - S
  108.     ELSE
  109.         fmx = B + (B * S)
  110.         fmn = B - (B * S)
  111.     END IF
  112.  
  113.     iSextant = INT(H / 60)
  114.  
  115.     IF H >= 300 THEN
  116.         H = H - 360
  117.     END IF
  118.  
  119.     H = H / 60
  120.     H = H - (2 * INT(((iSextant + 1) MOD 6) / 2))
  121.  
  122.     IF iSextant MOD 2 = 0 THEN
  123.         fmd = (H * (fmx - fmn)) + fmn
  124.     ELSE
  125.         fmd = fmn - (H * (fmx - fmn))
  126.     END IF
  127.  
  128.     imx = _ROUND(fmx * 255)
  129.     imd = _ROUND(fmd * 255)
  130.     imn = _ROUND(fmn * 255)
  131.  
  132.     SELECT CASE INT(iSextant)
  133.         CASE 1
  134.             hsb~& = _RGBA32(imd, imx, imn, A)
  135.         CASE 2
  136.             hsb~& = _RGBA32(imn, imx, imd, A)
  137.         CASE 3
  138.             hsb~& = _RGBA32(imn, imd, imx, A)
  139.         CASE 4
  140.             hsb~& = _RGBA32(imd, imn, imx, A)
  141.         CASE 5
  142.             hsb~& = _RGBA32(imx, imn, imd, A)
  143.         CASE ELSE
  144.             hsb~& = _RGBA32(imx, imd, imn, A)
  145.     END SELECT
  146.  
  148.  
  149.  
  150. FUNCTION map! (value!, minRange!, maxRange!, newMinRange!, newMaxRange!)
  151.     map! = ((value! - minRange!) / (maxRange! - minRange!)) * (newMaxRange! - newMinRange!) + newMinRange!
  153.  
  154. SUB CircleFill (x AS LONG, y AS LONG, R AS LONG, C AS _UNSIGNED LONG)
  155.     DIM x0 AS SINGLE, y0 AS SINGLE
  156.     DIM e AS SINGLE
  157.  
  158.     x0 = R
  159.     y0 = 0
  160.     e = -R
  161.     DO WHILE y0 < x0
  162.         IF e <= 0 THEN
  163.             y0 = y0 + 1
  164.             LINE (x - x0, y + y0)-(x + x0, y + y0), C, BF
  165.             LINE (x - x0, y - y0)-(x + x0, y - y0), C, BF
  166.             e = e + 2 * y0
  167.         ELSE
  168.             LINE (x - y0, y - x0)-(x + y0, y - x0), C, BF
  169.             LINE (x - y0, y + x0)-(x + y0, y + x0), C, BF
  170.             x0 = x0 - 1
  171.             e = e - 2 * x0
  172.         END IF
  173.     LOOP
  174.     LINE (x - R, y)-(x + R, y), C, BF
  176.  
Title: Re: Hypnotic polygon orbits
Post by: Bolee on February 17, 2021, 05:36:59 am
Wow I like the pattern.

There is also something called an ULAM SPIRAL  where you can set the type of polygon and then it spirals (a bit like your pattern but spiraling). I saw it on the freebasic site years ago. It was also on Rosetta code.
Text Only | Text with Attachments