Even Better Stars

[bplus]

Souping up some old SdlBasic code:

Code: QB64: [Select]

1. _Title "Even Better Stars" 'b+ 2021-11-18 trans of
2. 'Better Stars.sdlbas (B+=MGA) 2016-05-16
3. ' odd or even number of point, fat or skinny, better fills
4.  
5. Const Pi = _Acos(-1) 'cute way to get pi
6. 'Print (Pi) 'check pi
7. 'End
8. Const Radians = Pi / 180 'to convert an angle measured in degrees to and angle measure in radians, just mutiply by this
9. Const Xmax = 700
10. Const Ymax = 700
11. Const Cx = Xmax / 2
12. Const Cy = Ymax / 2
13.  
14. 'setdisplay(xmax, ymax, 32, 1)
15. Screen _NewImage(Xmax, Ymax, 32)
16. _ScreenMove 300, 40
17. 'setcaption("Better Stars demo")
18. 'autoback(-2)
19.  
20. 'main
21. Const NS = 100
22. Dim Shared x(NS), y(NS), dx(NS), dy(NS), ri(NS), ro(NS), p(NS), a(NS), turn(NS), fill(NS), c(NS) As _Unsigned Long
23. loopcounter = 0
24. For i = 0 To NS
25.     NewStar i
26. Next
27. While _KeyDown(27) = 0
28.     Line (0, 0)-(Xmax, Ymax), _RGB32(0, 0, 0, 30), BF
29.     For i = 0 To NS
30.         If x(i) > 0 And x(i) < Xmax And y(i) > 0 And y(i) < Ymax Then
31.             'ink(colr(c(i)))
32.             Color c(i)
33.             Star x(i), y(i), ri(i), ro(i), p(i), a(i), fill(i)
34.             x(i) = x(i) + dx(i)
35.             y(i) = y(i) + dy(i)
36.             ri(i) = 1.015 * ri(i)
37.             ro(i) = 1.015 * ro(i)
38.             a(i) = a(i) + turn(i)
39.         Else
40.             NewStar i
41.         End If
42.     Next
43.     'screenswap
44.     _Display
45.     _Limit 100
46.     'wait(50)
47.     loopcounter = loopcounter + 1
48. Wend
49.  
50.  
51. Sub NewStar (nxt)
52.     angle = Rnd * 2 * Pi
53.     r = Rnd * 6 + 1
54.     dx(nxt) = r * Cos(angle)
55.     dy(nxt) = r * Sin(angle)
56.     r = Rnd * 300
57.     x(nxt) = Cx + r * dx(nxt)
58.     y(nxt) = Cy + r * dy(nxt)
59.     ri(nxt) = Rnd
60.     ro(nxt) = ri(nxt) + 1 + Rnd
61.     p(nxt) = 3 + Int(Rnd * 9)
62.     a(nxt) = Rnd * 2 * Pi
63.     turn(nxt) = Rnd * 6 - 3
64.     fill(nxt) = Int(Rnd * 2)
65.     c(nxt) = rndColor~&
66. End Sub
67.  
68. Function rndColor~& ()
69.     rndColor~& = _RGB32(Rnd * 255, Rnd * 255, Rnd * 255)
70. End Function
71.  
72. Sub Star (x, y, rInner, rOuter, nPoints, angleOffset, TFfill)
73.     ' x, y are same as for circle,
74.     ' rInner is center circle radius
75.     ' rOuter is the outer most point of star
76.     ' nPoints is the number of points,
77.     ' angleOffset = angle offset IN DEGREES, it will be converted to radians in sub
78.     ' this is to allow us to spin the polygon of n sides
79.     ' TFfill filled True or False (1 or 0)
80.     p_angle = Radians * (360 / nPoints): rad_angle_offset = Radians * angleOffset
81.     x1 = x + rInner * Cos(rad_angle_offset)
82.     y1 = y + rInner * Sin(rad_angle_offset)
83.     For i = 0 To nPoints - 1
84.         x2 = x + rOuter * Cos(i * p_angle + rad_angle_offset + .5 * p_angle)
85.         y2 = y + rOuter * Sin(i * p_angle + rad_angle_offset + .5 * p_angle)
86.         x3 = x + rInner * Cos((i + 1) * p_angle + rad_angle_offset)
87.         y3 = y + rInner * Sin((i + 1) * p_angle + rad_angle_offset)
88.         Line (x1, y1)-(x2, y2)
89.         Line (x2, y2)-(x3, y3)
90.         x1 = x3: y1 = y3
91.     Next
92.     If TFfill Then
93.         'Circle (x, y), 2, &HFFFFFFFF
94.         Paint (x, y), _DefaultColor, _DefaultColor
95.     End If
96. End Sub
97.  
98.  

[Dav]

Really nice, @bplus!

- Dav

[Richard Frost]

It's what Dave would have seen in 2001 if Kubrick wasn't so much into realism - Dave
after a lollipop overdose.   The animation would fit well into The Big Lebowski too.  Super pretty.

[johnno56]

Totally stellar.... (Boom. Boom)

J

[bplus]

Try with steering: up, down, left, right arrows

Code: QB64: [Select]

