Code archives/Graphics/Fireworks II

This code has been declared by its author to be Public Domain code.

Download source code

Fireworks II by Subirenihil
(Posted 21 years ago)
Unforunately, I have not added many comments. All settings can be set with the constants at the top of the program. Modify for your computer or add your own code for making the settings easier to modify.
WARNING!: This is a processor killer, adjust for your system.

By the way, I used WritePixelFast to multiply increase the effects 10x more than the original. I used a function I came up with for compressing data CompressInts(n1%,n2%,n3%,n4%). However, due to my backwards thinking at the time, the function must be sent blue,green,red,alpha. The alpha is not used in this program, but the function return integer color WritePixelFast needs to be sent. Quite useful.

[EDIT] Optimized for another 3-5 times the speed. 
SeedRnd MilliSecs()

Const scrwid=1024
Const scrhgh=768
Const depth=32           ;This may work better at 32
Const grav#=0.055*(480.0/scrhgh)
Const intensity=250      ;Smaller numbers run faster
Const SparkIntensity=1    ;sparks generated each frame. more than this starts looking fake
Const SparkFade#=.005    ;.075 smaller numbers mean more processor required
Const frequency=25
Const fadespeed#=.015    ;.015 smaller numbers mean more processor required
Const DudRate=50         ;out of 1000 are duds
Const explodesize#=2     ;1 to 2 is about as big as you want. bigger numbers don't look good
Const variance#=1
Const spiralchance=5
Const spinchance=500
Const screenlimit=10     ;don't overdo this, to many will bog your processor down.

Graphics scrwid,scrhgh,depth,1
SetBuffer BackBuffer()

Type shot
	Field x#,y#,xs#,ys#,t,sp#,sa,spn
End Type

Type frag
	Field x#,y#,xs#,ys#,r,g,b,br#,fad#,sr,sg,sb,st#
End Type

Type sprk
	Field x#,y#,xs#,ys#,r,g,b,br#,fad#
End Type

Global currentcount=0

t=MilliSecs()
Repeat
	Cls
	LockBuffer
	If Rand(0,1000)<frequency And currentcount<screenlimit
		Launch
	EndIf
	UpDate
	Render
	dla=30-(MilliSecs()-t)
	t=MilliSecs()
	Delay dla
	UnlockBuffer
	Flip
Until KeyHit(1)

End

Function Launch()
	s.shot=New shot
	s\x=Rand(scrwid)
	s\y=scrhgh-1
	s\ys=Rnd(-7,-6)
	s\xs=Rnd(-1,1)
	s\t=Rand(-30,30)+(158000.0/scrhgh)
	If Rand(1000)<DudRate Then s\t=s\t+Rand(50,s\t-5)*Rand(-1,2)
	If (s\x+(s\t*s\xs))<-20 Or (s\x+(s\t*s\xs))>scrwid+20 Then s\xs=-s\xs
	s\sp=0
	s\sa=90
	If Rand(1000)<spiralchance
		s\sp=Rnd(30,60)
		s\sa=Rnd(360)
		s\spn=0
		If Rand(1000)<spinchance Then s\spn=1
	EndIf
End Function

Function Explode(s.shot)
	c=Rand(1,3)
	e#=Rnd(1/variance,variance)
	st#=Rnd(.25,1)
	For l=0 To c-1
		fd#=sparkfade/Rnd(1/variance/3,variance*3)
		r=Rand(1,255)
		g=Rand(1,255)
		b=Rand(1,255)
		gr#=r
		If g>gr Then gr=g
		If b>gr Then gr=b
		r=r*255/gr#
		g=g*255/gr#
		b=b*255/gr#
		sr=Rand(1,255)
		sg=Rand(1,255)
		sb=Rand(1,255)
		gr#=sr
		If sg>gr Then gr=sg
		If sb>gr Then gr=sb
		sr=sr*255/gr#
		sg=sg*255/gr#
		sb=sb*255/gr#
		For a=0 To (intensity/c)*e;+Rand(-intensity/(c*2),intensity/(c*2))
			ang=Rand(360)
			If c=1
				spd#=Rnd(.5,2)
			ElseIf c=2
				If l=0
					spd#=Rnd(.5,1.6)
				Else
					spd#=Rnd(.9,2)
				EndIf
			ElseIf c=3
				If l=0
					spd#=Rnd(.5,1.25)
				ElseIf l=1
					spd#=Rnd(.75,1.75)
				Else
					spd#=Rnd(1.25,2)
				EndIf
			EndIf
			f.frag=New frag
			f\fad=fd
			f\x=s\x
			f\y=s\y
			f\xs=s\xs+Cos(ang)*spd*explodesize*e
			f\ys=s\ys-Sin(ang)*spd*explodesize*e
			If s\y>=scrhgh-7
				f\y=scrhgh-2
				f\ys=-Abs(f\ys)/3
			EndIf
			f\r=r
			f\g=g
			f\b=b
			f\sr=sr
			f\sg=sg
			f\sb=sb
			f\br=Rnd(.01,1)
			f\st=f\br-st
		Next
	Next
	Delete s
