« previous next »
Pages: [1]   Go Down

Author Topic: Star Patterns  (Read 5578 times)

0 Members and 1 Guest are viewing this topic.

This topic contains a post which is marked as Best Answer. Press here if you would like to see it.

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Star Patterns
« on: April 17, 2019, 07:54:11 am »
Watching Shiffmans Islamic Star Patterns Coding Challenge #54.1, I came up with much shorter method for Rectangles that might be generalized to any regular polygon.
&index=70

Instead of sliders, you can use the up / down arrow keys to increase / decrease the inner radius of the 4 point star within the rectangle and use the left / right arrows to decrease / increase the distance from side midpoints that the lines of star end on rectangle tile.

Code: QB64: [Select]
  1. _TITLE "Rectangular Star Tiling: Arrow up/down inner radius, Arrow left/right midpoint distance" 'B+ 2019-04-16
  2. ' Trying to duplicate results shown here by Daniel Shiffman
  3. ' [youtube]https://www.youtube.com/watch?v=sJ6pMLp_IaI&list=PLRqwX-V7Uu6ZiZxtDDRCi6uhfTH4FilpH[/youtube]&index=70
  4. ' but using a completely different method for drawing the tile
  5.  
  6. CONST xmax = 800
  7. CONST ymax = 600
  8. SCREEN _NEWIMAGE(xmax, ymax, 32)
  10.  
  11. wd = 100: ht = 100: rd = 20: dm = 20
  12. WHILE _KEYDOWN(27) = 0
  13.     KH& = _KEYHIT
  14.     SELECT CASE KH&
  15.         CASE 18432 'up
  16.             IF rd + 1 <= min(wd / 2, ht / 2) THEN rd = rd + 1
  17.         CASE 20480 'down
  18.             IF rd - 1 >= 0 THEN rd = rd - 1
  19.         CASE 19200 'left
  20.             IF dm - 1 >= 0 THEN dm = dm - 1
  21.         CASE 19712 'right
  22.             IF dm + 1 <= min(wd / 2, ht / 2) THEN dm = dm + 1
  23.     END SELECT
  24.     CLS
  25.     FOR y = 0 TO ymax STEP ht
  26.         FOR x = 0 TO xmax STEP wd
  27.             drawStarTile x, y, wd, ht, rd, dm
  28.         NEXT
  29.     NEXT
  30.     T$ = "Rectangular Star Tiling: Arrow up/down inner radius = " + _TRIM$(STR$(rd)) + ", Arrow left/right midpoint distance = " + _TRIM$(STR$(dm))
  31.     _TITLE T$
  32.     _DISPLAY
  33.     _LIMIT 60
  35.  
  36. FUNCTION min (n1, n2)
  37.     IF n1 < n2 THEN min = n1 ELSE min = n2
  39.  
  40.  
  41. SUB drawStarTile (x, y, w, h, r, d)
  42.     'this just draws 8 lines from 4 inner circle points to 2 places on each side of rectangle
  43.  
  44.     'some helpers
  45.     pd2 = _PI / 2: pd4 = _PI / 4 'pi
  46.     mpx = x + w / 2: mpy = y + h / 2 'rect midpoint
  47.  
  48.     'inner circle points
  49.     icx1 = mpx + r * COS(pd4)
  50.     icy1 = mpy + r * SIN(pd4)
  51.     icx2 = mpx + r * COS(pd2 + pd4)
  52.     icy2 = mpy + r * SIN(pd2 + pd4)
  53.     icx3 = mpx + r * COS(2 * pd2 + pd4)
  54.     icy3 = mpy + r * SIN(2 * pd2 + pd4)
  55.     icx4 = mpx + r * COS(3 * pd2 + pd4)
  56.     icy4 = mpy + r * SIN(3 * pd2 + pd4)
  57.  
  58.     'outer rectangle points, yeah some variables are redundant
  59.     'right side
  60.     x1 = x + w
  61.     y1 = y + h / 2 - d
  62.     x2 = x + w
  63.     y2 = y + h / 2 + d
  64.     'bottom
  65.     x3 = x + w / 2 + d
  66.     y3 = y + h
  67.     x4 = x + w / 2 - d
  68.     y4 = y + h
  69.     'left
  70.     x5 = x
  71.     y5 = y + h / 2 + d
  72.     x6 = x
  73.     y6 = y + h / 2 - d
  74.     'and top
  75.     x7 = x + w / 2 - d
  76.     y7 = y
  77.     x8 = x + w / 2 + d
  78.     y8 = y
  79.  
  80.     'draw rect
  81.     LINE (x, y)-STEP(w, h), _RGBA(255, 0, 0, 50), B 'here is rect
  82.  
  83.     'draw star
  84.     LINE (icx1, icy1)-(x4, y4)
  85.     LINE (icx1, icy1)-(x1, y1)
  86.     LINE (icx2, icy2)-(x3, y3)
  87.     LINE (icx2, icy2)-(x6, y6)
  88.     LINE (icx3, icy3)-(x5, y5)
  89.     LINE (icx3, icy3)-(x8, y8)
  90.     LINE (icx4, icy4)-(x7, y7)
  91.     LINE (icx4, icy4)-(x2, y2)
  93.  
  94.  

