Fireworks with gravity!

[SAB]

Should I keep going?

Code Select Expand


nops = 200   ' Number of points in an explosion
dis  = 10    ' Distance of motion blur     
noexps = 10  ' Number of explosions

dim xbuffer#(dis,nops,noexps)
dim ybuffer#(dis,nops,noexps)

dim intensity#(dis,nops,noexps)
dim lite#(noexps,nops)

dim xpts#(noexps,nops)
dim ypts#(noexps,nops)
dim angs(noexps,nops)     

dim explode(noexps)   
dim counter(noexps)

dim times(noexps,nops)
dim st(noexps,nops)
dim et(noexps,nops)
dim t1(noexps,nops)

dim accel#(noexps,nops)
dim vel#(noexps,nops)

speed = 1

dim xcntr(noexps),ycntr(noexps)

dim choice
dim x,y
dim h,i,j
dim n
dim e

dim red(noexps),green(noexps),blue(noexps)
dim r,g,b

dim rcol,gcol,bcol

' Initialization

for h = 1 to noexps
 
  gosub refresh

next

SCREEN 18,32,2

RANDOMIZE TIMER

SCREENSET 1,0

DO   

CLS

for j = 1 to noexps 
  if counter(j) > explode(j) then
  for h = 1 to dis
    for i = 1 to nops
     
      if xbuffer#(h,i,j) = 0 and ybuffer#(h,i,j) = 0 then goto skip1
               
      rcol = red(j) - (intensity#(h,i,j) * 255)
      if rcol < 0 then rcol = 0
      gcol = green(j) - (intensity#(h,i,j) * 255)
      if gcol < 0 then gcol = 0
      bcol = blue(j) - (intensity#(h,i,j) * 255)     
      if bcol < 0 then bcol = 0
     
      CIRCLE (xbuffer#(h,i,j),ybuffer#(h,i,j)),1,RGB(rcol,gcol,bcol)
     
      PAINT (xbuffer#(h,i,j),ybuffer#(h,i,j)),RGB(rcol,gcol,bcol),RGB(rcol,gcol,bcol)
           
      skip1:   
   
    next
  next
  endif
next                                 

SCREENCOPY

for j = 1 to noexps
  if counter(j) > explode(j) then
  for h = 1 to dis - 1
    for i = 1 to nops
     
      xbuffer#(h,i,j) = xbuffer#(h+1,i,j)
      ybuffer#(h,i,j) = ybuffer#(h+1,i,j)
      intensity#(h,i,j) = intensity#(h+1,i,j) + .1
   
    next
  next
  endif
next

for i = 1 to noexps

  if counter(i) > explode(i) then

  for j = 1 to nops

    xpts#(i,j) = xcntr(i) + cos(angs(i,j)) * (times(i,j) * speed)
    ypts#(i,j) = ycntr(i) + sin(angs(i,j)) * (times(i,j) * speed)

    if t1(i,j) > st(i,j) then gosub move
    if times(i,j) > et(i,j) then goto skip2

    xbuffer#(dis,j,i) = xpts#(i,j)
    ybuffer#(dis,j,i) = ypts#(i,j)

    intensity#(dis,j,i) = lite#(i,j)
   
    goto skip3

    skip2:

    xbuffer#(dis,j,i) = 0
    ybuffer#(dis,j,i) = 0

    skip3:

  next
  endif
next         


for h = 1 to noexps
 
  if counter(h) > explode(h) then

  n = 1

  for i = 1 to nops

    t1(h,i) = t1(h,i) + 1

    if times(h,i) > et(h,i) then n = n + 1

    if n = nops then gosub refresh

  next       
  endif
next         

for h = 1 to noexps

counter(h) = counter(h) + 1

next

LOOP UNTIL INKEY$ = CHR$(27)

END

move:

accel#(i,j) = accel#(i,j) + .01
vel#(i,j) = vel#(i,j) + accel#(i,j)
ypts#(i,j) = ypts#(i,j) + vel#(i,j)
times(i,j) = times(i,j) + 1

return

refresh: 

explode(h) = int(rnd(1)  * 100)
counter(h) = 0

x = int(rnd(1) *  640)
y = int(rnd(1) *  480)

choice = int(rnd(1) * 7) + 1

if choice =  1 then r = 255: g = 0: b = 0
if choice =  2 then r = 0: g = 255: b = 0
if choice =  3 then r = 0: g = 0: b = 255
if choice =  4 then r = 255: g = 255: b = 0
if choice =  5 then r = 0: g = 255: b = 255
if choice =  6 then r = 255: g = 0: b = 255
if choice =  7 then r = 255: g = 255: b = 255

xcntr(h) = x
ycntr(h) = y

red(h) = r
green(h) = g
blue(h) = b       

for i = 1 to nops

lite#(h,i) = 0
angs(h,i) = int(rnd(1) * 360)
st(h,i) = int(rnd(1) * 100)
et(h,i) = int(rnd(1) * 100)
accel#(h,i) = 0
vel#(h,i) = 0
times(h,i) = 0
t1(h,i) = 0       

next

return


             


(Edit ~ Listing added - SW)

[Shockwave]

That's really cool
Nice one Sab!

[Clyde]

Neat routines dude, nice one.

Keep 'em comming,
Cheers - Clyde.