Proggies

[bplus]

Star Vortex

Warning: spinning flashing colors

Code: (Select All)

_Title "Star Vortex: key 3 to 9 for star points, spacebar for color change"
' Star Vortex.bas  SmallBASIC 0.12.9 [B+=MGA] 2017-04-19
' Inspired by Andy Amaya's recent Neon Vortex at SdlBasic

' ++++++++++++     Instructions !   +++++++++++++
' Press Spacebar to change Plasma Coloring Setting
' Press Number keys 3 to 9 for that many pointed stars
'+++++++++++++++++++++++++++++++++++++++++++++++++++++

Randomize Timer
Const xmax = 500
Const ymax = 500
Const cx = xmax / 2
Const cy = ymax / 2
Dim Shared pR, pG, pB, pN

Screen _NewImage(xmax, ymax, 32)
_ScreenMove 300, 20

nP = 5: ao = 0
resetPlasma
While _KeyDown(27) = 0
    k$ = InKey$
    If Len(k$) = 1 Then
        If k$ = " " Then resetPlasma
        If Val(k$) > 2 And Val(k$) <= 9 Then nP = Val(k$)
    End If
    aoo = 0
    For i = 170 To 10 Step -1
        star cx, cy, i, 3 * i, nP, i + ao, setPlasma~&
    Next
    _Display
    ao = ao - 5
Wend

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)
        FillTriangle 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 FillTriangle (x1, y1, x2, y2, x3, y3, K As _Unsigned Long)
    $Checking:Off
    Static a&, m As _MEM
    If a& = 0 Then a& = _NewImage(1, 1, 32): m = _MemImage(a&)
    _MemPut m, m.OFFSET, K
    _MapTriangle _Seamless(0, 0)-(0, 0)-(0, 0), a& To(x1, y1)-(x2, y2)-(x3, y3)
    $Checking:On
End Sub

Sub resetPlasma
    'all globals
    pR = Rnd ^ 2: pG = Rnd ^ 2: pB = Rnd ^ 2: pN = 0
End Sub

Function setPlasma~& () 'all globals
    pN = pN + 1
    setPlasma~& = _RGB32(127 + 99 * Sin(pR * pN), 127 + 99 * Sin(pG * pN), 127 + 99 * Sin(pB * pN))
End Function