A fun bit of code.

I think this method could be generalized for any regular polygon but you can only tile with 3, 4 and 6 sided polygons (I think).

« Last Edit: April 17, 2019, 07:56:27 am by bplus »
Logged

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Star Patterns
« Reply #1 on: April 17, 2019, 01:29:31 pm »
Yes! generalized to draw any N sided polygon star tile and setting up the square grid again only diagonally:
Code: QB64: [Select]
  1. _TITLE "Regular Polygon Star Tiling" 'B+ 2019-04-17
  2. ' Trying to duplicate results shown here by Daniel Shiffman
  3. ' [youtube]https://www.youtube.com/watch?v=sJ6pMLp_IaI&list=PLRqwX-V7Uu6ZiZxtDDRCi6uhfTH4FilpH[/youtube]&index=70
  4. ' but using a completely different method for drawing the tile
  5. ' 2019-04-17 Yes! the star tile can be generalized to any N sided regular polygon!
  6.  
  7. CONST xmax = 800
  8. CONST ymax = 600
  9. SCREEN _NEWIMAGE(xmax, ymax, 32)
  11.  
  12. FOR i = 3 TO 9
  13.     CLS
  14.     PRINT i; " sided polygon, poly radius 200, inner star radius 60, dist from side midpoints 40."
  15.     drawRegPolyStar 400, 300, 200, i, 60, 40 'OK !
  16.     IF i = 9 THEN
  17.         INPUT "Press enter for a grid of square polygons ", wate$
  18.     ELSE
  19.         INPUT "Press enter for next ", wate$
  20.     END IF
  22.  
  23. 'grid height
  24. polyRadius = 100
  25. griddist = polyRadius * COS(0)
  26. rd = 10
  27. dm = 20
  28.  
  29. WHILE _KEYDOWN(27) = 0
  30.     KH& = _KEYHIT
  31.     SELECT CASE KH&
  32.         CASE 18432 'up
  33.             IF rd + 1 <= polyRadius - 2 THEN rd = rd + 1
  34.         CASE 20480 'down
  35.             IF rd - 1 >= 0 THEN rd = rd - 1
  36.         CASE 19200 'left
  37.             IF dm - 1 >= 0 THEN dm = dm - 1
  38.         CASE 19712 'right
  39.             IF dm + 1 <= SQR(2) * polyRadius / 2 THEN dm = dm + 1
  40.     END SELECT
  41.     CLS
  42.     xoff = 0
  43.     FOR y = 0 TO ymax STEP griddist
  44.         xoff = (xoff + 1) MOD 2
  45.         FOR x = 0 TO xmax STEP 2 * griddist
  46.             drawRegPolyStar x + xoff * griddist, y, polyRadius, 4, rd, dm
  47.         NEXT
  48.     NEXT
  49.  
  50.     T$ = "Square Star Tiling: Arrow up/down inner radius = " + _TRIM$(STR$(rd)) + ", Arrow left/right midpoint distance = " + _TRIM$(STR$(dm))
  51.     _TITLE T$
  52.     _DISPLAY
  53.     _LIMIT 10
  55.  
  56.  
  57. SUB drawRegPolyStar (cx, cy, pRadius, nSides, innerStarRadius, midPtDist)
  58.     DIM tilePtsX(1 TO nSides), tilePtsY(1 TO nSides)
  59.     DIM innerStarX(1 TO nSides), innerStarY(1 TO nSides)
  60.  
  61.     pA = _PI(2 / nSides)
  62.     FOR i = 1 TO nSides
  63.         tilePtsX(i) = cx + pRadius * COS(pA * i)
  64.         tilePtsY(i) = cy + pRadius * SIN(pA * i)
  65.         'on the same line the innerStar pts
  66.         innerStarX(i) = cx + innerStarRadius * COS(pA * i)
  67.         innerStarY(i) = cy + innerStarRadius * SIN(pA * i)
  68.         'CIRCLE (innerStarX(i), innerStarY(i)), 3, _RGB32(255, 255, 0)
  69.         'draw tile
  70.         IF i > 1 THEN
  71.             LINE (tilePtsX(i), tilePtsY(i))-(tilePtsX(i - 1), tilePtsY(i - 1)), _RGB32(255, 0, 0, 200)
  72.             IF i = nSides THEN
  73.                 LINE (tilePtsX(i), tilePtsY(i))-(tilePtsX(1), tilePtsY(1)), _RGB32(255, 0, 0, 200)
  74.             END IF
  75.         END IF
  76.         '_DELAY .5
  77.     NEXT
  78.  
  79.     'from each innerStarPt 2 lines connect to side midpoints
  80.     'lets calc all the midpoints +/- midPtDist
  81.     DIM mpdX(1 TO 2 * nSides), mpdY(1 TO 2 * nSides)
  82.     FOR i = 1 TO nSides
  83.         IF i - 1 = 0 THEN ei = nSides ELSE ei = i - 1
  84.         mx = (tilePtsX(ei) + tilePtsX(i)) / 2
  85.         my = (tilePtsY(ei) + tilePtsY(i)) / 2
  86.         'check
  87.         'CIRCLE (mx, my), 2, _RGB32(0, 0, 255)
  88.         '_DELAY .5
  89.  
  90.         'from each mx, my we need a point midPtDist along the angle from mx, my to the ei index point
  91.         a = _ATAN2(tilePtsY(ei) - my, tilePtsX(ei) - mx)
  92.         mdx = mx + midPtDist * COS(a)
  93.         mdy = my + midPtDist * SIN(a)
  94.         'the other point is 180 degrees in opposite direction
  95.         mdx2 = mx + midPtDist * COS(a - _PI)
  96.         mdy2 = my + midPtDist * SIN(a - _PI)
  97.         'check
  98.         'CIRCLE (mdx, mdy), 2, _RGB32(255, 255, 0)
  99.         'CIRCLE (mdx2, mdy2), 2, _RGB32(255, 0, 255)
  100.  
  101.         'OK store all these points for drawing lines later
  102.         mpdX(2 * i - 1) = mdx: mpdY(2 * i - 1) = mdy
  103.         mpdX(2 * i) = mdx2: mpdY(2 * i) = mdy2
  104.  
  105.     NEXT
  106.  
  107.     'from each point in inner star Radius draw 2 lines to the poly edges
  108.     FOR i = 1 TO nSides
  109.         'now figure the pattern: sequence maps are to 2*i +2 and to 2*i - 1
  110.         IF 2 * i + 2 > 2 * nSides THEN map = 2 * i + 2 - 2 * nSides ELSE map = 2 * i + 2
  111.         LINE (innerStarX(i), innerStarY(i))-(mpdX(map), mpdY(map))
  112.  
  113.         IF 2 * i - 1 < 1 THEN map = 2 * i - 1 + 2 * nSides ELSE map = 2 * i - 1
  114.         LINE (innerStarX(i), innerStarY(i))-(mpdX(map), mpdY(map))
  115.         '_DELAY .5
  116.     NEXT
  117.  
  119.  
  120.  

