TheGameCreators - CodeBase

Return to the CodeBase listing

Category: 3D Effects

Version: 1.1

Information

Uploaded: 23rd Aug 2004 00:10

Modified: 6th Sep 2004 01:56

Author: Rasdini

Summary

A particles feast for the eyes.Up-graded.

Full Description

Using particles to create a fireworks display with dazzling visuals.

DarkBASIC Professional Source Code

` 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

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

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

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

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

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

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

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

Download

Please login to download

Comments

No comments yet.

CodeBase - FireWorks

Information

Summary

Full Description

DarkBASIC Professional Source Code

Download

Screen Shot

Author

Comments

Author Name:	Rasdini
CodeBase Entries:	13