End Function

Function Update()
	currentcount=0
	For s.shot=Each shot
		currentcount=currentcount+1
		s\x=s\x+s\xs+Cos(s\sa)
		If s\spn=1 Then s\y=s\y+Sin(s\sa)
		s\y=s\y+s\ys
		s\ys=s\ys+grav
		s\sa=(s\sa+s\sp) Mod 360
		For a=0 To SparkIntensity
			p.sprk=New sprk
			p\x=s\x
			p\y=s\y
			p\ys=(s\ys+Sin(s\sa)*s\spn)/2+Rnd(-.1,.1)
			p\xs=(s\xs+Cos(s\sa))/2+Rnd(-.1,.1)
			p\br=Rnd(.01,1)
			p\r=255
			p\g=191
			p\b=191
			p\fad=sparkfade/4
		Next
		s\t=s\t-1
		If s\t<=0 Or s\y>scrhgh-1
			Explode s
		EndIf
	Next
	For f.frag=Each frag
		f\x=f\x+f\xs
		f\y=f\y+f\ys
		f\ys=f\ys+grav/2
		f\br=f\br-fadespeed
		If f\st<f\br
			For a=0 To SparkIntensity
				p.sprk=New sprk
				p\fad=f\fad
				p\x=f\x
				p\y=f\y
				p\ys=f\ys/2
				p\xs=f\xs/2+Rnd(-.25,.25)
				p\br=Rnd(.01,f\br)
				p\r=f\sr
				p\g=f\sg
				p\b=f\sb
			Next
		EndIf
		If f\y>scrhgh
			f\ys=-(f\ys/4)
		EndIf
		If (f\x<0 And f\xs<0) Or (f\xs>0 And f\x>scrwid) Or f\br<=0
			Delete f
		EndIf
	Next
	For p.sprk=Each sprk
		p\x=p\x+p\xs
		p\y=p\y+p\ys
		p\ys#=p\ys#+grav#/10
		p\ys#=p\ys#*.95
		p\xs#=p\xs#*.95
		p\br=p\br-p\fad;SparkFade
		If p\y>scrhgh Or (p\x<0 And p\xs<0) Or (p\x>scrwid And p\xs>0) Or p\br<=0
			Delete p
		EndIf
	Next
End Function

Function Render()
	For p.sprk=Each sprk
		If p\x>=0 And p\y>=0 And p\x<=scrwid-1 And p\y<=scrhgh-1 Then WritePixelFast p\x,p\y,((p\r*p\br) Shl 16)+((p\g*p\br) Shl 8)+(p\b*p\br); CompressInts(p\b*p\br,p\g*p\br,p\r*p\br,255)
;		Color p\r*p\br,p\g*p\br,p\b*p\br
;		Plot p\x,p\y
	Next
	For f.frag=Each frag
		If f\br>fadespeed*15
			If f\x>=0 And f\y>=0 And f\x<=scrwid-1 And f\y<=scrhgh-1 Then WritePixelFast f\x,f\y,$ffffff;CompressInts(255,255,255,255)
			If f\x-1>=0 And f\y>=0 And f\x-1<=scrwid-1 And f\y<=scrhgh-1 Then WritePixelFast f\x-1,f\y,(f\r Shl 16)+(f\g Shl 8)+f\b;CompressInts(f\b,f\g,f\r,255)
			If f\x+1>=0 And f\y>=0 And f\x+1<=scrwid-1 And f\y<=scrhgh-1 Then WritePixelFast f\x+1,f\y,(f\r Shl 16)+(f\g Shl 8)+f\b;CompressInts(f\b,f\g,f\r,255)
			If f\x>=0 And f\y-1>=0 And f\x<=scrwid-1 And f\y-1<=scrhgh-1 Then WritePixelFast f\x,f\y-1,(f\r Shl 16)+(f\g Shl 8)+f\b;CompressInts(f\b,f\g,f\r,255)
			If f\x>=0 And f\y+1>=0 And f\x<=scrwid-1 And f\y+1<=scrhgh-1 Then WritePixelFast f\x,f\y+1,(f\r Shl 16)+(f\g Shl 8)+f\b;CompressInts(f\b,f\g,f\r,255)