Some trouble setting up for hexagonal grid and allot of redundant calculation can be eliminated, probably by drawing one tile and placing a copy where ever needed or just sharing the arrays that contain the points calculations.
Logged

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Star Patterns
« Reply #2 on: April 17, 2019, 08:27:48 pm »
Hexagonal Star Tiling:
Code: QB64: [Select]
  1. _TITLE "Hexagonal Star Tiling" 'B+ 2019-04-17
  2. ' Trying to duplicate results shown here by Daniel Shiffman
  3. ' [youtube]https://www.youtube.com/watch?v=sJ6pMLp_IaI&list=PLRqwX-V7Uu6ZiZxtDDRCi6uhfTH4FilpH[/youtube]&index=70
  4. ' but using a completely different method for drawing the tile
  5. ' 2019-04-17 Yes! the star tile can be generalized to any N sided regular polygon!
  6. ' 2019-04-17 This version try Hexagonal Tiling
  7.  
  8. CONST xmax = 800
  9. CONST ymax = 600
  10. SCREEN _NEWIMAGE(xmax, ymax, 32)
  12.  
  13. 'grid height
  14. polyRadius = 100
  15. gridheight = polyRadius * SQR(3) / 2
  16. rd = 10
  17. dm = 20
  18. WHILE _KEYDOWN(27) = 0
  19.     KH& = _KEYHIT
  20.     SELECT CASE KH&
  21.         CASE 18432 'up
  22.             IF rd + 1 <= polyRadius - 2 THEN rd = rd + 1
  23.         CASE 20480 'down
  24.             IF rd - 1 >= 0 THEN rd = rd - 1
  25.         CASE 19200 'left
  26.             IF dm - 1 >= 0 THEN dm = dm - 1
  27.         CASE 19712 'right
  28.             IF dm + 1 <= .5 * polyRadius THEN dm = dm + 1
  29.     END SELECT
  30.     CLS
  31.     xoff = 0
  32.     FOR y = 0 TO ymax + gridheight STEP gridheight
  33.         xoff = (xoff + 1) MOD 2
  34.         FOR x = 0 TO xmax STEP 3 * polyRadius
  35.             drawRegPolyStar x + xoff * 1.5 * polyRadius, y, polyRadius, 6, rd, dm
  36.         NEXT
  37.     NEXT
  38.     T$ = "Hexagonal Star Tiling: Arrow up/down inner radius = " + _TRIM$(STR$(rd)) + ", Arrow left/right midpoint distance = " + _TRIM$(STR$(dm))
  39.     _TITLE T$
  40.     _DISPLAY
  41.     _LIMIT 10
  43.  
  44. SUB drawRegPolyStar (cx, cy, pRadius, nSides, innerStarRadius, midPtDist)
  45.     DIM tilePtsX(1 TO nSides), tilePtsY(1 TO nSides)
  46.     DIM innerStarX(1 TO nSides), innerStarY(1 TO nSides)
  47.  
  48.     pA = _PI(2 / nSides)
  49.     FOR i = 1 TO nSides
  50.         tilePtsX(i) = cx + pRadius * COS(pA * i)
  51.         tilePtsY(i) = cy + pRadius * SIN(pA * i)
  52.         'on the same line the innerStar pts
  53.         innerStarX(i) = cx + innerStarRadius * COS(pA * i)
  54.         innerStarY(i) = cy + innerStarRadius * SIN(pA * i)
  55.         'CIRCLE (innerStarX(i), innerStarY(i)), 3, _RGB32(255, 255, 0)
  56.         'draw tile
  57.         IF i > 1 THEN
  58.             LINE (tilePtsX(i), tilePtsY(i))-(tilePtsX(i - 1), tilePtsY(i - 1)), _RGB32(255, 0, 0, 200)
  59.             IF i = nSides THEN
  60.                 LINE (tilePtsX(i), tilePtsY(i))-(tilePtsX(1), tilePtsY(1)), _RGB32(255, 0, 0, 200)
  61.             END IF
  62.         END IF
  63.         '_DELAY .5
  64.     NEXT
  65.  
  66.     'from each innerStarPt 2 lines connect to side midpoints
  67.     'lets calc all the midpoints +/- midPtDist
  68.     DIM mpdX(1 TO 2 * nSides), mpdY(1 TO 2 * nSides)
  69.     FOR i = 1 TO nSides
  70.         IF i - 1 = 0 THEN ei = nSides ELSE ei = i - 1
  71.         mx = (tilePtsX(ei) + tilePtsX(i)) / 2
  72.         my = (tilePtsY(ei) + tilePtsY(i)) / 2
  73.         'check
  74.         'CIRCLE (mx, my), 2, _RGB32(0, 0, 255)
  75.         '_DELAY .5
  76.  
  77.         'from each mx, my we need a point midPtDist along the angle from mx, my to the ei index point
  78.         a = _ATAN2(tilePtsY(ei) - my, tilePtsX(ei) - mx)
  79.         mdx = mx + midPtDist * COS(a)
  80.         mdy = my + midPtDist * SIN(a)
  81.         'the other point is 180 degrees in opposite direction
  82.         mdx2 = mx + midPtDist * COS(a - _PI)
  83.         mdy2 = my + midPtDist * SIN(a - _PI)
  84.         'check
  85.         'CIRCLE (mdx, mdy), 2, _RGB32(255, 255, 0)
  86.         'CIRCLE (mdx2, mdy2), 2, _RGB32(255, 0, 255)
  87.  
  88.         'OK store all these points for drawing lines later
  89.         mpdX(2 * i - 1) = mdx: mpdY(2 * i - 1) = mdy
  90.         mpdX(2 * i) = mdx2: mpdY(2 * i) = mdy2
  91.  
  92.     NEXT
  93.  
  94.     'from each point in inner star Radius draw 2 lines to the poly edges
  95.     FOR i = 1 TO nSides
  96.         'now figure the pattern: sequence maps are to 2*i +2 and to 2*i - 1
  97.         IF 2 * i + 2 > 2 * nSides THEN map = 2 * i + 2 - 2 * nSides ELSE map = 2 * i + 2
  98.         LINE (innerStarX(i), innerStarY(i))-(mpdX(map), mpdY(map))
  99.  
  100.         IF 2 * i - 1 < 1 THEN map = 2 * i - 1 + 2 * nSides ELSE map = 2 * i - 1
  101.         LINE (innerStarX(i), innerStarY(i))-(mpdX(map), mpdY(map))
  102.         '_DELAY .5
  103.     NEXT
  104.  
  106.  
  107.  
