Text Only | Text with Attachments

QB64.org Forum

Active Forums => Programs => Topic started by: bplus on November 18, 2021, 04:33:17 pm

Title: Even Better Stars
Post by: bplus on November 18, 2021, 04:33:17 pm
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
  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
  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~&
  67.  
  68. Function rndColor~& ()
  69.     rndColor~& = _RGB32(Rnd * 255, Rnd * 255, Rnd * 255)
  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
  97.  
  98.  
Title: Re: Even Better Stars
Post by: Dav on November 18, 2021, 05:17:16 pm
Really nice, @bplus!

- Dav
Title: Re: Even Better Stars
Post by: Richard Frost on November 18, 2021, 07:05:37 pm
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.




Title: Re: Even Better Stars
Post by: johnno56 on November 18, 2021, 09:35:00 pm
Totally stellar.... (Boom. Boom)

J
Title: Re: Even Better Stars
Post by: bplus on November 23, 2021, 08:13:54 pm
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
  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
  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~&
  94.  
  95. Function rndColor~& ()
  96.     rndColor~& = _RGB32(Rnd * 255, Rnd * 255, Rnd * 255)
  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
  124.  
  125.  
Text Only | Text with Attachments