Great balls of fire.bas


'Great balls of fire.bas SmallBASIC 0.12.9 (B+=MGA) 2017-11-23

xxmax = 180 : yymax = 85 'pixels too slow
xstep = xmax / xxmax : ystep = ymax / yymax
dim p(300) 'pallette thanks harixxx
for i = 1 to 100
fr = 240 * i / 100 + 15
p(i) = rgb(fr, 0, 0)
p(i + 100) = rgb(255, fr, 0)
p(i + 200) = rgb(255, 255, fr)
next
dim f(xxmax, yymax) 'fire array tracks flames
nb = 13 'number of balls
acc = .1 'gravity
br = 4 'ball radius
brs = br * br 'ball radius squared
dim b(1 to nb) 'ball array
for i = 1 to nb 'ball maker
b(i).x = (xxmax - 2 * br) * rnd + br 'x location
b(i).y = (yymax - 2 * br) * (i - 1) / nb + br 'y location
if rnd < .5 then b(i).dx = 1 + rnd * 2 else b(i).dx = -1 - rnd * 2 'dx change of x
b(i).dy = 1 'dy change of y
next

while 1 'main show

cls 'some flames are sticking
for i = 0 to xxmax : f(i, yymax) = 0 : f(i, yymax - 1) = 0 : next
for i = 0 to yymax : f(0, i) = 0 : next

for y = 1 to yymax - 2 'fire based literally on 4 pixels below it like cellular automata
for x = 1 to xxmax - 1
f(x, y) = max( (f(x - 1, y + 1) + f(x, y + 1) +f(x + 1, y + 1) + f(x, y + 2) ) / 4 - 5, 0)
rect x * xstep, y * ystep, step xstep + 1, ystep + 1, p(f(x, y)) filled
next
next

for i = 1 to nb 'move ball
b(i).dy = b(i).dy + acc

'new location unless out of bounds
b(i).y = b(i).y + b(i).dy
b(i).x = b(i).x + b(i).dx

'keep ball in bounds
if b(i).y > yymax - br then b(i).dy = -.9 * b(i).dy : b(i).y = yymax - br : b(i).dx = b(i).dx *.9
if b(i).x < br then b(i).dx = -.9 * b(i).dx : b(i).x = br
if b(i).x > xxmax - br then b(i).dx = -.9 * b(i).dx : b(i).x = xxmax - br

'handle new location
fireBall b(i).x, b(i).y

'handle dead balls
if abs(b(i).lastbx - b(i).x)< .01 and abs(b(i).lastby-b(i).y) < .01 then
b(i).x = (xxmax - 2 * br) * rnd + br
b(i).y = 0
b(i).dy = 1
if rnd < .5 then b(i).dx = 1 + rnd * 2 else b(i).dx = -1 - rnd * 2 'edit
fi
b(i).lastby = b(i).y : b(i).lastbx = b(i).x

next
showpage
delay 10
wend

sub
fireBall(x, y)
local xr, yr, yrMax
for yr = 0 to br
if y + yr <= yymax - 2 then f(x, y + yr) = 300
if y - yr >= 0 then f(x, y - yr) = 300
next
for xr = 0 to br
yrMax = (brs - xr * xr) ^ .5
for yr = 0 to yrMax
if x + xr < xxmax - 1 and y + yr <= yymax - 1 then f(x + xr, y + yr) = 300
if x + xr < xxmax - 1 and y - yr >= 0 then f(x + xr, y - yr) = 300
if x - xr >= 0 and y + yr <= yymax then f(x - xr, y + yr) = 300
if x - xr >= 0 and y - yr >= 0 then f(x - xr, y - yr) = 300
next
next
circle x * xstep, y * ystep - ystep, br * xstep, xstep / ystep, p(300) filled
end

Learned a couple of improvements while translating previous version to QB64.
QB64 version
http://www.thejoyfulprogrammer.com/qb64/forum/showthread.php?tid=1138&pid=5382&rndtime=15115562001835193033#pid5382
SB snap shot
http://www.thejoyfulprogrammer.com/qb64/forum/showthread.php?tid=1137&pid=5383&rndtime=15115582601203139914#pid5383

