This makes me confused, right now I don't even feel like trying to figure out where the "error" is (I got other things I should do). It did work perfectly in the previous version so I guess it might be caused by some bug.
So I leave the code here for anyone to look at so maybe someone can help me figuring out if this is a bug or just a change in the logic.
Code: Select all
EnableExplicit
;- Enumeration
#ScreenWidth = 1024
#ScreenHeight = 768
;#ScreenWidth = 640
;#ScreenHeight = 480
#RAD = 0.0175
;_
;- Structures
Structure Particle
X.f
Y.f
Gravity.f
Duration.f
Color.l
EndColor.l
StepProcedure.l
EndingProcedure.l
StepArg.l
EndArg.l
SpeedX.f
SpeedY.f
GravityX.f
GravityY.f
Step.l
ColorWas.l
GravityForce.f
EndStructure
Structure Rocket
X.f
Y.f
SpeedX.f
SpeedY.f
Direction.f
Timer.l
EndStructure
;_
;- Variables
Global NewList Particle.Particle()
Global NewList Rocket.Rocket()
Define Delay.l, ShowInfo.l, Timer.l, PreviewMode.l
;_
;- Procedures
Procedure.l PreviewCallback(hWnd.l,Message.l,wParam.l,lParam.l)
Select Message
Case #WM_CLOSE
End
EndSelect
ProcedureReturn DefWindowProc_(hWnd.l,Message.l,wParam.l,lParam.l)
EndProcedure
Procedure PreviewWindow()
Protected DisplayHwnd.l, PSize.rect
DisplayHwnd = Val(ProgramParameter(1))
GetClientRect_(DisplayHwnd,@PSize)
If OpenWindow(0,0,0,PSize\right,PSize\bottom,"",#WS_CHILD,DisplayHwnd)
SetWindowCallback(@PreviewCallback())
EndIf
EndProcedure
Procedure ConfigWindow()
Protected Text.s, Delay.l, WindowEvent.l
If OpenWindow(0,0,0,220,195,"Fireworks Config",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)=#False; Or CreateGadgetList(WindowID(0))=#False
ProcedureReturn
EndIf
Frame3DGadget(#PB_Any,5,5,210,60,"Options:")
TextGadget(4,150,43,60,20,"")
TrackBarGadget(0,10,20,200,20,0,50)
CheckBoxGadget(1,20,40,80,20,"Display info")
Text + #CRLF$+"Fireworks Screensaver"+#CRLF$
Text + "v1.0 Beta 3"+#CRLF$+#CRLF$
Text + "Copyright © 2006 Joakim L. Christiansen"+#CRLF$
Text + "All rights reserved."
TextGadget(#PB_Any,5,75,210,90,Text,#PB_Text_Center|#PB_Text_Border)
ButtonGadget(2,5,170,60,20,"Webpage")
ButtonGadget(3,155,170,60,20,"Close")
OpenPreferences("FireworksScr.ini")
Delay = ReadPreferenceLong("Delay",20)
SetGadgetState(1,ReadPreferenceLong("ShowInfo",GetGadgetState(1)))
ClosePreferences()
SetGadgetState(0,Delay)
SetGadgetText(4,"Delay: "+Str(Delay))
Repeat
WindowEvent = WaitWindowEvent()
Select WindowEvent
Case #PB_Event_CloseWindow
Break
Case #PB_Event_Gadget
Select EventGadget()
Case 0 ;Trackbar
Delay = GetGadgetState(0)
SetGadgetText(4,"Delay: "+Str(Delay))
Case 1 ;Display info
Case 2 ;Webpage
RunProgram("http://www.jlc-software.com")
Case 3 ;Close
Break
EndSelect
EndSelect
ForEver
OpenPreferences("FireworksScr.ini")
WritePreferenceLong("Delay",Delay)
WritePreferenceLong("ShowInfo",GetGadgetState(1))
ClosePreferences()
EndProcedure
Procedure.f atan2f(X.f,Y.f)
!FLD dword[p.v_Y]
!FLD dword[p.v_X]
!FPATAN
ProcedureReturn
EndProcedure
Procedure ParticleCreate(X.f,Y.f,Speed.f,Direction.l,Gravity.f,GravityDirection.l,Duration.l,Color.l,EndColor.l,StepProcedure.l=0,EndingProcedure.l=0,StepArg.l=0,EndArg.l=0)
AddElement(Particle())
With Particle()
\X = X
\Y = Y
\Gravity = Gravity
\Duration = Duration
\Color = Color
\EndColor = EndColor
\ColorWas = Color
\StepProcedure = StepProcedure
\EndingProcedure = EndingProcedure
\StepArg = StepArg
\EndArg = EndArg
\SpeedX + Cos(Direction*#RAD) * Speed
\SpeedY + Sin(Direction*#RAD) * Speed
If Gravity
\GravityX + Cos(GravityDirection*#RAD)
\GravityY + Sin(GravityDirection*#RAD)
EndIf
EndWith
EndProcedure
Procedure ParticleDraw()
Protected *Index.l
ForEach Particle()
With Particle()
\X + \SpeedX
\Y + \SpeedY
If \Gravity
\GravityForce + \Gravity
\X + \GravityX * \GravityForce
\Y + \GravityY * \GravityForce
EndIf
\Color = RGB((Red(\EndColor)-Red(\ColorWas))/\Duration*\Step+Red(\ColorWas), (Green(\EndColor)-Green(\ColorWas))/\Duration*\Step+Green(\ColorWas), (Blue(\EndColor)-Blue(\ColorWas))/\Duration*\Step+Blue(\ColorWas))
If \StepProcedure
*Index = @Particle()
CallFunctionFast(\StepProcedure,\X,\Y,\StepArg)
ChangeCurrentElement(Particle(),*Index)
EndIf
\Step + 1
If \Step > \Duration
If \EndingProcedure
*Index = @Particle()
CallFunctionFast(\EndingProcedure,\X,\Y,\EndArg)
ChangeCurrentElement(Particle(),*Index)
EndIf
DeleteElement(Particle())
ElseIf Not (\X < 0 Or \X > #ScreenWidth-1 Or \Y < 0 Or \Y > #ScreenHeight-1)
Plot(\X,\Y,\Color)
EndIf
EndWith
Next
EndProcedure
Procedure.l GetFPS()
Static Frames.l, Time.l, FPS.l
Frames + 1
If Time < ElapsedMilliseconds()-1000
Time = ElapsedMilliseconds()
FPS = Frames
Frames = 0
EndIf
ProcedureReturn FPS
EndProcedure
Procedure Sparks(X.f,Y.f,Arg.l)
ParticleCreate(X,Y,Random(100)/100,Random(360),0.02,90,20+Random(5),Arg,#Black)
EndProcedure
Procedure LongSparks(X.f,Y.f,Arg.l)
ParticleCreate(X,Y,Random(20)/100,Random(360),0.04,90,70+Random(5),Arg,#Black)
EndProcedure
Procedure ManySparks(X.f,Y.f,Arg.l)
Protected i.l
For i=0 To 2
ParticleCreate(X,Y,Random(100)/100,Random(360),0.06,90,40+Random(5),Arg,#Black)
Next
EndProcedure
Procedure SmallExp(X.f,Y.f,Arg.l)
Protected i.l, Rnd.l = Random(100)
RandomSeed(Arg)
Protected Particles = 2 + Random(8)
Protected Duration.l = 30 + Random(50)
RandomSeed(Rnd) ;Reset
For i=0 To Particles
ParticleCreate(X,Y,Random(0)+Random(100)/100,Random(360),0.06,90,Duration+Random(10),Arg,#Black)
Next
EndProcedure
Procedure BigExp(X.f,Y.f,Arg.l)
;other rnd values here
Protected i.l, Rnd.l = Random(100), EndingProcedure.l, EndArg.l
RandomSeed(Arg)
Protected Particles.l = 2 + Random(8)
Protected StepArg.l = RGB(Random(255),Random(255),Random(255))
Protected Gravity.f = 0.03 + Random(35)/1000
If Random(1)
EndingProcedure = @SmallExp()
EndArg = RGB(Random(255),Random(255),Random(255))
EndIf
RandomSeed(Rnd) ;Reset
For i=0 To Particles
ParticleCreate(X,Y,Random(2)+Random(100)/100,Random(360),Gravity,90,40+Random(50),Arg,#Black,@Sparks(),EndingProcedure,StepArg,EndArg)
Next
EndProcedure
Procedure Explode()
Protected Speed.f,Direction.l,Gravity.f,GravityDirection.l,Duration.l,Color.l,EndColor.l,StepProcedure.l,EndingProcedure.l,StepArg.l,EndArg.l
Protected i.l, Particles.l, Type.l = Random(3), RndGrav.l = Random(2)
Speed = Random(3)
;Direction = Random(360)
Gravity = 0.01 + Random(35)/1000
GravityDirection = 90
Duration = 50 + Random(100)
Color = RGB(Random(255),Random(255),Random(255))
EndColor = #Black
StepProcedure = @Sparks()
EndingProcedure = @SmallExp()
StepArg = RGB(Random(255),Random(255),Random(255))
EndArg = RGB(Random(255),Random(255),Random(255))
Particles = 70+Random(50)
If RndGrav = 0
Gravity = 0.005
EndIf
Select Type
Case 0 ;Big explosions
Duration = 20 + Random(20)
Particles = 7 + Random(3)
StepProcedure = @ManySparks()
EndingProcedure = @BigExp()
Case 1 ;Long sparks
Particles = 35 + Random(10)
StepProcedure = @LongSparks()
EndSelect
For i=0 To Particles
If RndGrav = 0
GravityDirection = Random(360)
EndIf
ParticleCreate(Rocket()\X,Rocket()\Y,Random(Speed)+Random(100)/100,Random(360),Gravity,GravityDirection,Duration+Random(30),Color,EndColor,StepProcedure,EndingProcedure,StepArg,EndArg)
Next
EndProcedure
;_
;- Setup
Select Left(ProgramParameter(0),2)
Case "/p" ;Preview
PreviewWindow()
PreviewMode = #True
Case "/c" ;Config
ConfigWindow()
End
EndSelect
OpenPreferences("FireworksScr.ini")
Delay = ReadPreferenceLong("Delay",20)
ShowInfo = ReadPreferenceLong("ShowInfo",#False)
ClosePreferences()
If Not (InitKeyboard() And InitMouse() And InitSprite())
MessageRequester("Warning!","DirectX not found!",#MB_ICONWARNING)
End
Else
If Not PreviewMode
If Not OpenScreen(#ScreenWidth,#ScreenHeight,32,"Fireworks screensaver")
MessageRequester("Warning!","Can't open a "+Str(#ScreenWidth)+"x"+Str(#ScreenHeight)+" 32bit screen!",#MB_ICONWARNING)
End
EndIf
Else
If Not OpenWindowedScreen(WindowID(0),0,0,#ScreenWidth,#ScreenHeight,#True,0,0)
End
EndIf
EndIf
EndIf
LoadFont(0,"CourierNew",8,#PB_Font_Bold)
;_
Repeat
;- Logic
If Timer > 0
Timer - 1
Else
Timer = 40+Random(160)
AddElement(Rocket())
With Rocket()
\X = #ScreenWidth/2
\Y = #ScreenHeight
\Direction = 270+Random(80)-40
\SpeedX + Cos(\Direction*#RAD) * 5
\SpeedY + Sin(\Direction*#RAD) * 5
\Timer = 70 + Random(70)
EndWith
EndIf
ForEach Rocket()
With Rocket()
If \Timer > 0
\X + \SpeedX + Random(2)-1
\Y + \SpeedY
ParticleCreate(\X,\Y,Random(4)/10,Random(360),0.04,90,30+Random(5),#Yellow,#Black)
\Timer - 1
Else
Explode()
DeleteElement(Rocket())
EndIf
EndWith
Next
;_
;- Draw screen
Delay(Delay)
FlipBuffers(0)
ClearScreen(#Black)
StartDrawing(ScreenOutput())
ParticleDraw()
If ShowInfo
DrawingMode(1)
FrontColor(#White)
DrawingFont(FontID(0))
DrawText(0,0,"FPS: "+Str(GetFPS()))
DrawText(0,12,"Particles: "+Str(ListSize(Particle())))
DrawText(0,24,"Delay: "+Str(Delay)+"ms")
EndIf
StopDrawing()
;_
If PreviewMode
If WaitWindowEvent(1) = #PB_Event_CloseWindow
End
EndIf
Continue
EndIf
;- User input
ExamineKeyboard(): ExamineMouse()
If KeyboardReleased(#PB_Key_I)
ShowInfo = ShowInfo!1
ElseIf KeyboardReleased(#PB_Key_Add)
Delay + 1
ElseIf KeyboardReleased(#PB_Key_Subtract)
If Delay > 0
Delay - 1
EndIf
ElseIf MouseDeltaX() Or MouseDeltaY() Or KeyboardReleased(#PB_Key_All)
End
EndIf
;_
ForEver

