+- QB64 Phoenix Edition (https://staging.qb64phoenix.com)
+-- Forum: QB64 Rising (https://staging.qb64phoenix.com/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://staging.qb64phoenix.com/forumdisplay.php?fid=3)
+---- Forum: Programs (https://staging.qb64phoenix.com/forumdisplay.php?fid=7)
+---- Thread: Recurring Star Power (/showthread.php?tid=965)
Pages:
1
2
Recurring Star Power - bplus - 10-12-2022
Code: (Select All)
_Title "Recurring Star Power" ' b+ 2022-10-12
_Title "Recurring Star Power" ' b+ 2022-10-12
Const xmax = 700
Const ymax = 700
Randomize Timer
Screen _NewImage(xmax, ymax, 32)
_ScreenMove 360, 5
Dim Shared cx, cy, cr, ra, inc
cx = xmax / 2: cy = ymax / 2: cr = ymax / 5.5: inc = _Pi(1 / 360)
Color _RGBA(100, 255, 100, 40), _RGB32(0, 0, 0)
For n = 5 To 5
a = 0
ra = _Pi(2) / n
While 1
Cls
levels = 5 '12 - n
RecurringCircles cx, cy, cr, n, a, levels
a = a + inc
_Display
Wend
Sleep
Cls
RecurringCircles cx, cy, cr, n, 0, levels
_Display
_Limit 5
Next
Sub RecurringCircles (x, y, r, n, rao, level)
star x, y, .4 * r, r, 5, _R2D(_Pi / 10), &HFFFFFF00 ' <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
If level > 0 Then
For i = 0 To n - 1
x1 = x + 1.5 * r * Cos(i * ra + rao + _Pi(-.5))
y1 = y + 1.5 * r * Sin(i * ra + rao + _Pi(-.5))
RecurringCircles x1, y1, r * .45, n, 2 * rao, level - 1
Next
End If
End Sub
Sub star (x, y, rInner, rOuter, nPoints, angleOffset, K As _Unsigned Long)
' 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(angleOffset)
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)
ftri x1, y1, x2, y2, x3, y3, K
'triangles leaked
Line (x1, y1)-(x2, y2), K
Line (x2, y2)-(x3, y3), K
Line (x3, y3)-(x1, y1), K
x1 = x3: y1 = y3
Next
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 SubComplete with the occasional twinkle!
EDIT: remove extra sub
RE: Recurring Star Power - Pete - 10-12-2022
If I want to see stars, I just take a quick 30-minute trip to Hollywood. If I want to see more stars, I just whistle at one of the sexy actresses, on Hollywood Blvd, while my wife is in the car.
Pete
RE: Recurring Star Power - bplus - 10-12-2022
(10-12-2022, 04:19 PM)Pete Wrote: If I want to see stars, I just take a quick 30-minute trip to Hollywood. If I want to see more stars, I just whistle at one of the sexy actresses, on Hollywood Blvd, while my wife is in the car.
Pete
I had to think a sec about the wife part!
RE: Recurring Star Power - Pete - 10-12-2022
Yeah. I wish I did, before I whistled.
Pete
RE: Recurring Star Power - Pete - 10-12-2022
Well stars in rotating snowflakes? That's what it looks like to me. Honestly, if someone would have told me 15 years ago that this would be 100 lines of code, I think I would have been very skeptical, _maptriangle and a few other qb64 keywords later and there we have it. Nice job!
Pete
RE: Recurring Star Power - bplus - 10-12-2022
Here is a little mod expansion on the Star Flake theme:
Code: (Select All)
_Title "Recurring Star Power 2" ' b+ 2022-10-12
Const xmax = 700
Const ymax = 700
Randomize Timer
Screen _NewImage(xmax, ymax, 32)
_ScreenMove 360, 5
Dim Shared cx, cy, cr, ra, inc
cx = xmax / 2: cy = ymax / 2: cr = ymax / 5.5: inc = _Pi(1 / 360)
Color _RGBA(100, 255, 100, 40), _RGB32(0, 0, 0)
For n = 3 To 7
a = 0
ra = _Pi(2) / n
While a < _Pi(2) / n
Cls
levels = 10 - n
RecurringCircles cx, cy, cr, n, a, levels
a = a + inc
_Display
Wend
Cls
RecurringCircles cx, cy, cr, n, 0, levels
_Display
_Delay 2
Next
Sub RecurringCircles (x, y, r, n, rao, level)
star x, y, .4 * r, r, 5, _R2D(_Pi / 10), &HFFFFFF00 ' <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
If level > 0 Then
For i = 0 To n - 1
x1 = x + 1.5 * r * Cos(i * ra + rao + _Pi(-.5))
y1 = y + 1.5 * r * Sin(i * ra + rao + _Pi(-.5))
RecurringCircles x1, y1, r * .45, n, 2 * rao, level - 1
Next
End If
End Sub
Sub star (x, y, rInner, rOuter, nPoints, angleOffset, K As _Unsigned Long)
' 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(angleOffset)
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)
ftri x1, y1, x2, y2, x3, y3, K
'triangles leaked
Line (x1, y1)-(x2, y2), K
Line (x2, y2)-(x3, y3), K
Line (x3, y3)-(x1, y1), K
x1 = x3: y1 = y3
Next
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 SubRE: Recurring Star Power - Pete - 10-12-2022
I just got a call from snowflake General Mark Milley. He wants 4 for each shoulder, and a cry closet to store them in.
Pete
RE: Recurring Star Power - Kernelpanic - 10-12-2022
That's great! I should really take a look at the graphics options under Basic. But I have to start from absolutely zero.
How much is two and two? Hm, . . . Yeah, . . . three?
RE: Recurring Star Power - Pete - 10-12-2022
Everyone in North Korea knows two plus two equals bigger two.
I've done a few graphics programs. It's not too difficult to learn, but it doesn't feel as intuitive to do printing in graphics.
Pete
RE: Recurring Star Power - SierraKen - 10-15-2022
Awesome stuff! You could make the background white and the stars red and turn it into cards.