'Great balls of fire.bas SmallBASIC 0.12.9 (B+=MGA) 2017-11-24
' some lessons learned while doing QB64 version
'mod Great balls of fire.bas SmallBASIC 0.12.9 (B+=MGA) 2017-11-23

xxmax = 150 : yymax = 150 'pixels too slow
xstep = 600 / xxmax : ystep = 600 / yymax
dim p(300) 'pallette thanks harixxx
for i = 1 to 100
fr = 240 * i / 100 + 15
p(i) = rgb(fr, 0, 0)
p(i + 100) = rgb(255, fr, 0)
p(i + 200) = rgb(255, 255, fr)
next
dim f(xxmax, yymax) 'fire array tracks flames
nb = 7 'number of balls
acc = .1 'gravity
br = 4 'ball radius
brs = br * br 'ball radius squared
dim b(1 to nb) 'ball array
for i = 1 to nb 'ball maker
b(i).x = (xxmax - 2 * br) * rnd + br 'x location
b(i).y = (yymax - 2 * br) * (i - 1) / nb + br 'y location
if rnd < .5 then b(i).dx = 1 + rnd * 2 else b(i).dx = -1 - rnd * 2 'dx change of x
b(i).dy = 1 'dy change of y
next

while 1 'main show

cls 'some flames are sticking
rect 0, 0, 601, 598, 9
for i = 0 to xxmax : f(i, yymax) = 0 : f(i, yymax - 1) = 0 : next
for i = 0 to yymax : f(0, i) = 0 : next

for y = 1 to yymax - 2 'fire based literally on 4 pixels below it like cellular automata
for x = 1 to xxmax - 1
v = (f(x - 1, y + 1) + f(x, y + 1) + f(x + 1, y + 1) + f(x, y + 2)) / 4 - 1
IF v > 0 AND RND < .9 THEN f(x, y) = v ELSE f(x, y) = 0
if v > 294 then f(x, y) = 300
rect x * xstep, y * ystep, step xstep + 1, ystep + 1, p(f(x,y)) filled
next
next

for i = 1 to nb 'move ball
b(i).dy = b(i).dy + acc

'new location unless out of boundsw
b(i).y = b(i).y + b(i).dy
b(i).x = b(i).x + b(i).dx

'keep ball in bounds
if b(i).y < br then b(i).y = br : b(i).dy = -1 * b(i).dy
if b(i).y > yymax - br then b(i).dy = -.9 * b(i).dy : b(i).y = yymax - br : b(i).dx = b(i).dx *.9
if b(i).x < br then b(i).dx = -.9 * b(i).dx : b(i).x = br
if b(i).x > xxmax - br then b(i).dx = -.9 * b(i).dx : b(i).x = xxmax - br

'handle new location
fireBall b(i).x, b(i).y

'handle dead balls
if abs(b(i).lastbx - b(i).x)< .01 and abs(b(i).lastby-b(i).y) < .01 then
b(i).x = (xxmax - 2 * br) * rnd + br
b(i).y = 0
b(i).dy = 1
if rnd < .5 then b(i).dx = 1 + rnd * 2 else b(i).dx = -1 - rnd * 2 'edit
fi
b(i).lastby = b(i).y : b(i).lastbx = b(i).x

next
showpage
delay 10
wend

sub
fireBall(x, y)
local xr, yr, yrMax
for xr = 0 to br
yrMax = (brs - xr * xr) ^ .5
for yr = 0 to yrMax
if x + xr < xxmax - 1 and y + yr <= yymax - 1 then f(x + xr, y + yr) = 300
if x + xr < xxmax - 1 and y - yr >= 0 then f(x + xr, y - yr) = 300
if x - xr >= 0 and y + yr <= yymax then f(x - xr, y + yr) = 300
if x - xr >= 0 and y - yr >= 0 then f(x - xr, y - yr) = 300
next
next
end