A configurable fireworks effect demo.
'===============================================================================
'||Fireworks Demo
'||by Ezekiel Gutierrez
'||(c)2018
'===============================================================================
dim shared as integer mx,my,click,r,g,b,rd=1,gd=1,bd=1
#include once "gui.bi"
type star
a as integer 'active
s as integer 'size
x as single 'x co-ord
y as single 'y co-ord
ang as single 'direction
speed as single 'speed
col as integer 'color
declare sub move
declare sub render(scr as any ptr)
declare sub create(x as integer,y as integer,ms as integer,msp as integer,minsp as integer)
end type
screenres 640,480,32 '640x480 Fullscreen, 32 bit color depth
'Create 2 images for the blur effect
dim as any ptr scr=imagecreate(640,480,rgb(255,0,255)),lscr=imagecreate(640,480,rgb(255,0,255))
dim as star stars(9999) 'Create 999 stars. This is the max number of stars that can be active at once.
'Setup a user interface
dim as menu menu1
with menu1
redim .sliders(10) as slider
.x=0:.y=0
.w=150:.h=480
.sliders(0).text="Trail Length"
.sliders(0).x=10:.sliders(0).y=30
.sliders(0).length=70
.sliders(0).minv=0
.sliders(0).maxv=255
.sliders(0).posit=50
.sliders(1).text="Max Star Size"
.sliders(1).x=10:.sliders(1).y=60
.sliders(1).length=70
.sliders(1).minv=1
.sliders(1).maxv=10
.sliders(1).posit=8
.sliders(2).text="Max Star Number"
.sliders(2).x=10:.sliders(2).y=90
.sliders(2).length=70
.sliders(2).minv=0
.sliders(2).maxv=ubound(stars)
.sliders(2).posit=6
.sliders(3).text="Max Star Speed"
.sliders(3).x=10:.sliders(3).y=120
.sliders(3).length=70
.sliders(3).minv=0
.sliders(3).maxv=35
.sliders(3).posit=4
.sliders(4).text="Min Star Speed"
.sliders(4).x=10:.sliders(4).y=150
.sliders(4).length=70
.sliders(4).minv=0
.sliders(4).maxv=35
.sliders(4).posit=2
.sliders(5).text="Star Congestion"
.sliders(5).x=10:.sliders(5).y=180
.sliders(5).length=70
.sliders(5).minv=0
.sliders(5).maxv=200
.sliders(5).posit=8
.sliders(6).text="Blur Mode"
.sliders(6).x=10:.sliders(6).y=210
.sliders(6).length=70
.sliders(6).minv=0
.sliders(6).maxv=1
.sliders(6).posit=0
.sliders(7).text="Glow"
.sliders(7).x=10:.sliders(7).y=240
.sliders(7).length=70
.sliders(7).minv=0
.sliders(7).maxv=1
.sliders(7).posit=0
.sliders(8).text="Glow Width"
.sliders(8).x=10:.sliders(8).y=270
.sliders(8).length=70
.sliders(8).minv=0
.sliders(8).maxv=5
.sliders(8).posit=0
.sliders(9).text="Glow Amount"
.sliders(9).x=10:.sliders(9).y=300
.sliders(9).length=70
.sliders(9).minv=0
.sliders(9).maxv=255
.sliders(9).posit=18
end with
dim as integer ex,ey,edx=1,edy=1
setmouse ,,0
'=======================================================
' Main Loop
'=======================================================
do
getmouse mx,my,,click
line scr,(0,0)-(640,480),rgba(0,0,0,0),bf 'clear the image buffer
if menu1.sliders(6).value>=0.5 then
if menu1.sliders(7).value>=0.5 then
dim as integer wid=menu1.sliders(8).value,am=menu1.sliders(9).value
put scr,(wid,0),lscr,alpha,am '|'
put scr,(0,wid),lscr,alpha,am '|'Put 4 faded
put scr,(-wid,0),lscr,alpha,am '|'images for
put scr,(0,-wid),lscr,alpha,am '|'the blur
end if
put scr,(0,0),lscr,alpha,menu1.sliders(0).value'180 '|'effect
end if
draw string scr,(460+ex,430+ey),"Fireworks Demo",rgb(180,180,180)
draw string scr,(460+ex,440+ey),"by Ezekiel Gutierrez",rgb(180,180,180)
draw string scr,(460+ex,450+ey),"(c)2018",rgb(180,180,180)
circle scr,(mx,my),4,rgb(100,100,100),,,,f
circle scr,(mx,my),3,rgb(170,170,170),,,,f
circle scr,(mx,my),2,rgb(255,255,255),,,,f
ex+=edx
ey+=edy
edx=-edx:edy=-edy
for i as integer=0 to ubound(stars)
stars(i).move 'Move the stars
stars(i).render(scr) 'Draw the stars
next
if menu1.sliders(6).value<0.5 then
if menu1.sliders(7).value>=0.5 then
dim as integer wid=menu1.sliders(8).value,am=menu1.sliders(9).value
put scr,(wid,0),lscr,alpha,am '|'
put scr,(0,wid),lscr,alpha,am '|'Put 4 faded
put scr,(-wid,0),lscr,alpha,am '|'images for
put scr,(0,-wid),lscr,alpha,am '|'the blur
end if
put scr,(0,0),lscr,alpha,menu1.sliders(0).value'180 '|'effect
end if
menu1.manage
menu1.render(scr)
'=============================
'Render
screenlock
cls 'clear the screen to the background color
put (0,0),scr,trans 'Draw the stars to the screen
screenunlock
put lscr,(0,0),scr,pset 'Save a backup of the screen for the blur effect
'=============================
if click=1 and mx>150 then 'If the user is clicking then
for j as integer=0 to menu1.sliders(5).value 'Create 20 stars
for i as integer=0 to menu1.sliders(2).value'Scan for an unused star to activate
if stars(i).a=0 then
stars(i).create(mx,my,menu1.sliders(1).value,menu1.sliders(3).value,menu1.sliders(4).value)
exit for
end if
next
next
end if
dim as integer mi=100,mx=220 '|'
if rd=1 then r+=rnd*2 else r-=rnd*2 '|'
if gd=1 then g+=rnd*2 else g-=rnd*2 '|'Manage the
if bd=1 then b+=rnd*2 else b-=rnd*2 '|'color of
if r>mx then r=mx:rd=-rd '|'stars
if rmx then g=mx:gd=-gd '|'
if gmx then b=mx:bd=-bd '|'
if b0 then dx-=0.04
'if dx<0 then dx+=0.04
'if dy<2 then dy+=0.04
if x<0 then a=0 'Deactivate particles
if y<0 then a=0 'that go off the edge
if x>640 then a=0 'of the screen.
if y>480 then a=0 '
end if
end sub
'==================================================================
'==================================================================
'This routine draws with trails.
sub star.render(scr as any ptr)
if a=1 then
circle scr,(x,y),s,col,,,,f
'circle scr,(x+dx,y+dy),s,col,,,,f
'circle scr,(x+(dx*2),y+(dy*2)),s,col,,,,f
'circle scr,(x+(dx*3),y+(dy*3)),s,col,,,,f
end if
end sub
'===================================================================
'===================================================================
'This routine creates stars.
'It needs to be told the screen co-ords for the star.
sub star.create(x1 as integer,y1 as integer,ms as integer,msp as integer,minsp as integer)
x=x1
y=y1
'dx=(rnd*(msp*2))-msp 'Set a random direction
'dy=(rnd*(msp*2))-msp 'for the star
ang=rnd*6.28
speed=(rnd*msp)+minsp
'if dx<=0 then dx+=minsp
'if dx>0 then dx+=minsp
'if dy<=0 then dy-=minsp
'if dy<>0 then dy+=minsp
s=rnd*ms 'Set a random size for the star. The number is the max size.
dim as integer sb=rnd*100'Give a color
col=rgb(r-sb,g-sb,b-sb) 'to the star
a=1 'Set the star as activated
end sub
'===================================================================
'===============================================================================
'||Mini Graphic Interface
'||by Ezekiel Gutierrez
'||(c)2018
'===============================================================================
' Slider Element
type slider
text as string
x as integer
y as integer
length as integer
posit as integer
minv as single
maxv as single
value as single
hpx as integer
hpy as integer
h as integer
declare sub manage()
declare sub render(img as any ptr)
end type
' Menu Container
type menu
x as integer
y as integer
w as integer
h as integer
sliders(any) as slider
declare sub manage()
declare sub render(img as any ptr)
end type
'=================================================================
' Subroutines
'=================================================================
'=================================================================
'These routines for managing menu
sub menu.manage()
for i as integer=0 to ubound(sliders)
sliders(i).manage()
next
end sub
sub slider.manage()
if h=0 andalso click=1 andalso mx>=x+posit-2 andalso mx<=x+posit+2 andalso my>=y-5 andalso my<=y+5 then
h=1:hpx=mx
end if
if h=1 and click=1 then
dim as integer d=hpx-mx
while posit-d>length
d+=1
wend
while posit-d<0
d-=1
wend
posit-=d
hpx-=d
else
h=0
end if
'if posit>length then posit=length
'if posit<0 then posit=0
'0 - length posit
'minv - maxv value
dim as integer l=maxv-minv
value=((l*posit)/length)+minv
end sub
'=================================================================
'These routines for rendering menu
sub menu.render(img as any ptr)
line img,(x,y)-(x+w,y+h),rgb(100,100,100),bf
if mx>=x and mx<=x+w and my>=y and my<=my then line img,(mx,my)-(mx+2,my+4)
for i as integer=0 to ubound(sliders)
sliders(i).render(img)
next
end sub
sub slider.render(img as any ptr)
draw string img,(x,y-15),text,rgb(255,255,255)
line img,(x,y)-(x+length,y),rgb(0,0,0)
line img,(x+posit-2,y-5)-(x+posit+2,y+5),rgb(255,255,255),b
draw string img,(x+length+4,y-3),str(value)
end sub