Logged

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Star Patterns
« Reply #3 on: April 17, 2019, 08:54:05 pm »
Draw one tile and rubber stamp the grid with the image to skip recalculations for every tile:
Code: QB64: [Select]
  1. _TITLE "Hexagonal Star Tiling 2" 'B+ 2019-04-17
  2. ' Trying to duplicate results shown here by Daniel Shiffman
  3. ' [youtube]https://www.youtube.com/watch?v=sJ6pMLp_IaI&list=PLRqwX-V7Uu6ZiZxtDDRCi6uhfTH4FilpH[/youtube]&index=70
  4. ' but using a completely different method for drawing the tile
  5. ' 2019-04-17 Yes! the star tile can be generalized to any N sided regular polygon!
  6. ' 2019-04-17 This version try Hexagonal Tiling.
  7. ' 2019-04-17 Hexagonal Star Tiling 2, prep one tile and rubber stamp the grid with image.
  8.  
  9. CONST xmax = 800
  10. CONST ymax = 600
  11. SCREEN _NEWIMAGE(xmax, ymax, 32)
  13. DIM SHARED tile&
  14.  
  15. 'grid height
  16. polyRadius = 100
  17. gridheight = polyRadius * SQR(3) / 2
  18.  
  19. rd = 10
  20. dm = 20
  21. prepTile polyRadius, 6, rd, dm
  22. WHILE _KEYDOWN(27) = 0
  23.     KH& = _KEYHIT
  24.     SELECT CASE KH&
  25.         CASE 18432 'up
  26.             IF rd + 1 <= polyRadius - 2 THEN rd = rd + 1: prepTile polyRadius, 6, rd, dm
  27.         CASE 20480 'down
  28.             IF rd - 1 >= 0 THEN rd = rd - 1: prepTile polyRadius, 6, rd, dm
  29.         CASE 19200 'left
  30.             IF dm - 1 >= 0 THEN dm = dm - 1: prepTile polyRadius, 6, rd, dm
  31.         CASE 19712 'right
  32.             IF dm + 1 <= .5 * polyRadius THEN dm = dm + 1: prepTile polyRadius, 6, rd, dm
  33.     END SELECT
  34.     CLS
  35.     xoff = 0
  36.     FOR y = -polyRadius TO ymax + gridheight STEP gridheight
  37.         xoff = (xoff + 1) MOD 2
  38.         FOR x = -polyRadius TO xmax STEP 3 * polyRadius
  39.             _PUTIMAGE (x + xoff * 1.5 * polyRadius, y), tile&, 0
  40.             'drawRegPolyStar x + xoff * 1.5 * polyRadius, y, polyRadius, 6, rd, dm
  41.         NEXT
  42.     NEXT
  43.     T$ = "Square Star Tiling: Arrow up/down inner radius = " + _TRIM$(STR$(rd)) + ", Arrow left/right midpoint distance = " + _TRIM$(STR$(dm))
  44.     _TITLE T$
  45.     _DISPLAY
  46.     _LIMIT 60
  48.  
  49. SUB prepTile (pRadius, nSides, innerStarRadius, midPtDist)
  50.     IF tile& THEN _FREEIMAGE tile&
  51.     tile& = _NEWIMAGE(2 * pRadius, 2 * pRadius, 32)
  52.     _DEST tile&
  53.     drawRegPolyStar pRadius, pRadius, pRadius, nSides, innerStarRadius, midPtDist
  54.     _DEST 0
  56.  
  57. SUB drawRegPolyStar (cx, cy, pRadius, nSides, innerStarRadius, midPtDist)
  58.     DIM tilePtsX(1 TO nSides), tilePtsY(1 TO nSides)
  59.     DIM innerStarX(1 TO nSides), innerStarY(1 TO nSides)
  60.  
  61.     pA = _PI(2 / nSides)
  62.     FOR i = 1 TO nSides
  63.         tilePtsX(i) = cx + pRadius * COS(pA * i)
  64.         tilePtsY(i) = cy + pRadius * SIN(pA * i)
  65.         'on the same line the innerStar pts
  66.         innerStarX(i) = cx + innerStarRadius * COS(pA * i)
  67.         innerStarY(i) = cy + innerStarRadius * SIN(pA * i)
  68.         'CIRCLE (innerStarX(i), innerStarY(i)), 3, _RGB32(255, 255, 0)
  69.         'draw tile
  70.         IF i > 1 THEN
  71.             LINE (tilePtsX(i), tilePtsY(i))-(tilePtsX(i - 1), tilePtsY(i - 1)), _RGB32(255, 0, 0, 200)
  72.             IF i = nSides THEN
  73.                 LINE (tilePtsX(i), tilePtsY(i))-(tilePtsX(1), tilePtsY(1)), _RGB32(255, 0, 0, 200)
  74.             END IF
  75.         END IF
  76.         '_DELAY .5
  77.     NEXT
  78.  
  79.     'from each innerStarPt 2 lines connect to side midpoints
  80.     'lets calc all the midpoints +/- midPtDist
  81.     DIM mpdX(1 TO 2 * nSides), mpdY(1 TO 2 * nSides)
  82.     FOR i = 1 TO nSides
  83.         IF i - 1 = 0 THEN ei = nSides ELSE ei = i - 1
  84.         mx = (tilePtsX(ei) + tilePtsX(i)) / 2
  85.         my = (tilePtsY(ei) + tilePtsY(i)) / 2
  86.         'check
  87.         'CIRCLE (mx, my), 2, _RGB32(0, 0, 255)
  88.         '_DELAY .5
  89.  
  90.         'from each mx, my we need a point midPtDist along the angle from mx, my to the ei index point
  91.         a = _ATAN2(tilePtsY(ei) - my, tilePtsX(ei) - mx)
  92.         mdx = mx + midPtDist * COS(a)
  93.         mdy = my + midPtDist * SIN(a)
  94.         'the other point is 180 degrees in opposite direction
  95.         mdx2 = mx + midPtDist * COS(a - _PI)
  96.         mdy2 = my + midPtDist * SIN(a - _PI)
  97.         'check
  98.         'CIRCLE (mdx, mdy), 2, _RGB32(255, 255, 0)
  99.         'CIRCLE (mdx2, mdy2), 2, _RGB32(255, 0, 255)
  100.  
  101.         'OK store all these points for drawing lines later
  102.         mpdX(2 * i - 1) = mdx: mpdY(2 * i - 1) = mdy
  103.         mpdX(2 * i) = mdx2: mpdY(2 * i) = mdy2
  104.  
  105.     NEXT
  106.  
  107.     'from each point in inner star Radius draw 2 lines to the poly edges
  108.     FOR i = 1 TO nSides
  109.         'now figure the pattern: sequence maps are to 2*i +2 and to 2*i - 1
  110.         IF 2 * i + 2 > 2 * nSides THEN map = 2 * i + 2 - 2 * nSides ELSE map = 2 * i + 2
  111.         LINE (innerStarX(i), innerStarY(i))-(mpdX(map), mpdY(map))
  112.  
  113.         IF 2 * i - 1 < 1 THEN map = 2 * i - 1 + 2 * nSides ELSE map = 2 * i - 1
  114.         LINE (innerStarX(i), innerStarY(i))-(mpdX(map), mpdY(map))
  115.         '_DELAY .5
  116.     NEXT
  117.  
  119.  
  120.  

