Dia de la Muertos

[bplus]

Yeah this one is making the rounds at other forums!

So bplus throws his hat into the ring, I modified off a GW Basic port from ZXDunny himself.

Tons and tons of variations, use q to quit

Code: (Select All)

_Title "Skull - ZXDunny to Ron to b+" ' bplus 2023-11-01
Randomize Timer
Dim Shared CN, PR, PG, PB
xmax = 480: ymax = 480
cx = xmax / 2
Dim c As _Unsigned Long
Screen _NewImage(xmax, ymax, 32) ' 320x 200 no graphics ??

K = 360
Dim Sine(K): Dim Cosi(K)

For I = 0 To K
    T = I * 2 * _Pi / K
    Sine(I) = Sin(T)
    Cosi(I) = Cos(T)
Next I

Do
    Cls
    resetPlasma
    U = 120 ' orig
    V = -60: D = 2: N = 7: a = 70
    c = _RGB32(255, 0, 0) ' eye coloring
    For J = 1 To 40

        For T = 0 To K * 2 Step .25
            z = a * Cosi(((T * N) \ D) Mod K)
            x = U + z * Cosi(T Mod K)
            Y = V + z * Sine(T Mod K)
            E = x * x
            R = Sqr(E + Y * Y)
            F = Y + K
            G = Sqr(E + F * F)
            L = Y + 60
            I = x - 120
            H = Sqr(I * I + L * L)
            B1 = (G <= 220 Or R <= K)
            B2 = (R <= 380 Or R >= 480 Or Abs(x) >= 160 Or Abs(x Mod 32) <= 4 Or R Mod 48 <= 4)
            B3 = (J <= 1 Or H >= 90)
            B4 = (Y < -300 Or Y >= -160 Or -x * 2 - Y <= 180)
            If B1 And B2 And B3 And B4 Then
                ' apply scaling and translation
                x = x / 2
                Y = ymax - ((Y / 2.2) + 130 * 2.2)
                PSet (x + cx, Y), c
                PSet (cx - x, Y), c
            End If
        Next T
        D = Rand(3): N = Rand(5) + 2: a = Rand(80) + 50: U = Rand(K): V = Rand(940) - 520
        c = _RGB32(0, 0, J * 5 + 55)
        c = Plasma~&
    Next J
    Sleep
Loop Until InKey$ = "q"

Function Rand (n)
    Rand = Int(Rnd * n) + 1
End Function

Function Plasma~& ()
    CN = CN + .2 'dim shared cN as _Integer64, pR as long, pG as long, pB as long
    Plasma~& = _RGB32(127 + 127 * Sin(PR * CN), 127 + 127 * Sin(PG * CN), 127 + 127 * Sin(PB * CN))
End Function

Sub resetPlasma ()
    PR = Rnd ^ 2: PG = Rnd ^ 2: PB = Rnd ^ 2
End Sub