12-09-2024, 02:09 PM
Thanks @macalwan I was impelled to update my own code for Star:
And it's Demo:
Code: (Select All)
' this sub requires fTri for Filling stars rev 2024-12-09 for FillTF option
Sub star (x, y, rInner, rOuter, nPoints, DegAngleOffset, K As _Unsigned Long, FillTF)
' x, y are same as for circle,
' rInner is center circle radius
' rOuter is the outer most point of star
' nPoints is the number of points,
' angleOffset = angle offset IN DEGREES, it will be converted to radians in sub
' this is to allow us to spin the polygon of n sides
Dim pAngle, radAngleOffset, x1, y1, x2, y2, x3, y3, i As Long
pAngle = _D2R(360 / nPoints): radAngleOffset = _D2R(DegAngleOffset)
x1 = x + rInner * Cos(radAngleOffset)
y1 = y + rInner * Sin(radAngleOffset)
For i = 0 To nPoints - 1
x2 = x + rOuter * Cos(i * pAngle + radAngleOffset + .5 * pAngle)
y2 = y + rOuter * Sin(i * pAngle + radAngleOffset + .5 * pAngle)
x3 = x + rInner * Cos((i + 1) * pAngle + radAngleOffset)
y3 = y + rInner * Sin((i + 1) * pAngle + radAngleOffset)
If FillTF Then
fTri x1, y1, x2, y2, x3, y3, K
Line (x3, y3)-(x1, y1), K ' need this ?? Yes!!! wo Paint leaks
Line (x1, y1)-(x2, y2), K
Line (x2, y2)-(x3, y3), K
Else
Line (x1, y1)-(x2, y2), K
Line (x2, y2)-(x3, y3), K
End If
x1 = x3: y1 = y3
Next
If FillTF Then Paint (x, y), K, K
End Sub
Sub fTri (x1, y1, x2, y2, x3, y3, K As _Unsigned Long)
Dim D As Long
Static a&
D = _Dest
If a& = 0 Then a& = _NewImage(1, 1, 32)
_Dest a&
_DontBlend a& ' '<<<< new 2019-12-16 fix
PSet (0, 0), K
_Blend a& '<<<< new 2019-12-16 fix
_Dest D
_MapTriangle _Seamless(0, 0)-(0, 0)-(0, 0), a& To(x1, y1)-(x2, y2)-(x3, y3)
End Sub
And it's Demo:
Code: (Select All)
Option _Explicit
_Title "Better Stars 4" 'b+ 2024-12-09
' Even Better Stars 2 Arrow Steering" 'b+ 2021-11-23 try with arrow steering
' Better Stars.sdlbas (B+=MGA) 2016-05-16
' odd or even number of point, fat or skinny, better fills
' upgrade Star for FillTF and Color both why I didn't have this before ???
Const Xmax = 700
Const Ymax = 700
Const Cx = Xmax / 2
Const Cy = Ymax / 2
Screen _NewImage(Xmax, Ymax, 32)
_ScreenMove 300, 40
'main
Const NS = 100 ' number of stars (minus one because 0 based arrays)
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
Dim As Long Loopcounter, i
Loopcounter = 0
For i = 0 To NS
NewStar i
Next
While _KeyDown(27) = 0
If _KeyDown(19200) Then ' turn left
For i = 0 To NS
x(i) = x(i) + 2 * ri(i) ^ 2
dx(i) = dx(i) + 1
Next
End If
If _KeyDown(19712) Then ' turn right
For i = 0 To NS
x(i) = x(i) - 2 * ri(i) ^ 2
dx(i) = dx(i) - 1
Next
End If
If _KeyDown(18432) Then ' turn up
For i = 0 To NS
y(i) = y(i) + 2 * ri(i) ^ 2
dy(i) = dy(i) + 1
Next
End If
If _KeyDown(20480) Then ' turn down
For i = 0 To NS
y(i) = y(i) - 2 * ri(i) ^ 2
dy(i) = dy(i) - 1
Next
End If
Line (0, 0)-(Xmax, Ymax), _RGB32(0, 0, 0, 10), BF
For i = 0 To NS
If x(i) > 0 And x(i) < Xmax And y(i) > 0 And y(i) < Ymax Then
star x(i), y(i), ri(i), ro(i), p(i), a(i), c(i), fill(i)
x(i) = x(i) + dx(i)
y(i) = y(i) + dy(i)
ri(i) = 1.015 * ri(i)
ro(i) = 1.015 * ro(i)
a(i) = a(i) + turn(i)
Else
NewStar i
End If
Next
_Display
_Limit 120
Loopcounter = Loopcounter + 1
Wend
Sub NewStar (nxt)
Dim angle, r
angle = Rnd * 2 * _Pi
r = Rnd * 6 + 1
dx(nxt) = r * Cos(angle)
dy(nxt) = r * Sin(angle)
r = Rnd * 300
x(nxt) = Cx + r * dx(nxt)
y(nxt) = Cy + r * dy(nxt)
ri(nxt) = Rnd
ro(nxt) = ri(nxt) + 1 + Rnd
p(nxt) = 3 + Int(Rnd * 9)
a(nxt) = Rnd * 2 * _Pi
turn(nxt) = Rnd * 6 - 3
fill(nxt) = Int(Rnd * 2)
c(nxt) = _RGB32(Rnd * 255, Rnd * 255, Rnd * 255)
End Sub
' this sub requires fTri for Filling stars rev 2024-12-09 for FillTF option
Sub star (x, y, rInner, rOuter, nPoints, DegAngleOffset, K As _Unsigned Long, FillTF)
' x, y are same as for circle,
' rInner is center circle radius
' rOuter is the outer most point of star
' nPoints is the number of points,
' angleOffset = angle offset IN DEGREES, it will be converted to radians in sub
' this is to allow us to spin the polygon of n sides
Dim pAngle, radAngleOffset, x1, y1, x2, y2, x3, y3, i As Long
pAngle = _D2R(360 / nPoints): radAngleOffset = _D2R(DegAngleOffset)
x1 = x + rInner * Cos(radAngleOffset)
y1 = y + rInner * Sin(radAngleOffset)
For i = 0 To nPoints - 1
x2 = x + rOuter * Cos(i * pAngle + radAngleOffset + .5 * pAngle)
y2 = y + rOuter * Sin(i * pAngle + radAngleOffset + .5 * pAngle)
x3 = x + rInner * Cos((i + 1) * pAngle + radAngleOffset)
y3 = y + rInner * Sin((i + 1) * pAngle + radAngleOffset)
If FillTF Then
fTri x1, y1, x2, y2, x3, y3, K
Line (x3, y3)-(x1, y1), K ' need this ?? Yes!!! wo Paint leaks
Line (x1, y1)-(x2, y2), K
Line (x2, y2)-(x3, y3), K
Else
Line (x1, y1)-(x2, y2), K
Line (x2, y2)-(x3, y3), K
End If
x1 = x3: y1 = y3
Next
If FillTF Then Paint (x, y), K, K
End Sub
Sub fTri (x1, y1, x2, y2, x3, y3, K As _Unsigned Long)
Dim D As Long
Static a&
D = _Dest
If a& = 0 Then a& = _NewImage(1, 1, 32)
_Dest a&
_DontBlend a& ' '<<<< new 2019-12-16 fix
PSet (0, 0), K
_Blend a& '<<<< new 2019-12-16 fix
_Dest D
_MapTriangle _Seamless(0, 0)-(0, 0)-(0, 0), a& To(x1, y1)-(x2, y2)-(x3, y3)
End Sub
b = b + ...