A particles feast for the eyes.Up-graded.

Using particles to create a fireworks display with dazzling visuals.

                                    ` This code was downloaded from The Game Creators
                                    ` It is reproduced here with full permission
                                    ` http://www.thegamecreators.com
                                    
                                    Rem Project: fireworks
Rem Created: 8/19/04 9:33:05 PM

Rem ***** Main Source File *****

rem new fireworks program

cls
set display mode 800,600,32
sync on
autocam off
backdrop on
color backdrop rgb(0,0,0)

hide mouse

dim red(10):dim green(10):dim blue(10)
red(1)=255:green(1)=255:blue(1)=255          `white
red(2)=180:green(2)=10:blue(2)=5             `red
red(3)=0:green(3)=255:blue(3)=180            `teal
red(4)=0:green(4)=155:blue(4)=255            `ice blue
red(5)=255:green(5)=128:blue(5)=0            `gold
red(6)=128:green(6)=0:blue(6)=255            `purple
red(7)=255:green(7)=255:blue(7)=0            `yellow
red(8)=255:green(8)=135:blue(8)=255          `cool purple
red(9)=205:green(9)=30:blue(9)=65            `pink
red(10)=150:green(10)=150:blue(10)=255       `bright blue/purple

`for x=1 to 50
`   load sound "explosion.wav",x
`   set sound volume x,80
`next x
`report=1
`for x=51 to 100
`   load sound "explosion.wav",x
`   set sound volume x,60
`next x
`report2=51
`for x=101 to 120
`   load sound "crackle.wav",x
`   set sound volume x,82
`   load sound "crackle2.wav",x+20
`next x
`report3=101

show=250:lpcount=0:lpcount1=0
dim partht(500):dim partpos#(500):dim partdur(500)
dim partdir(500):dim trldur(600)
dim partclch(500):dim trad(500):dim trad2(500)
dim tdec(500):dim tdec2(500)
stat=0
gosub randomloop
ink rgb(255,255,255),0
op=0:trad=170:ladder=1
position camera 0,0,0,-200
point camera 0,0,0,40
set camera range 1,100000
do
inc op,5:if op>360 then op=0
if lpcount1=0 then inc lpcount
if lpcount>1500 then lpcount1=1200:lpcount=0:stat=1

rem control camera using arrowkeys 0,2,2
if lpcount1>0 then dec lpcount1:goto skipintro
spurt=rnd(2000):if spurt=ranfactor*2 then spurt2=20:spurt3=2+rnd(2)
firework=rnd(show)
if firework=ranfactor/2 or firework=int(ranfactor/3) or spurt3>0
   if spurt3>0
      dec spurt2
      if spurt2>0 then goto spurting
      dec spurt3:spurt2=5+rnd(25)
   endif
   for x=1 to 500
      if particles exist(x)=0
         make particles x,0,5+rnd(5),15+rnd(50)
         position particles x,rnd(2200)-1100,0,2800+(rnd(200)-100)
         set particle emissions x,0
         color particles x,200,0,0
         set particle velocity x,2+rnd(10)
         set particle gravity x,1
         gr=rnd(10):if gr<6 then set particle gravity x,.5 else set particle gravity x,.6
         set particle floor x,0
         set particle speed x,.015
         set particle life x,60+rnd(40)
         partht(x)=150+rnd(410):partpos#(x)=-1800
         partdir(x)=rnd(2):partclch(x)=0
         if special>0 and spurt3<>2 then dec special:goto skipspecial
         spec=rnd(10)
         if spec=5
            partclch(x)=10
            px=particles position x(x):py=particles position y(x):pz=particles position z(x)
            delete particles x
            make particles x,0,12,45
            position particles x,px,py,pz-1200
            set particle emissions x,0
            set particle floor x,0
            special=3
         endif
         spec=rnd(10)
         if spec=5
            partclch(x)=9
            px=particles position x(x):py=particles position y(x):pz=particles position z(x)
            delete particles x
            make particles x,0,9,30
            position particles x,px,py,pz
            set particle emissions x,0
            set particle floor x,0
            special=3
         endif
         spec=rnd(10)
         if spec=5 or spurt3=2
            partclch(x)=8
            px=particles position x(x):py=particles position y(x):pz=particles position z(x)
            delete particles x
            make particles x,0,4,60
            position particles x,px,py,pz+500
            set particle emissions x,0
            set particle floor x,0
            trad(x)=100+rnd(400):trad2(x)=100+rnd(400)
            tdec(x)=rnd(4)+1:tdec2(x)=rnd(4)+1
            partht(x)=400+rnd(110)
            special=3
         endif
         skipspecial:
         x=500
         `play sound report2
         `inc report2
         `if report2>100 then report2=51
      endif
   next x
   spurting:
endif
skipintro:
if lpcount1=0 and stat=1 then stat=0:gosub randomloop

if ladder=1 then ladder=2 else ladder=1
for x=1 to 500
   if particles exist(x)=1 and partpos#(x)<partht(x)
      if partpos#(x)<partht(x)
         if partpos#(x)<51 then htch=8
         if partpos#(x)>50 and partpos#(x)<130 then htch=6
         if partpos#(x)>129 and partpos#(x)<221 then htch=4
         if partpos#(x)>220 then htch=2
         inc partpos#(x),htch
         if partclch(x)=8 then dec partpos#(x),int(htch/3)
         if partpos#(x)>-550
            if partdir(x)=1
               position particles x,particles position x(x)+.5,particles position y(x),particles position z(x)
            endif
            if partdir(x)=2
               position particles x,particles position x(x)-.5,particles position y(x),particles position z(x)
            endif
         endif
         if partclch(x)=8
            position particles x,particles position x(x),particles position y(x),particles position z(x)-1
         endif
         if partclch(x)=8 and partpos#(x)>-500
            dec trad(x),tdec(x):dec trad2(x),tdec2(x)
         endif
         if partpos#(x)<partht(x)
            trail=rnd(4)
            if trail=1 or trail=2 and partclch(x)=8
               for tr=801 to 1400 step ladder
                  if particles exist(tr)=0
                     make particles tr,0,2,18
                     set particle gravity tr,8
                     set particle emissions tr,1
                     set particle floor tr,0
                     cl=10
                     color particles tr,red(cl),green(cl),blue(cl)
                     set particle life tr,50+rnd(10)
                     set particle speed tr,.0038
                     trldur(tr-800)=200
                     if partclch(x)=10
                        delete particles tr
                        make particles tr,0,5,20
                        cl=5
                        color particles tr,red(cl),green(cl),blue(cl)
                        set particle gravity tr,2
                        set particle emissions tr,3
                        set particle life tr,60+rnd(20)
                        set particle speed tr,.006
                        set particle chaos tr,90
                        set particle floor tr,0
                        trldur(tr-800)=400
                     endif
                     if partclch(x)=9
                        delete particles tr
                        make particles tr,0,8,20
                        cl=3
                        color particles tr,red(cl),green(cl),blue(cl)
                        set particle gravity tr,5
                        set particle emissions tr,3
                        set particle life tr,60+rnd(20)
                        set particle speed tr,.006
                        set particle chaos tr,30
                        set particle floor tr,0
                        trldur(tr-800)=400
                     endif
                     if partclch(x)=8
                        tox=cos(op)*trad(x):toz=sin(op)*trad2(x)
                        delete particles tr
                        make particles tr,0,12,19
                        cl=10
                        color particles tr,red(cl),green(cl),blue(cl)
                        set particle gravity tr,5+rnd(15)
                        set particle emissions tr,8
                        set particle life tr,90+rnd(10)
                        set particle speed tr,.006
                        set particle chaos tr,70
                        set particle velocity tr,5
                        set particle floor tr,0
                        trldur(tr-800)=400
                     endif
                     position particles tr,particles position x(x),partpos#(x),particles position z(x)
                     if partclch(x)=8
                        position particles tr,particles position x(x)+tox,partpos#(x),particles position z(x)+toz
                     endif
                     tr=1400
                  endif
               next tr
            endif
         endif
         if partpos#(x)>=partht(x)
            partdur(x)=804+rnd(20)
            position particles x,particles position x(x),partht(x),particles position z(x)
            `pan=particles position x(x)
            set particle emissions x,2+rnd(10)
            cl=rnd(9)+1
            color particles x,red(cl),green(cl),blue(cl)
            cha=rnd(20)
            if cha=10 and partclch(x)<8
               kaos=20+rnd(800)
               set particle chaos x,kaos
               if kaos>150
                  rem play sound report3
                  set particle life x,100
                  set particle velocity x,2
                  set particle speed x,.005
                  partdur(x)=1504+rnd(20)
                  `play sound report3+20
                  `inc report3:if report3>120 then report3=101
               endif
            endif
            if partclch(x)=10
               set particle emissions x,20
               set particle life x,100
               set particle speed x,.02
               cl=rnd(9)+1
               color particles x,red(cl),green(cl),blue(cl)
               set particle velocity x,5
               set particle gravity x,1
               for l=1 to 500
                  if particles exist(l)=0
                     make particles l,0,7,15
                     position particles l,particles position x(x),particles position y(x)+rnd(50),particles position z(x)
                     cl=rnd(9)+1
                     color particles l,red(cl),green(cl),blue(cl)
                     set particle life l,85
                     set particle speed l,.02
                     set particle velocity l,8
                     set particle gravity l,1
                     set particle floor l,0
                     set particle emissions l,40
                     set particle chaos l,100+rnd(50)
                     partdur(l)=904+rnd(20)
                     l=500
                  endif
               next l
            endif
            if partclch(x)=9
               set particle emissions x,50
               set particle life x,100
               set particle speed x,.03
               cl=rnd(9)+1
               color particles x,red(cl),green(cl),blue(cl)
               set particle velocity x,4+rnd(2)
               set particle gravity x,0
               for sp=1 to 2
                  cl=rnd(9)+1
                  for l=1 to 500
                     if particles exist(l)=0
                        make particles l,0,7,15
                        position particles l,particles position x(x)+30-(sp*20),particles position y(x)+50,particles position z(x)
                        color particles l,red(cl),green(cl),blue(cl)
                        set particle life l,75
                        set particle speed l,.02
                        set particle velocity l,10
                        set particle gravity l,1
                        set particle floor l,0
                        set particle emissions l,20
                        partdur(l)=904+rnd(20)
                        l=500
                     endif
                  next l
               next sp
            endif
            if partclch(x)=8
               tox=cos(op)*trad(x):toz=sin(op)*trad2(x)
               position particles x,particles position x(x)+tox,partpos#(x),particles position z(x)+toz
               set particle emissions x,50
               set particle life x,70
               set particle speed x,.02
               cl=rnd(9)+1
               color particles x,red(cl),green(cl),blue(cl)
               set particle velocity x,6
               set particle gravity x,1.2
               for l=1 to 500
                  if particles exist(l)=0
                     make particles l,0,7,18
                     position particles l,particles position x(x),particles position y(x)+rnd(50),particles position z(x)
                     cl=rnd(9)+1
                     color particles l,red(cl),green(cl),blue(cl)
                     set particle life l,95
                     set particle speed l,.04
                     set particle velocity l,12
                     set particle gravity l,1
                     set particle floor l,0
                     set particle emissions l,60
                     set particle chaos l,100+rnd(200)
                     partdur(l)=904+rnd(20)
                     l=500
                  endif
               next l
            endif
            `set sound pan report,pan
            `play sound report
            `inc report
            `if report>50 then report=1
         endif
      endif
   endif
next x

for x=1 to 500
   if particles exist(x)=1 and partdur(x)>0
      dec partdur(x)
      if partclch(x)=0
         cc=rnd(28)
         if cc=14
            cl=rnd(9)+1
            color particles x,red(cl),green(cl),blue(cl)
            partclch(x)=1
         endif
      endif
      if partclch(x)=10 and partdur(x)=804
         cl=rnd(9)+1
         color particles x,red(cl),green(cl),blue(cl)
      endif
      if partclch(x)=10 and partdur(x)=904
         cl=rnd(9)+1
         color particles x,red(cl),green(cl),blue(cl)
      endif
      if partdur(x)=1497 then set particle emissions x,0
      if partdur(x)=897 then set particle emissions x,0
      if partdur(x)=797 then set particle emissions x,0
      if partdur(x)<0 then delete particles x

   endif
next x

for x=801 to 1400
   if particles exist(x)=1
      dec trldur(x-800)
      if trldur(x-800)=198 or trldur(x-800)=398
         set particle emissions x,0
      endif
      if trldur(x-800)<0
         delete particles x
      endif
   endif
next x


in=rnd(300)
if in=150 then ink rgb(rnd(255),rnd(255),rnd(255)),0
set cursor 0,screen height()-30
print "FIREWORKS-BY RICHARD SARDINI";


sync
loop



randomloop:
try1again:
t$=get time$()
r1$=right$(t$,1)
if val(r1$)<1 and val(r1$)>4 then sleep rnd(100):goto try1again
r1=val(r1$)
sleep 500

try2again:
t$=get time$()
r2$=right$(t$,1)
if val(r2$)<0 and val(r2$)>9 then sleep rnd(100):goto try2again
r2=val(r2$)
sleep 500

try3again:
t$=get time$()
r3$=right$(t$,1)
if val(r3$)<0 and val(r3$)>9 then sleep rnd(100):goto try3again
r3=val(r3$)
sleep 500

ranfactor=(r1*100)+(r2*10)+r3
while ranfactor>500
   dec ranfactor,rnd(200)
endwhile
for x=1 to 1400
if particles exist(x)=1 then delete particles x
next x
return