Great balls of fire
#1
Code:
'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 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 > 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


Attached Files Thumbnail(s)

B += x
Reply
#2
Mods based on what I learned translating to QB64:
Code:
'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


Attached Files Thumbnail(s)

B += x
Reply