EDIT: change main loop _LIMIT
« Last Edit: April 17, 2019, 09:01:57 pm by bplus »
Logged

Offline TempodiBasic

  • Forum Resident
  • Posts: 1792
    • View Profile
Re: Star Patterns
« Reply #4 on: April 18, 2019, 10:46:26 am »
Hi Bplus
Thanks to share!
I find very attonishing how Math is our better meter to misure and to reproduce the world.
What should Pitagora think about this?
Logged
Programming isn't difficult, only it's  consuming time and coffee

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Star Patterns
« Reply #5 on: April 18, 2019, 11:44:04 am »
Quote from: TempodiBasic on April 18, 2019, 10:46:26 am
Hi Bplus
Thanks to share!
I find very attonishing how Math is our better meter to misure and to reproduce the world.
What should Pitagora think about this?

What would Pythagoras think of computers and programming? He would love QB64!

Quote
There is geometry in the humming of the strings, there is music in the spacing of the spheres.
Read more at: https://www.brainyquote.com/authors/pythagoras
Logged

Offline qb4ever

  • Newbie
  • Posts: 40
  • LOCATE 15,15: COLOR 14: PRINT "Hello World!"
    • View Profile
Re: Star Patterns
« Reply #6 on: April 18, 2019, 06:26:33 pm »
Quote from: bplus on April 18, 2019, 11:44:04 am
What would Pythagoras think of computers and programming? He would love QB64!