;			Color 255,255,255
;			Plot f\x,f\y
;			Color f\r,f\g,f\b;*f\br,f\g*f\br,f\b*f\br;
;			Plot f\x-1,f\y
;			Plot f\x+1,f\y
;			Plot f\x,f\y-1
;			Plot f\x,f\y+1
		Else
			If f\x>=0 And f\y>=0 And f\x<=scrwid-1 And f\y<=scrhgh-1 Then WritePixelFast f\x,f\y,((f\r*f\br*4) Shl 16)+((f\g*f\br*4) Shl 8)+(f\b*f\br*4);CompressInts(f\b*br*4,f\g*f\br*4,f\r*f\br*4,255)
			If f\x-1>=0 And f\y>=0 And f\x-1<=scrwid-1 And f\y<=scrhgh-1 Then WritePixelFast f\x-1,f\y,((f\r*f\br) Shl 16)+((f\g*f\br) Shl 8)+(f\b*f\br);CompressInts(f\b*f\br,f\g*f\br,f\r*f\br,255)
			If f\x+1>=0 And f\y>=0 And f\x+1<=scrwid-1 And f\y<=scrhgh-1 Then WritePixelFast f\x+1,f\y,((f\r*f\br) Shl 16)+((f\g*f\br) Shl 8)+(f\b*f\br);CompressInts(f\b*f\br,f\g*f\br,f\r*f\br,255)
			If f\x>=0 And f\y-1>=0 And f\x<=scrwid-1 And f\y-1<=scrhgh-1 Then WritePixelFast f\x,f\y-1,((f\r*f\br) Shl 16)+((f\g*f\br) Shl 8)+(f\b*f\br);CompressInts(f\b*f\br,f\g*f\br,f\r*f\br,255)
			If f\x>=0 And f\y+1>=0 And f\x<=scrwid-1 And f\y+1<=scrhgh-1 Then WritePixelFast f\x,f\y+1,((f\r*f\br) Shl 16)+((f\g*f\br) Shl 8)+(f\b*f\br);CompressInts(f\b*f\br,f\g*f\br,f\r*f\br,255)
;			Color f\r*f\br*4,f\g*f\br*4,f\b*f\br*4
;			Plot f\x,f\y
;			Color f\r*f\br,f\g*f\br,f\b*f\br
;			Plot f\x-1,f\y
;			Plot f\x+1,f\y
;			Plot f\x,f\y-1
;			Plot f\x,f\y+1
		EndIf
	Next
	For s.shot=Each shot
		If s\x>=0 And s\y>=0 And s\x<=scrwid-1 And s\y<=scrhgh-1 Then WritePixelFast s\x,s\y,$ffffff;CompressInts(255,255,255,255)
		If s\x+1>=0 And s\y>=0 And s\x+1<=scrwid-1 And s\y<=scrhgh-1 Then WritePixelFast s\x+1,s\y,$ff0000;CompressInts(0,0,255,255)
		If s\x-1>=0 And s\y>=0 And s\x-1<=scrwid-1 And s\y<=scrhgh-1 Then WritePixelFast s\x-1,s\y,$ff0000;CompressInts(0,0,255,255)
		If s\x>=0 And s\y+1>=0 And s\x<=scrwid-1 And s\y+1<=scrhgh-1 Then WritePixelFast s\x,s\y+1,$ff0000;CompressInts(0,0,255,255)
		If s\x>=0 And s\y-1>=0 And s\x<=scrwid-1 And s\y-1<=scrhgh-1 Then WritePixelFast s\x,s\y-1,$ff0000;CompressInts(0,0,255,255)
;		Color 255,255,255
;		Plot s\x,s\y
;		Color 255,0,0
;		Plot s\x-1,s\y
;		Plot s\x+1,s\y
;		Plot s\x,s\y-1
;		Plot s\x,s\y+1
	Next
End Function

Function CompressInts(n1%,n2%,n3%,n4%)
	a%=n1+(n2 Shl 8)+(n3 Shl 16)+((n4 Mod 128) Shl 24)
	If n4>128 Then a=a-2147483648
	Return a
End Function