Dia de la Muertos

[James D Jarvis]

Code: (Select All)

'Dia de los Muertos

'adapted from a  conversion by Paul Dunn  of an original by Bazzargh

'$dynamic

Dim S(0), C(0)

Dim klr As _Unsigned Long

Screen _NewImage(800, 600, 32)

Window (-852, -600)-(852, 416)

Do

    klr = _RGB32(255, 0, 0)

    Cls

    k = 360

    ReDim S(k + 1), C(k + 1)

    kv = 220 + r(35)

    For i = 0 To k

        t = i * 2 * _Pi / k

        S(i) = Sin(t)

        C(i) = Cos(t)

        circleBF 0, -i / 2, k * .8, _RGB32(kv, kv, kv)

    Next i

    circleBF 0, 0, k, _RGB32(kv, kv, kv)

    circleBF 120, -60, 80, _RGB32(1, 1, 1)

    circleBF -120, -60, 80, _RGB32(1, 1, 1)





    u = 120: v = -60: d = 2: n = 7: a = 70

    For j = 1 To r(30) + 10 '40



        For t = 0 To k * 2

            z = a * C(((t * n) / d) Mod k)

            x = u + z * C(t Mod k)

            y = v + z * S(t Mod k)

            e = x * x

            rr = Sqr(e + y * y)

            f = y + k

            g = Sqr(e + f * f)

            l = y + 60

            i = x - 120

            h = Sqr(e + f * f)

            If (g < 220 Or rr < k) And (rr <= 380 Or rr <= k) And (rr <= 360 Or rr > 480 Or Abs(x) >= 160 Or Abs(x Mod 32) <= 4 Or rr Mod 48 <= 4) And (j <= 1 Or h >= 90) And (y < -300 Or y >= -150 Or -x * 2 - y >= 180) Then

                circleBF x, y, 2, klr

                circleBF -x, y, 2, klr

            End If

        Next t

        d = r(3): n = r(5) + 2: a = r(80) + 50: u = r(k): v = r(940) - 520

        kv = r(121)

        klr = _RGB32(kv, kv, kv)

    Next j

    Do

        _Limit 60

        kk$ = InKey$

    Loop Until kk$ <> ""

Loop Until kk$ = Chr$(27)









Function r (i)

    r = Int(1 + Rnd * i)

End Function

Sub circleBF (cx As Long, cy As Long, rad As Long, klr As _Unsigned Long)

    rsqrd = rad * rad

    y = -rad

    While y <= rad

        x = Sqr(rsqrd - y * y)

        Line (cx - x, cy + y)-(cx + x, cy + y), klr, BF

        y = y + 1

    Wend

End Sub

[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

       

[James D Jarvis]

Oooh better jaws.

[bplus]

Oooh better jaws.

Yeah amazing when the teeth show up, the snaps are cherry picked ones with teeth.

The design detail that sometimes appear in these is stunning. I figured out how to scale and translate so I can make bigger Skulls on bigger screens (never heard of Screen 1 before 320 x 200 supposedly non graphics? maybe QB45?) but find the code part for teeth THAT would be the ideal!