RetroBASIC
Basicprogramming(.org) => Code and examples => Topic started by: B+ on July 04, 2017, 04:33:15 AM
-
' more particles.bas SmallBASIC 0.12.8 [B+=MGA] 2016-11-18
' from: more particles.sdlbas [B+=MGA] 2016-11-18
' attempt to simulate alpha effect
func rand(n1, n2)
if n1 > n2 then hi = n1 : lo = n2 else hi = n2 : lo = n1
rand = (rnd * (hi - lo + 1)) \ 1 + lo
end
def rdir = iff(rnd < .5, -1, 1)
numPoints = 100
dim vx(numPoints), vy(numPoints), clr(numPoints), life(numPoints), lifeTime(numPoints)
wantColor = 1 'colorize on/off, 1 or 0
for i = 0 to numPoints
initPoint(i)
next
while 1
cls
for p = 0 to numPoints
life(p) += 1
if life(p) = lifeTime(p) then
initPoint(p)
else
'redraw the whole arc of particle path
x0 = xmax/2 : y0 = .35 * ymax : drop = vy(p)
for i = 0 to life(p)
if wantColor then
select case clr(p)
case 0
r = 1: g = 0 : b = 0
case 1
r =1 : g = 1 : b = 1
case 2
r =0 : g = 0 : b = 1
case 3
r = 0 : g = .7 : b = 0
case 4
r= 1: g = 1 : b = 0
case 5
r = 1 : g = 0 : b = 1
case 6
r = 1 : g = .6 : b = 0
end select
if r = 0 then
r = 3 * (life(p) - i)
else
r = i/life(p) * 255 * r
end if
if g = 0 then
g = 3 * (life(p) - i)
else
g = i/life(p) * 255 * g
end if
if b = 0 then
b = 3 * (life(p) -1)
else
b = i/life(p) * 255 * b
end if
color rgb(r, g, b)
else
m = i/life(p) * 255
color rgb(m, m, m)
end if
xnext = x0 + vx(p)
drop += .1
ynext = y0 + drop
radius = i/life(p) * 8
circle xnext, ynext, radius filled
x0 = xnext
y0 = ynext
next
end if
next
showpage
wend
sub initPoint(p)
vx(p) = rnd * 7 * rdir
vy(p) = rnd * 7 * rdir
clr(p) = rand(0, 6)
life(p) = 0
lifeTime(p) = rand(30, 70)
end
-
'fireworks 3.bas SmallBASIC 0.12.2 [B+=MGA] 2015-05-09
'fireworks 2.bas 2016-05-05 now with Gravity, Newtonian bounce, smoke debris
'fireworks 3.bas try with map variables make bursts around a central point
flare_max = 300 : debris_max = 5000 : debris_stack = 0
dim flare(flare_max)
dim debris(debris_max)
sub NewDebris(i)
local c
debris(i).x = rnd * xmax
debris(i).y = rnd * ymax
c = rnd * 255
debris(i).c = rgb(c, c, c)
end
while 1
rnd_cycle = rnd * 30
loop_count = 0
burst.x = .75 * xmax * rnd + .125 * xmax
burst.y = .5 * ymax * rnd +.125 * ymax
repeat
cls
'color 14 : locate 0,0: ? debris_stack; " Debris" 'debug line
for i=1 to 20 'new burst using random old flames to sim burnout
nxt = rnd * flare_max + 1
angle = rnd * 2 * pi
flare(nxt).x = burst.x + rnd * 5 * cos(angle)
flare(nxt).y = burst.y + rnd * 5 * sin(angle)
angle = rnd * 2 * pi
flare(nxt).dx = rnd * 15 * cos(angle)
flare(nxt).dy = rnd * 15 * sin(angle)
rc = int(rnd * 3)
if rc = 0 then
'flare(nxt).c = 12 'patriotic theme
flare(nxt).c = rgb(255, rnd * 255, 0)
elseif rc = 1
'flare(nxt).c = 9 'patriotic theme
flare(nxt).c = rgb(100 + rnd * 155, 100 + rnd * 155, 220)
else
flare(nxt).c = 15
endif
next
for i = 0 to flare_max
if flare(i).dy then 'while still moving vertically
line flare(i).x, flare(i).y step flare(i).dx, flare(i).dy, rgb(98, 98, 98)
circle step flare(i).dx, flare(i).dy, 1, 1, flare(i).c filled
flare(i).x += flare(i).dx
flare(i).y += flare(i).dy
flare(i).dy += .4 'add gravity
flare(i).dx *= .99 'add some air resistance
if flare(i).x < 0 or flare(i).x > xmax then flare(i).dy = 0 'outside of screen
'add some spark bouncing here
if flare(i).y > ymax then
if abs(flare(i).dy) > .5 then
flare(i).y = ymax : flare(i).dy *= -.25
else
flare(i).dy = 0
fi
fi
fi
next
for i = 0 to debris_stack
pset debris(i).x, debris(i).y, debris(i).c
debris(i).x += rnd * 3 - 1.5
debris(i).y += rnd * 3.5 - 1.5
if debris(i).x < 0 or debris(i).y < 0 or debris(i).x > xmax or debris(i).y > ymax then NewDebris(i)
next
showpage
delay 2
loop_count += 1
until loop_count > rnd_cycle
if debris_stack < debris_max then
for i = 1 to 20
NewDebris i + debris_stack
next
debris_stack += 20
fi
wend