Proggies - Printable Version

Code: (Select All)
_Title "Plasma Deluxe" 'b+ 2025-11-02

Screen _NewImage(1200, 600, 32)

_ScreenMove 50, 60

_PrintMode _KeepBackground

_Font _LoadFont("Arial.ttf", 128)

Dim Shared cN, pR, pG, pB

While _KeyDown(27) = 0

    Cls

    x = 0

    resetPlasma

    For y = 0 To 480 Step 2

        x = x + 1.4

        Color Plasma~&

        _PrintString (x, y), "Plasma Deluxe"

        _Display

        _Limit 100

    Next

    _Delay 1.5

Wend

Function Plasma~& ()

    cN = cN + 1 ''Dim Shared cN, pR, pG, pB

    Plasma~& = _RGB32(127 + 127 * Sin(pR * cN), 127 + 127 * Sin(pG * cN), 127 + 127 * Sin(pB * cN))

End Function

Sub resetPlasma ()

    ''Dim Shared cN, pR, pG, pB

    pR = Rnd ^ 2: pG = Rnd ^ 2: pB = Rnd ^ 2: cN = 0

End Sub

Code: (Select All)
_Title "Shell of another color 3" 'b+2020-01-25

'inspired by "shell-like thing" by tsh73 Jan 2020 at JB

' 2020-01-27 Shell of another color 3 adds more improvements

Screen _NewImage(660, 660, 32)

_ScreenMove 300, 40

Dim x(1600), y(1600), c As _Unsigned Long

cx = 340: cy = 390

For a = 0 To _Pi(8) Step _Pi(2 / 400) ' load x, y arrays

    x(i) = cx + ra * Cos(a): y(i) = cy + ra * Sin(a)

    dr = dr + 1 / 1700: ra = ra + dr ^ 2: i = i + 1

Next

While 1

    R = Rnd ^ 2: G = Rnd ^ 2: B = Rnd ^ 2: PN = 0: size = 1

    For i = 0 To 1139

        dx = x(i + 400) - x(i): dy = y(i + 400) - y(i)

        dist = Sqr(dx * dx + dy * dy): dx = dx / dist: dy = dy / dist: PN = PN + .73

        If i > 820 Then

            size = 3

        ElseIf i > 380 Then

            size = 2

        End If

        For j = 0 To dist

            shade = 1 - ((dist / 2 - j + 1 / 2) / (dist / 2)) ^ 2

            c = _RGB32(shade * Int(127 + 127 * Sin(R * PN)), shade * Int(127 + 127 * Sin(G * PN)), shade * Int(127 + 127 * Sin(B * PN)))

            fcirc x(i) + j * dx, y(i) + j * dy, size, c

        Next

    Next

    _Display

    _Delay 2

Wend

'from Steve Gold standard

Sub fcirc (CX As Integer, CY As Integer, R As Integer, C As _Unsigned Long)

    Dim Radius As Integer, RadiusError As Integer

    Dim X As Integer, Y As Integer

    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