Sierpinski Circled

[bplus]

A new twist on an old fractal! Sierpinski generalized beyond the triangle to any regular poly (though does not work well above 8 or 9) also made dynamic.

Code: QB64: [Select]

1. _TITLE "Sierepinski Circled by bplus 2018-04-04"
2. CONST xmax = 800
3. CONST ymax = 600
4. RANDOMIZE TIMER
5. SCREEN _NEWIMAGE(xmax, ymax, 32)
6. _SCREENMOVE 360, 60
7. FOR n = 3 TO 8
8.     a = 0
9.     COLOR _RGBA((RND * 155 + 100) * INT(RND * 2), RND * 155 + 100, (RND * 155 + 100) * INT(RND * 2), 40)
10.     WHILE a < _PI(2) - _PI(1 / 360)
11.         CLS
12.         a = a + _PI(1 / 360)
13.         levels = 9 - n + 3
14.         RecurringCircles xmax / 2, ymax / 2, ymax / 8, n, a, levels
15.         _DISPLAY
16.         _LIMIT 200
17.     WEND
18.     _DELAY 5
19. NEXT
20. SUB RecurringCircles (x, y, r, n, rao, level)
21.     fcirc x, y, r
22.     IF level > 0 THEN
23.         ra = _PI(2) / n
24.         FOR i = 0 TO n - 1
25.             x1 = x + 1.5 * r * COS(i * ra + rao + _PI(-.5))
26.             y1 = y + 1.5 * r * SIN(i * ra + rao + _PI(-.5))
27.             RecurringCircles x1, y1, r * .5, n, 2 * rao, level - 1
28.         NEXT
29.     END IF
30. END SUB
31.  
32. 'Steve McNeil's  copied from his forum   note: Radius is too common a name
33. SUB fcirc (CX AS LONG, CY AS LONG, R AS LONG)
34.     DIM subRadius AS LONG, RadiusError AS LONG
35.     DIM X AS LONG, Y AS LONG
36.  
37.     subRadius = ABS(R)
38.     RadiusError = -subRadius
39.     X = subRadius
40.     Y = 0
41.  
42.     IF subRadius = 0 THEN PSET (CX, CY): EXIT SUB
43.  
44.     ' Draw the middle span here so we don't draw it twice in the main loop,
45.     ' which would be a problem with blending turned on.
46.     LINE (CX - X, CY)-(CX + X, CY), , BF
47.  
48.     WHILE X > Y
49.         RadiusError = RadiusError + Y * 2 + 1
50.         IF RadiusError >= 0 THEN
51.             IF X <> Y + 1 THEN
52.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), , BF
53.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), , BF
54.             END IF
55.             X = X - 1
56.             RadiusError = RadiusError - X * 2
57.         END IF
58.         Y = Y + 1
59.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), , BF
60.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), , BF
61.     WEND
62. END SUB
63.  

The screen shots are stationary stills of final (or start) position.

[STxAxTIC]

These are immensely satisfying to watch - didn't expect it to "snap" to a final result before ending. Nice nice!

[_vince]

Original concept? Really great

[bplus]

Original concept? Really great

Thanks guys!

The idea of doing Sierpinski Triangles with circles has been on the back burner of my mind for some time and this afternoon, I sat down and got it going. It was so easy that I generalized to any n and running through angle offsets was also easy. I think it a great application for alpha coloring.

Original? It is so simple an idea, I am probably not first to come up with it but I haven't seen code for anything like this. 

[_vince]

made it into an animated gif

[Richard Frost]

Very pretty!

It could be titled "Snowflakes are Dancing", which is an old Isao Tomita electronic music album.
It's what I thought of when I first saw it.

Perhaps download that music and use it in the program, if that's legal where you live.

[bplus]

Ah Music! :)

'paste into browser Alan Parsons Project Mammagamma from Eye in Sky Album
' 

' or whatever...

Code: QB64: [Select]

1. _TITLE "Sierepinski Circled" ' by bplus 2018-04-04"
2. '2019-02-02 mod random
3.  
4. CONST xmax = 740
5. CONST ymax = 740
6. RANDOMIZE TIMER
7. SCREEN _NEWIMAGE(xmax, ymax, 32)
8. _SCREENMOVE 300, 0
9.  
10. 'paste into browser Alan Parson Project Mammagamma from Eye in Sky Album
11. '  [youtube]https://www.youtube.com/watch?v=XXzOkCLdFwI[/youtube]
12.  
13. ' or whatever...
14.  
15. WHILE _KEYHIT <> 27
16.     n = RND * 6 \ 1 + 3
17.     a = 0
18.     COLOR _RGBA((RND * 155 + 100) * INT(RND * 2), RND * 155 + 100, (RND * 155 + 100) * INT(RND * 2), 40)
19.     WHILE a < _PI(2) - _PI(1 / 360)
20.         CLS
21.         a = a + _PI(1 / 360)
22.         levels = 9 - n + 3
23.         RecurringCircles xmax / 2, ymax / 2, ymax / 6, n, a, levels
24.         _DISPLAY
25.         _LIMIT 60
26.     WEND
27.     _DELAY 5
28. WEND
29.  
30. SUB RecurringCircles (x, y, r, n, rao, level)
31.     fcirc x, y, r
32.     IF level > 0 THEN
33.         ra = _PI(2) / n
34.         FOR i = 0 TO n - 1
35.             x1 = x + 1.5 * r * COS(i * ra + rao + _PI(-.5))
36.             y1 = y + 1.5 * r * SIN(i * ra + rao + _PI(-.5))
37.             RecurringCircles x1, y1, r * .5, n, 2 * rao, level - 1
38.         NEXT
39.     END IF
40. END SUB
41.  
42. 'Steve McNeil's  copied from his forum   note: Radius is too common a name
43. SUB fcirc (CX AS LONG, CY AS LONG, R AS LONG)
44.     DIM subRadius AS LONG, RadiusError AS LONG
45.     DIM X AS LONG, Y AS LONG
46.  
47.     subRadius = ABS(R)
48.     RadiusError = -subRadius
49.     X = subRadius
50.     Y = 0
51.  
52.     IF subRadius = 0 THEN PSET (CX, CY): EXIT SUB
53.  
54.     ' Draw the middle span here so we don't draw it twice in the main loop,
55.     ' which would be a problem with blending turned on.
56.     LINE (CX - X, CY)-(CX + X, CY), , BF
57.  
58.     WHILE X > Y
59.         RadiusError = RadiusError + Y * 2 + 1
60.         IF RadiusError >= 0 THEN
61.             IF X <> Y + 1 THEN
62.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), , BF
63.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), , BF
64.             END IF
65.             X = X - 1
66.             RadiusError = RadiusError - X * 2
67.         END IF
68.         Y = Y + 1
69.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), , BF
70.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), , BF
71.     WEND
72. END SUB
73.  
74.