1. _Title "Even Better Stars 2 Arrow Steering" 'b+ 2021-11-23 try with arrow steering
2. 'Better Stars.sdlbas (B+=MGA) 2016-05-16
3. ' odd or even number of point, fat or skinny, better fills
4.  
5. Const Pi = _Acos(-1) 'cute way to get pi
6. 'Print (Pi) 'check pi
7. 'End
8. Const Radians = Pi / 180 'to convert an angle measured in degrees to and angle measure in radians, just mutiply by this
9. Const Xmax = 700
10. Const Ymax = 700
11. Const Cx = Xmax / 2
12. Const Cy = Ymax / 2
13.  
14. 'setdisplay(xmax, ymax, 32, 1)
15. Screen _NewImage(Xmax, Ymax, 32)
16. _ScreenMove 300, 40
17. 'setcaption("Better Stars demo")
18. 'autoback(-2)
19.  
20. 'main
21. Const NS = 100
22. Dim Shared x(NS), y(NS), dx(NS), dy(NS), ri(NS), ro(NS), p(NS), a(NS), turn(NS), fill(NS), c(NS) As _Unsigned Long
23. loopcounter = 0
24. For i = 0 To NS
25.     NewStar i
26. Next
27. While _KeyDown(27) = 0
28.     If _KeyDown(19200) Then '               turn left
29.         For i = 0 To NS
30.             x(i) = x(i) + 2 * ri(i) ^ 2
31.             dx(i) = dx(i) + 1
32.         Next
33.     End If
34.  
35.     If _KeyDown(19712) Then '              turn right
36.         For i = 0 To NS
37.             x(i) = x(i) - 2 * ri(i) ^ 2
38.             dx(i) = dx(i) - 1
39.         Next
40.     End If
41.  
42.     If _KeyDown(18432) Then '              turn up
43.         For i = 0 To NS
44.             y(i) = y(i) + 2 * ri(i) ^ 2
45.             dy(i) = dy(i) + 1
46.         Next
47.     End If
48.     If _KeyDown(20480) Then '               turn down
49.         For i = 0 To NS
50.             y(i) = y(i) - 2 * ri(i) ^ 2
51.             dy(i) = dy(i) - 1
52.         Next
53.     End If
54.  
55.     Line (0, 0)-(Xmax, Ymax), _RGB32(0, 0, 0, 50), BF
56.     For i = 0 To NS
57.         If x(i) > 0 And x(i) < Xmax And y(i) > 0 And y(i) < Ymax Then
58.             'ink(colr(c(i)))
59.             Color c(i)
60.             Star x(i), y(i), ri(i), ro(i), p(i), a(i), fill(i)
61.             x(i) = x(i) + dx(i)
62.             y(i) = y(i) + dy(i)
63.             ri(i) = 1.015 * ri(i)
64.             ro(i) = 1.015 * ro(i)
65.             a(i) = a(i) + turn(i)
66.         Else
67.             NewStar i
68.         End If
69.     Next
70.     'screenswap
71.     _Display
72.     _Limit 100
73.     'wait(50)
74.     loopcounter = loopcounter + 1
75. Wend
76.  
77.  
78. Sub NewStar (nxt)
79.     angle = Rnd * 2 * Pi
80.     r = Rnd * 6 + 1
81.     dx(nxt) = r * Cos(angle)
82.     dy(nxt) = r * Sin(angle)
83.     r = Rnd * 300
84.     x(nxt) = Cx + r * dx(nxt)
85.     y(nxt) = Cy + r * dy(nxt)
86.     ri(nxt) = Rnd
87.     ro(nxt) = ri(nxt) + 1 + Rnd
88.     p(nxt) = 3 + Int(Rnd * 9)
89.     a(nxt) = Rnd * 2 * Pi
90.     turn(nxt) = Rnd * 6 - 3
91.     fill(nxt) = 0 'Int(Rnd * 2)
92.     c(nxt) = rndColor~&
93. End Sub
94.  
95. Function rndColor~& ()
96.     rndColor~& = _RGB32(Rnd * 255, Rnd * 255, Rnd * 255)
97. End Function
98.  
99. Sub Star (x, y, rInner, rOuter, nPoints, angleOffset, TFfill)
100.     ' x, y are same as for circle,
101.     ' rInner is center circle radius
102.     ' rOuter is the outer most point of star
103.     ' nPoints is the number of points,
104.     ' angleOffset = angle offset IN DEGREES, it will be converted to radians in sub
105.     ' this is to allow us to spin the polygon of n sides
106.     ' TFfill filled True or False (1 or 0)
107.     p_angle = Radians * (360 / nPoints): rad_angle_offset = Radians * angleOffset
108.     x1 = x + rInner * Cos(rad_angle_offset)
109.     y1 = y + rInner * Sin(rad_angle_offset)
110.     For i = 0 To nPoints - 1
111.         x2 = x + rOuter * Cos(i * p_angle + rad_angle_offset + .5 * p_angle)
112.         y2 = y + rOuter * Sin(i * p_angle + rad_angle_offset + .5 * p_angle)
113.         x3 = x + rInner * Cos((i + 1) * p_angle + rad_angle_offset)
114.         y3 = y + rInner * Sin((i + 1) * p_angle + rad_angle_offset)
115.         Line (x1, y1)-(x2, y2)
116.         Line (x2, y2)-(x3, y3)
117.         x1 = x3: y1 = y3
118.     Next
119.     If TFfill Then
120.         'Circle (x, y), 2, &HFFFFFFFF
121.         Paint (x, y), _DefaultColor, _DefaultColor
122.     End If
123. End Sub
124.  
125.