PureBasic Forums - English

Posted: **Fri Aug 14, 2009 3:09 pm**

I was looking forward to test it since the speed of the plot command has increased, but there is something weird happening with some of the particles (some appear in the left upper corner).

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

Posted: **Fri Aug 14, 2009 6:44 pm**

your code use CallFunctionFast() :

- Changed: Call(C)Function(Fast) parameters have been changed from 'Any' to 'Integer'.

Posted: **Fri Aug 14, 2009 6:47 pm**

According to the changelog:

- Changed: Call(C)Function(Fast) parameters have been changed from 'Any' to 'Integer'.

I made the adjustments to your code, no new lines.

This summarizes the types of changes:

Code: Select all

;changed CallFunctionFast to use pass the address of the float variables (changed lines: 162, 170)
CallFunctionFast(\StepProcedure,\x,\y,\StepArg)
;was replaced with
CallFunctionFast(\StepProcedure,@\x,@\y,\StepArg)


;changed procedures called CallFunctionfast to use pointers to floats as parameters instead of floats (lines changed: 191,194,197,203,215)
Procedure Sparks(x.f,y.f,Arg.l)
;was replaced with
Procedure Sparks(*x.Float,*y.Float,Arg.l)


;changed the calls in those procedures to reflect this (lines changed: 192,195,200,212,230)
ParticleCreate(x,y,Random(100)/100,Random(360),0.02,90,20+Random(5),Arg,#Black)
;was replaced with
ParticleCreate(*x\f,*y\f,Random(100)/100,Random(360),0.02,90,20+Random(5),Arg,#Black)

The good news is that it will not only function the same as it did before it will also run in 4.31 after the changes.

It's awesome code with great particle effects. Now the show can go on.

Here's the updated code:

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.float,*Y.float,Arg.l)
  ParticleCreate(*X\f,*Y\f,Random(100)/100,Random(360),0.02,90,20+Random(5),Arg,#Black)
EndProcedure
Procedure LongSparks(*X.float,*Y.float,Arg.l)
  ParticleCreate(*X\f,*Y\f,Random(20)/100,Random(360),0.04,90,70+Random(5),Arg,#Black)
EndProcedure
Procedure ManySparks(*X.float,*Y.float,Arg.l)
  Protected i.l
  For i=0 To 2
    ParticleCreate(*X\f,*Y\f,Random(100)/100,Random(360),0.06,90,40+Random(5),Arg,#Black)
  Next
EndProcedure
Procedure SmallExp(*X.float,*Y.float,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\f,*Y\f,Random(0)+Random(100)/100,Random(360),0.06,90,Duration+Random(10),Arg,#Black)
  Next
EndProcedure
Procedure BigExp(*X.float,*Y.float,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\f,*Y\f,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

Posted: **Fri Aug 14, 2009 7:21 pm**

Thanks, I'm glad it wasn't a bug

Posted: **Fri Aug 14, 2009 7:27 pm**

Your welcome.

It does highlight changes that would need to be made because of the change to the CallFunction group of commands. So it's a good thing.

Posted: **Fri Aug 14, 2009 7:29 pm**

Better use prototype instead of CallFunctionFast() you will be on the safe way.

Posted: **Fri Aug 14, 2009 7:54 pm**

Fred wrote:Better use prototype instead of CallFunctionFast() you will be on the safe way.

I had overlooked the obvious solution.

For completeness, if you took the original code and made these changes using prototypes instead it would also work.

Code: Select all

;replaced callfunctionFast() by declaring a prototype. (added 1 line at top)
Prototype pf_ParticleAction(x.F,y.F,Arg.l)

;added a variable for prototype use (changed 1 line in Particle Draw)
Protected *Index.l
;was replaced with
Protected *Index.l, action.pf_ParticleAction

;changed CallFunctionFast to use protype (changed 2 lines in ParticleDraw)
CallFunctionFast(\StepProcedure,\x,\y,\StepArg)
;was replaced with
action = \EndingProcedure: action(\x,\y,\EndArg)

Only 4 changes needed using Prototypes vs 12 changes needed using CallFunctionFast().

Fred wins again.

Posted: **Mon Aug 17, 2009 1:53 am**

Fred wrote:Better use prototype instead of CallFunctionFast() you will be on the safe way.

I'll try to do that from now then.
But can someone help me understand why this function was changed? It kinda makes it a pain in the XXX to convert a lot of my old code (for example a FMOD include I have). Why break stuff when we can have both? Would be nice to put in CallFunctionFastClassic() for those of us who depends on the old way it worked

Posted: **Mon Aug 17, 2009 2:08 am**

http://www.purebasic.fr/english/viewtopic.php?t=37491

PureBasic Forums - English

My screensaver doesn't like 4.40 Beta 1... (solved)

My screensaver doesn't like 4.40 Beta 1... (solved)