Plasma Snake

[bplus]

Code: (Select All)

_Title "Plasma Snake - any key to change color" 'b+ 2023-06-27

' inspired once again by Paul Dunn aka ZXDunny here:

' https://retrocoders.phatcode.net/index.php?topic=634.0

' and my mod? hopefully I can do same or similar PLUS allow you to change plasma schemes!

' Plus put a face on it!



' lets see!

Screen _NewImage(800, 600, 32) ' 32 = all colors of _RGBA32() = millions!

_ScreenMove 250, 60 ' you may want different

Randomize Timer ' + so we start different each time, who wants to see same old snake?

Dim Shared PR, PG, PB, CN ' for setup and changing Plasma Color Schemes

PR = Rnd ^ 2: PG = Rnd ^ 2: PB = Rnd ^ 2 ' setup one to start

da = 1: r = 60

Do

    CN = 0 ' reset plasma index to 0 for consistent color bands

    For x = r To 800 - r ' make a snake body

        CN = CN + .5

        Color _RGB32(127 + 127 * Sin(PR * CN), 127 + 127 * Sin(PG * CN), 127 + 127 * Sin(PB * CN))

        FCirc x, 300 + (300 - r) * Sin(_D2R(x + a)), r, _DefaultColor

    Next



    ' Put a face on it!

    x = x - 1

    y = 300 + (300 - r) * Sin(_D2R(x + a))

    ' eyes

    FCirc x - .625 * r, y - .1 * r, .125 * r, &HFF000000

    FCirc x + .625 * r, y - .1 * r, .125 * r, &HFF000000

    Circle (x - .62 * r, y - .1 * r), .1 * r, &HFFFFFFFF

    Circle (x + .62 * r, y - .1 * r), .1 * r, &HFFFFFFFF

    ' nose

    FCirc x - .1 * r, y + .35 * r, .025 * r, &HFF000000

    FCirc x + .1 * r, y + .35 * r, .025 * r, &HFF000000

    ' mouth

    Line (x - 4, y + .65 * r)-(x + 4, y + .655 * r), &HFFFF0000, BF

    ' and a little tongue of course

    If m Mod 20 = 0 Then ' flash every 10 loops

        Line (x - 2, y + .655 * r)-(x + 2, y + .9 * r), &HFFFF0000, BF

        Line (x - 2, y + .9 * r)-(x - .08 * r, y + r), &HFFFF0000

        Line (x + 2, y + .9 * r)-(x + .08 * r, y + r), &HFFFF0000

    End If

    _Display

    If m Mod 20 = 0 Then ' erase the tongue flash every 10 loops

        Line (x - 2, y + .655 * r)-(x + 2, y + .9 * r), _DefaultColor, BF

        Line (x - 2, y + .9 * r)-(x - .08 * r, y + r), _DefaultColor

        Line (x + 2, y + .9 * r)-(x + .08 * r, y + r), _DefaultColor

    End If

    m = m + 1

    a = a + da



    If Len(InKey$) Then PR = Rnd ^ 2: PG = Rnd ^ 2: PB = Rnd ^ 2

Loop Until _KeyDown(27)



Sub FCirc (CX As Long, CY As Long, R As Long, C As _Unsigned Long)

    Dim Radius As Long, RadiusError As Long

    Dim X As Long, Y As Long

    Radius = Abs(R): RadiusError = -Radius: X = Radius: Y = 0

    If Radius = 0 Then PSet (CX, CY), C: Exit Sub

    Line (CX - X, CY)-(CX + X, CY), C, BF

    While X > Y

        RadiusError = RadiusError + Y * 2 + 1

        If RadiusError >= 0 Then

            If X <> Y + 1 Then

                Line (CX - Y, CY - X)-(CX + Y, CY - X), C, BF

                Line (CX - Y, CY + X)-(CX + Y, CY + X), C, BF

            End If

            X = X - 1

            RadiusError = RadiusError - X * 2

        End If

        Y = Y + 1

        Line (CX - X, CY - Y)-(CX + X, CY - Y), C, BF

        Line (CX - X, CY + Y)-(CX + X, CY + Y), C, BF

    Wend

End Sub

Much more fun to watch animation!