I've written a nice program that has a handful of features for particles and at least I think it's pretty fun to play with. However, it has a few minor bugs that I can't seem to get out. The program is far from complete.
A couple of my floats (made doubles for maximum accuracy) will, when set to 0, will instead show an almost random value such as 1.86 in one case.
I've tried to fix this but I'm not sure what's happening.
Controls-
m brings up the menu
arrow keys navigate menu and alter values
f toggles fire at mouse
g toggles smoke at mouse
s creates a sonic boom at mouse
r toggles rain
Comments on my program are also welcome, and ideas as well. I hope you think it's fun also, and note that the fireworks section of the menu is incomplete.
A couple of my floats (made doubles for maximum accuracy) will, when set to 0, will instead show an almost random value such as 1.86 in one case.
I've tried to fix this but I'm not sure what's happening.
Controls-
m brings up the menu
arrow keys navigate menu and alter values
f toggles fire at mouse
g toggles smoke at mouse
s creates a sonic boom at mouse
r toggles rain
Comments on my program are also welcome, and ideas as well. I hope you think it's fun also, and note that the fireworks section of the menu is incomplete.
Const GW=800,GH=600 Global Parts%=0 Global B3DM_xp[360],B3DM_yp[360] Graphics GW,GH,32,60 SeedRnd MilliSecs() HideMouse SetBlend ALPHABLEND Local IntroDone=False,Itime=0 Local boxx=-480 Repeat Cls Itime=Itime+1 SetColor 50,50,50 DrawRect boxx,GH/2-20,300,40 boxx=boxx+7 SetColor Itime,Itime,Itime Text GW/2,GH/2,"This graphics demo was coded by Blitz3DMan in BlitzMAX.",1,1 Flip Until KeyHit(KEY_ESCAPE) Or Itime=>250 Delay 200 FlushKeys ' Constant flame toggle with f Global FireOn=False Global flamesPerMouse=80 Global fLIST:Tlist=CreateList() Global FireUp!=0.00 Type flame Field x#,y#,ang#,spd#,a#,size,shape Field lived,life Method Move() x=x+Cos(ang)*spd y=y+Sin(ang)*spd y=y-FireUp End Method Method Draw() lived=lived+1 SetAlpha a;If lived>(life/2) Then a=a-0.05 SetColor 190+(lived*65/life),190-(lived*190/life),(lived*50/life) SetScale 1,1;SetRotation 0 Select shape Case 0 DrawOval x,y,size,size Case 1 DrawRect x,y,size,size End Select End Method Method Check() If lived=>life Then fLIST.remove(Self);Parts:-1 End Method Function MakeFire(x#,y#) Local f:flame=New flame f.x=x;f.y=y f.ang=Rnd(0.000,359.999) f.spd=Rnd(2.000,3.500) f.life=Rand(8,16) f.a=Rnd(0.600,1.000) f.size=Rand(2,5) f.shape=Rand(0,1) fLIST.AddLast f;Parts:+1 End Function Function s_Update() If FireOn If KeyHit(KEY_F) Then FireOn=False For Local newf=1 To flamesPerMouse flame.MakeFire MouseX(),MouseY() Next Else If KeyHit(KEY_F) Then FireOn=True EndIf For Local f:flame=EachIn fLIST f.Move f.Draw f.Check Next End Function End Type ' s key sonic boom Global sbLIST:Tlist=CreateList() Global sbExist=150 Type sonic Field x#,y#,radius#,time# Method Draw() SetColor 10,100,205 SetAlpha time/sbExist/2.0000 SetScale 1,1;SetRotation 0 DrawOval x-radius,y-radius,radius*2,radius*2 End Method Method Enlarge() time=time-1 If time<0 Then DeleteMe radius:+1.2 End Method Method DeleteMe() sbLIST.remove(Self);Parts:-1 End Method Function Boom_Make(x#,y#) Local s:sonic=New sonic s.x=x;s.y=y s.radius=0.00 s.time=sbExist sbLIST.AddLast s;Parts:+1 End Function Function booms_Update() If KeyHit(KEY_S) Then sonic.Boom_Make(MouseX(),MouseY()) For Local sb:sonic=EachIn sbLIST sb.Draw sb.Enlarge Next End Function End Type ' Constant smoke with g Global Smokes=False Global numsmoke=3 Global Smokesiz=20,Minsmokesiz=5 Global s_spread#=2.00,maxSdist=12 Global Slife=56,minSlife=28 Global sLIST:Tlist=CreateList() Type smoke Field x#,y#,xv#,a#,size Field lived,life Method Move() If xv<0 Then xv:+0.1 Else xv:-0.1 x=x+xv y=y-2.4 End Method Method Draw() lived=lived+1 SetAlpha a;If lived>(life/2) Then a=a-0.06 SetColor 180,180,180 SetScale 1,1;SetRotation 0 DrawOval x,y,size,size End Method Method Check() If lived=>life Then sLIST.remove(Self);Parts:-1 End Method Function MakeSmoke(x#,y#) Local s:smoke=New smoke Local ang=Rand(0.0,359.9) s.x=x+Cos(ang)*Rnd(0.1,maxSdist-1);s.y=y+Sin(ang)*Rnd(0.1,maxSdist-1) s.life=Rand(minSlife,Slife) s.a=Rnd(0.600,1.000) s.size=Rand(Minsmokesiz,Smokesiz) s.xv=Rnd(-s_spread,s_spread) sLIST.AddLast s;Parts:+1 End Function Function Update() If Smokes If KeyHit(KEY_G) Then Smokes=False For Local news=1 To numsmoke smoke.MakeSmoke MouseX(),MouseY() Next Else If KeyHit(KEY_G) Then Smokes=True EndIf For Local s:smoke=EachIn sLIST s.Move s.Draw s.Check Next End Function End Type ' R toggle rain Global rLIST:Tlist=CreateList() Global IsItRain=0 Global RainFreq=1 Global RainWindVel#=0.02000000,Rgrav!=0.05 Type rain Field x#,y#,xv#,yv#,blu Method Update() Local lx=x,ly=y x=x+xv;y=y+yv SetColor 5,blu/2-10,blu SetAlpha 0.72;SetScale 1,1;SetRotation 0 SetLineWidth 1.2 DrawLine x,y,lx,ly xv=xv+RainWindVel yv=yv+Rgrav If y>GH Then rLIST.remove(Self);Parts:-1 End Method Function fall() If KeyHit(KEY_R) Then IsItRain=Abs(IsItRain-1) For Local r:rain=EachIn rLIST r.Update Next If IsItRain For Local NewRains=1 To RainFreq RainDrop Next EndIf End Function Function RainDrop() Local r:rain=New rain r.x=Rand(-300,GW+300);r.y=-4 r.xv=Rnd(0.000,0.080);r.yv=Rnd(5,9) r.blu=Rand(140,240) rLIST.AddLast r;Parts:+1 End Function End Type ' w key fireworks Global fwLIST:Tlist=CreateList() Global NumFWpresets=5 +1 Global Fp=1 Global Fr[NumFWpresets],Fg[NumFWpresets],Fb[NumFWpresets] Global FWpvel![NumFWpresets] Global FWnumparts[NumFWpresets] Global FWpartLife[NumFWpresets] Global FWlaunch![NumFWpresets] Global FWpartShape[NumFWpresets] '0=pixel, 1=circle, 2=square, 4=line Global FWpartSize[NumFWpresets] 'Used as line width if FWpartShape=4, irrelevant if FWpartShape=0 Global FWy[NumFWpresets] Global FWgrav![NumFWpresets] For Local s=1 To numFWpresets-1 Fr[s]=230;Fg[s]=140;Fb[s]=32 FWpvel[s]=2.2 FWnumparts[s]=36 FWpartLife[s]=180 FWlaunch[s]=4 FWpartShape[s]=0 FWpartSize[s]=1 FWy[s]=12 FWgrav[s]=0.0 Next Type firew Field x#,y#,tx,ty,yv#,ang!,spd! 'Fields that pertain to the firework Field pShape,pr,pg,pb,pNum,pSpd!,pSiz,pGrav!,pLif 'Fields that pertain to the spark particles Method Update() x:+Cos(ang)*spd y:+Sin(ang)*spd If Distance(x,y,tx,ty)<5 Then Detonate SetAlpha 0.9;SetScale 1,1;SetRotation 0;SetColor 200,200,200 DrawOval x-3,y-3,6,6 End Method Method Detonate() fpart.NewFW x,y,pSpd,pNum,pShape,pSiz,pr,pg,pb,pGrav!,pLIf fwLIST.remove(Self);Parts:-1 End Method Function orks() If KeyHit(KEY_W) Then firew.orkNew For Local fw:firew=EachIn fwLIST fw.Update Next fpart.FWparts End Function Function orkNew() Local fw:firew=New firew fw.x=Rand(0,GW) fw.y=GH+FWy[Fp] fw.tx=MouseX();fw.ty=MouseY() fw.ang=Point(fw.x,fw.y,MouseX(),MouseY()) fw.spd=FWlaunch[Fp] fw.pShape=FWpartShape[Fp] fw.pr=Fr[Fp];fw.pg=Fg[Fp];fw.pb=Fb[Fp] fw.pNum=FWnumparts[Fp] fw.pSpd=FWpvel[Fp] fw.pSiz=FWpartSize[Fp] fw.pGrav=FWgrav[Fp] fw.pLif=FWpartLife[Fp] fwLIST.AddLast fw;Parts:+1 End Function End Type Global fpLIST:Tlist=CreateList() Type fpart Field x!,y!,ang#,vel#,grav!,shape,size,r,g,b,life,lived=0 Method Update() Local lx=x,ly=y x:+Cos(ang)*vel;y:+Sin(ang)*vel y=y+grav SetAlpha 1;SetScale 1,1;SetRotation 0;SetColor r,g,b;SetLineWidth 1 Select shape Case 0 Plot x,y Case 1 DrawOval x-size/2,y-size/2,size,size Case 2 DrawRect x-size/2,y-size/2,size,size Case 3 SetLineWidth size;DrawLine x,y,lx,ly End Select lived:+1 r:-(lived*255/life);g:-(lived*255/life);b:-(lived*255/life) If lived>life Then fpLIST.remove(Self);Parts:-1 End Method Function FWparts() For Local fp:fpart=EachIn fpLIST fp.Update Next End Function Function NewFW(x#,y#,vel#,num,shape,siz,r,g,b,grav!,life) For Local np=1 To num Local fp:fpart=New fpart fp.x=x;fp.y=y fp.r=r;fp.g=g;fp.b=b fp.shape=shape;fp.size=siz fp.ang=360/num*np fp.vel=vel fp.grav=grav fp.life=life fpLIST.AddLast fp;Parts:+1 Next End Function End Type Global Menu Global Mpos Global KL,KR Global Msec$="Fire" Repeat Cls SetColor 255,255,255;SetAlpha 1;SetScale 1,1 Plot MouseX(),MouseY() smoke.Update flame.s_Update firew.orks rain.fall sonic.booms_Update 'draw the AWESOME hud created by none other than me =D SetAlpha 1;SetScale 0.9,1;SetRotation 0;SetLineWidth 1;SetColor 255,255,255 DrawText "Total particles: "+Parts,5,5 If KeyHit(KEY_M) Then Menu=Abs(Menu-1);FlushKeys() If Mpos<0 Then Mpos=0 If Menu SetAlpha 0.5;SetScale 1,1;SetRotation 0;SetLineWidth 1;SetColor 255,255,255 DrawRect 16,46,300,420 SetAlpha 0.9 DrawLine 16,46,16,466;DrawLine 16,466,316,466;DrawLine 316,466,316,46;DrawLine 316,46,16,46 SetScale 0.9,1 If KeyHit(KEY_UP) Then Mpos=Mpos-1 ElseIf KeyHit(KEY_DOWN) Then Mpos=Mpos+1 SetLineWidth(1) DrawLine 16,46+15*(Mpos+1),348,46+15*(Mpos+1) KL=0;KR=0;If KeyHit(KEY_LEFT) Then KL=True ElseIf KeyHit(KEY_RIGHT) Then KR=True Text 20,50,"Currently editing: "+Msec Select Msec Case "Fire" If Mpos=0 Then If KR Then Msec="Sonic Booms" If FireOn Text 20,65,"Fire ON" Else text 20,65,"Fire OFF" If Mpos=1 Then If KL FireOn=0 ElseIf KR FireOn=1 EndIf Text 20,80,"Fire density: "+flamesPerMouse If Mpos=2 Then If KL And flamesPerMouse>5 Then flamesPerMouse:-5 If KR Then flamesPerMouse:+5 EndIf If FireUp=>0 Then Text 20,95,"Gravity: "+Left(String(FireUp),3) Else Text 20,95,"Gravity: "+Left(String(FireUp),4) If Mpos=3 Then If KL Then FireUp:-0.1 If KR Then FireUp:+0.1 EndIf Case "Sonic Booms" If Mpos=0 Then If KL Then Msec="Fire" ElseIf KR Then Msec="Smoke" EndIf Text 20,65,"Make sonic boom" If Mpos=1 Then If KL Or KR Or KeyHit(KEY_ENTER) Then sonic.Boom_Make(MouseX(),MouseY()) EndIf Text 20,80,"Size: "+sbExist If Mpos=2 Then If KL And sbExist>10 Then sbExist:-10 If KR Then sbExist:+10 EndIf Case "Smoke" If Mpos=0 Then If KL Then Msec="Sonic Booms" ElseIf KR Then Msec="Rain" EndIf If Smokes Text 20,65,"Smoke ON" Else text 20,65,"Smoke OFF" If Mpos=1 Then If KL Smokes=0 ElseIf KR Smokes=1 EndIf Text 20,80,"Smoke density: "+numsmoke If Mpos=2 Then If KL And numsmoke>1 Then numsmoke:-1 If KR Then numsmoke:+1 EndIf Text 20,95,"Spawn distance: <"+maxSdist If Mpos=3 Then If KL And maxSdist>1 Then maxSdist:-1 If KR Then maxSdist:+1 EndIf Text 20,110,"Maximum size: >"+Smokesiz If Mpos=4 Then If KL And Smokesiz>Minsmokesiz Then Smokesiz:-1 If KR Then Smokesiz:+1 EndIf Text 20,125,"Minimum size: <"+Minsmokesiz If Mpos=5 Then If KL And Minsmokesiz>1 Then Minsmokesiz:-1 If KR And Minsmokesiz<Smokesiz Then Minsmokesiz:+1 EndIf Text 20,140,"Maximum particle life: >"+Slife If Mpos=6 Then If KL And Slife>minSlife Then Slife:-2 If KR Then Slife:+2 EndIf Text 20,155,"Minimum particle life: <"+minSlife If Mpos=7 Then If KL And minSlife>2 Then minSlife:-2 If KR And minSlife<Slife Then minSlife:+2 EndIf Case "Rain" If Mpos=0 Then If KL Then Msec="Smoke" If KR Then Msec="Fireworks" EndIf If IsItRain Text 20,65,"Rain ON" Else text 20,65,"Rain OFF" If Mpos=1 Then If KL IsItRain=0 ElseIf KR IsItRain=1 EndIf If RainWindVel=>0 Then Text 20,80,"Wind velocity: "+Left(String(RainWindVel),5) Else Text 20,80,"Wind velocity: "+Left(String(RainWindVel),6) If Mpos=2 Then If KL Then RainWindVel:-0.01 If KR Then RainWindVel:+0.01 EndIf If Rgrav=>0 Then Text 20,95,"Gravity: "+Left(String(Rgrav),4) Else Text 20,95,"Gravity: "+Left(String(Rgrav),5) If Mpos=3 Then If KL And Rgrav>0.01 Then Rgrav:-0.01 If KR Then Rgrav:+0.01 EndIf Text 20,110,"Rain density: "+RainFreq If Mpos=4 Then If KL And RainFreq>1 Then RainFreq:-1 If KR Then RainFreq:+1 EndIf Case "Fireworks" If Mpos=0 Then If KL Then Msec="Rain" EndIf Text 20,65,"Shoot firework" If Mpos=1 Then If KL Or KR Or KeyHit(KEY_ENTER) Then firew.orkNew() EndIf Text 20,80,"Current firework: "+Fp If Mpos=2 Then If KL And Fp>1 Then Fp:-1 If KR And Fp<NumFWpresets-1 Then Fp:+1 EndIf Text 20,95,"Particle paremeters" Text 20,110,"Red value: "+Fr[Fp] Text 20,125,"Green value: "+Fg[Fp] Text 20,140,"Blue value: "+Fb[Fp] If Mpos=4 If KL And Fr[Fp]>0 Then Fr[Fp]:-1 If KR And Fr[Fp]<255 Then Fr[Fp]:+1 ElseIf Mpos=5 If KL And Fg[Fp]>0 Then Fg[Fp]:-1 If KR And Fg[Fp]<255 Then Fg[Fp]:+1 ElseIf Mpos=6 If KL And Fb[Fp]>0 Then Fb[Fp]:-1 If KR And Fb[Fp]<255 Then Fb[Fp]:+1 EndIf Text 20,155,"Particle velocity: "+Left(String(FWpvel[Fp]),3) If Mpos=7 Then If KL And FWpvel[Fp]>0.1 Then FWpvel[Fp]:-0.1 If KR Then FWpvel[Fp]:+0.1 EndIf Default End End Select EndIf Flip Until KeyDown(KEY_ESCAPE) End Function Point!(x0,y0,x1,y1) Return (ATan2(x1-x0,y1-y0))*-1+90 End Function Function Text(x#,y#,txt$,centerx=False,centery=False) Local TEXTscalex#,TEXTscaley#,TXTxpos,TXTypos GetScale(TEXTscalex#,TEXTscaley#) If centerx Then TXTxpos=x-TextWidth(txt)*TEXTscalex/2 Else TXTxpos=x EndIf If centery Then TXTypos=y-TextHeight(txt)*TEXTscaley/2 Else TXTypos=y EndIf DrawText txt,TXTxpos,TXTypos Return True End Function Function Polygon(x#,y#,w#,h#,s%,ang#=0) Local dop,lin If s>360 Then s=360 s=s-1;w=w/2;h=h/2 For dop=0 To s B3DM_xp[dop]=x+w*(Cos((360/(s+1)*dop)+ang)) B3DM_yp[dop]=y+h*(Sin((360/(s+1)*dop)+ang)) Next For lin=0 To s p2=lin+1;If p2>s Then p2=0 DrawLine B3DM_xp[lin],B3DM_yp[lin],B3DM_xp[p2],B3DM_yp[p2] Next End Function Function Distance#(x0,y0,x1,y1) Return Sqr((x1-x0)^2+(y1-y0)^2) End Function Function RectsOverlap (x0, y0, w0, h0, x2, y2, w2, h2) If x0 > (x2 + w2) Or (x0 + w0) < x2 Then Return False If y0 > (y2 + h2) Or (y0 + h0) < y2 Then Return False Return True End Function