Dia de la Muertos - James D Jarvis - 10-31-2023
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
RE: Dia de la Muertos - bplus - 11-01-2023
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
RE: Dia de la Muertos - James D Jarvis - 11-02-2023
Oooh better jaws.
RE: Dia de la Muertos - bplus - 11-02-2023
(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!
|