Sure !
Logged

Offline Jack002

  • Forum Regular
  • Posts: 123
  • Boss, l wanna talk about arrays
    • View Profile
Re: Star Patterns
« Reply #7 on: April 19, 2019, 09:27:56 am »
Quote from: bplus on April 18, 2019, 11:44:04 am
What would Pythagoras think of computers and programming? He would love QB64!
He would be PI eyed
Logged
QB64 is the best!

Offline Ashish

  • Forum Resident
  • Posts: 630
  • Never Give Up!
    • View Profile
Re: Star Patterns
« Reply #8 on: April 19, 2019, 11:44:22 am »
Nice effect, Bplus!
Logged
if (Me.success) {Me.improve()} else {Me.tryAgain()}


My Projects - https://github.com/AshishKingdom?tab=repositories
OpenGL tutorials - https://ashishkingdom.github.io/OpenGL-Tutorials
Marked as best answer by bplus on September 04, 2019, 07:29:29 am

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Star Patterns
« Reply #9 on: April 19, 2019, 01:27:20 pm »
Thanks Ashish,

Here is screen saver style dynamic tiling:
Code: QB64: [Select]
  1. _TITLE "Hexagonal Star Tiling 3" 'B+ 2019-04-19
  2. ' Trying to duplicate results shown here by Daniel Shiffman
  3. ' [youtube]https://www.youtube.com/watch?v=sJ6pMLp_IaI&list=PLRqwX-V7Uu6ZiZxtDDRCi6uhfTH4FilpH[/youtube]&index=70
  4. ' but using a completely different method for drawing the tile
  5. ' 2019-04-17 Yes! the star tile can be generalized to any N sided regular polygon!
  6. ' 2019-04-17 This version try Hexagonal Tiling.
  7. ' 2019-04-17 Hexagonal Star Tiling 2, prep one tile and rubber stamp the grid with image.
  8. ' 2019-04-18 Go for a dynamic tile, image constantly changing
  9.  
  10. CONST xmax = 1380 'bigger than your screen can hold
  11. CONST ymax = 800
  12. SCREEN _NEWIMAGE(xmax, ymax, 32)
  13. '_SCREENMOVE _MIDDLE
  16.  
  17. DIM SHARED tile&, polyRadius, triColor AS _UNSIGNED LONG
  18.  
  19. polyRadius = 60
  20. gridheight = polyRadius * SQR(3) / 2
  21. triColor = _RGB32(0, 0, 255)
  22. rd = 10
  23. dm = 20
  24. prepTile polyRadius, rd, dm
  25. rDir = 1: dDir = 1
  26. WHILE _KEYDOWN(27) = 0
  27.     IF rDir = 1 THEN
  28.         IF rd + 1 <= polyRadius * .5 THEN
  29.             rd = rd + 1: prepTile polyRadius, rd, dm
  30.         ELSE
  31.  
  32.             IF RND > .8 THEN
  33.                 polyRadius = rand(20, 200)
  34.                 triColor = _RGB32(128 * RND + 127, 128 * RND + 127, 128 * RND + 127)
  35.                 rDir = -1: dm = RND * polyRadius * .5: rd = RND * polyRadius * .5 \ 1
  36.                 COLOR , _RGB32(128 * RND, 128 * RND, 128 * RND)
  37.             ELSE
  38.                 rDir = -1
  39.             END IF
  40.         END IF
  41.     END IF
  42.     IF rDir = -1 THEN
  43.         IF rd - 1 >= 0 THEN
  44.             rd = rd - 1: prepTile polyRadius, rd, dm
  45.         ELSE
  46.             IF RND > .8 THEN
  47.                 triColor = _RGB32(128 * RND, 128 * RND, 128 * RND)
  48.                 polyRadius = rand(20, 200)
  49.                 rDir = 1: dm = RND * polyRadius * .5: rd = RND * polyRadius * .5 \ 1
  50.                 COLOR , _RGB32(128 * RND + 127, 128 * RND + 127, 128 * RND + 127)
  51.             ELSE
  52.                 rDir = 1
  53.             END IF
  54.         END IF
  55.     END IF
  56.  
  57.     CLS
  58.     gridheight = polyRadius * SQR(3) / 2
  59.     xoff = 0
  60.     FOR y = -polyRadius TO ymax + gridheight STEP gridheight
  61.         xoff = (xoff + 1) MOD 2
  62.         FOR x = -polyRadius TO xmax STEP 3 * polyRadius
  63.             _PUTIMAGE (x + xoff * 1.5 * polyRadius, y), tile&, 0
  64.         NEXT
  65.     NEXT
  66.     _DISPLAY
  67.     _LIMIT .1 * polyRadius
  70.  
  71. SUB prepTile (pRadius, innerStarRadius, midPtDist)
  72.     IF tile& THEN _FREEIMAGE tile&
  73.     tile& = _NEWIMAGE(2 * pRadius, 2 * pRadius, 32)
  74.     _DEST tile&
  75.     drawRegPolyStar pRadius, pRadius, pRadius, 6, innerStarRadius, midPtDist, triColor
  76.     _DEST 0
  78.  
  79. SUB drawRegPolyStar (cx, cy, pRadius, nSides, innerStarRadius, midPtDist, c1 AS _UNSIGNED LONG)
  80.     DIM tilePtsX(1 TO nSides), tilePtsY(1 TO nSides)
  81.     DIM innerStarX(1 TO nSides), innerStarY(1 TO nSides)
  82.  
  83.     pA = _PI(2 / nSides)
  84.     FOR i = 1 TO nSides
  85.         tilePtsX(i) = cx + pRadius * COS(pA * i)
  86.         tilePtsY(i) = cy + pRadius * SIN(pA * i)
  87.         'on the same line the innerStar pts
  88.         innerStarX(i) = cx + innerStarRadius * COS(pA * i)
  89.         innerStarY(i) = cy + innerStarRadius * SIN(pA * i)
  90.         'CIRCLE (innerStarX(i), innerStarY(i)), 3, _RGB32(255, 255, 0)
  91.         'draw tile
  92.         IF i > 1 THEN
  93.             LINE (tilePtsX(i), tilePtsY(i))-(tilePtsX(i - 1), tilePtsY(i - 1)), _RGB32(255, 0, 0, 200)
  94.             IF i = nSides THEN
  95.                 LINE (tilePtsX(i), tilePtsY(i))-(tilePtsX(1), tilePtsY(1)), _RGB32(255, 0, 0, 200)
  96.             END IF
  97.         END IF
  98.         '_DELAY .5
  99.     NEXT
  100.  
  101.     'from each innerStarPt 2 lines connect to side midpoints
  102.     'lets calc all the midpoints +/- midPtDist
  103.     DIM mpdX(1 TO 2 * nSides), mpdY(1 TO 2 * nSides)
  104.     FOR i = 1 TO nSides
  105.         IF i - 1 = 0 THEN ei = nSides ELSE ei = i - 1
  106.         mx = (tilePtsX(ei) + tilePtsX(i)) / 2
  107.         my = (tilePtsY(ei) + tilePtsY(i)) / 2
  108.         'check
  109.         'CIRCLE (mx, my), 2, _RGB32(0, 0, 255)
  110.         '_DELAY .5
  111.  
  112.         'from each mx, my we need a point midPtDist along the angle from mx, my to the ei index point
  113.         a = _ATAN2(tilePtsY(ei) - my, tilePtsX(ei) - mx)
  114.         mdx = mx + midPtDist * COS(a)
  115.         mdy = my + midPtDist * SIN(a)
  116.         'the other point is 180 degrees in opposite direction
  117.         mdx2 = mx + midPtDist * COS(a - _PI)
  118.         mdy2 = my + midPtDist * SIN(a - _PI)
  119.         'check
  120.         'CIRCLE (mdx, mdy), 2, _RGB32(255, 255, 0)
  121.         'CIRCLE (mdx2, mdy2), 2, _RGB32(255, 0, 255)
  122.  
  123.         'OK store all these points for drawing lines later
  124.         mpdX(2 * i - 1) = mdx: mpdY(2 * i - 1) = mdy
  125.         mpdX(2 * i) = mdx2: mpdY(2 * i) = mdy2
  126.  
  127.     NEXT
  128.     COLOR c1
  129.     'from each point in inner star Radius draw 2 lines to the poly edges
  130.     FOR i = 1 TO nSides
  131.         'now figure the pattern: sequence maps are to 2*i +2 and to 2*i - 1
  132.         IF 2 * i + 2 > 2 * nSides THEN map = 2 * i + 2 - 2 * nSides ELSE map = 2 * i + 2
  133.         LINE (innerStarX(i), innerStarY(i))-(mpdX(map), mpdY(map))
  134.  
  135.         IF 2 * i - 1 < 1 THEN map2 = 2 * i - 1 + 2 * nSides ELSE map2 = 2 * i - 1
  136.         LINE (innerStarX(i), innerStarY(i))-(mpdX(map2), mpdY(map2))
  137.  
  138.         ftri innerStarX(i), innerStarY(i), mpdX(map), mpdY(map), mpdX(map2), mpdY(map2), c1
  139.         '_DELAY .5
  140.     NEXT
  141.  
  143.  
  144. FUNCTION rand% (lo%, hi%)
  145.     rand% = INT(RND * (hi% - lo% + 1)) + lo%
  147.  
  148. ' found at [abandoned, outdated and now likely malicious qb64 dot net website - don’t go there]:    http://www.[abandoned, outdated and now likely malicious qb64 dot net website - don’t go there]/forum/index.php?topic=14425.0
  149. SUB ftri (x1, y1, x2, y2, x3, y3, K AS _UNSIGNED LONG)
  150.     a& = _NEWIMAGE(1, 1, 32)
  151.     _DEST a&
  152.     PSET (0, 0), K
  153.     _DEST tile&
  154.     _MAPTRIANGLE _SEAMLESS(0, 0)-(0, 0)-(0, 0), a& TO(x1, y1)-(x2, y2)-(x3, y3)
  155.     _FREEIMAGE a& '<<< this is important!
  157.  
  158.  
Logged
Pages: [1]   Go Up
« previous next »