Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Dia de la Muertos
#1
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
Reply
#2
Thumbs Up 
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

       
b = b + ...
Reply
#3
Oooh better jaws.
Reply
#4
(11-02-2023, 02:44 PM)James D Jarvis Wrote: 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!
b = b + ...
Reply




Users browsing this thread: 1 Guest(s)