PureBasic Forum

;fireworks by BasicallyPure
;05/24/2011
;PureBasic v4.51 (x86)

If Not InitSprite() Or Not InitKeyboard() : End : EndIf
ExamineDesktops()
ScreenWidth = DesktopWidth(0)
ScreenHeight = DesktopHeight(0)

;{ constant declarations
#Color_Blue = $FF0000
#Color_Red = $0000FF
#Color_Green = $00FF00
#Color_Yellow = $00FFFF
#Color_White = $FFFFFF
#Color_Cyan = $FFFF00
#Color_Pink = $FF00FF
#Color_Black = $000000
;}

Declare.f RandFloat()

;{ variable declarations
Define.l max = 600 ; This sets the size of the ember array
Define.l fuse = 0 ; countdown timer until next burst
Define.l ode = 0 ; index to oldest ember
Define.l youngest = -1 ; index to youngest ember
Define.f drag = 0.91 ; 0 < drag < 1; smaller = more drag
Define.f gravity = 0.1, pow, alfa
Define.f tupi = 2*#PI
Define.l midx = ScreenWidth / 2 ; middle of screen
Define.l devx = midx * 0.75 ; maximum x deviation from center
Define.l nomy = ScreenHeight * 0.45 ; nominal y location
Define.l devy = ScreenHeight * 0.25 ; maximum y deviation from nomy
Define.l a, n, embers, cmix, c1, c2, shape

Dim rm.f(max,3) ;array for erasing previous embers
Dim em.f(max,5) ;this is the ember array
   ;legend for em(n,n) array
     ;em(n,0) = x coordinate of ember
     ;em(n,1) = y coordinate of ember
     ;em(n,2) = x velocity of ember
     ;em(n,3) = y velocity of ember
     ;em(n,4) = color of ember
     ;em(n,5) = lifetime of ember
   ;end legend

Dim color.l(6) ;colors for embers
color(0)= #color_red : color(1)=#Color_Cyan : color(2)=#Color_Pink
color(3)=#Color_White : color(4) = #Color_Green
color(5) = #Color_Yellow : color(6) = #Color_Black
;}

flags.l = #PB_Window_BorderLess
title$ = "press escape to exit"
If Not OpenWindow(1,0,0,ScreenWidth,ScreenHeight,title$,flags) : End : EndIf
If Not OpenWindowedScreen(WindowID(1),0,0,ScreenWidth,ScreenHeight,0,0,0) : End : EndIf

 Repeat ;here is the endless animation loop
   StartDrawing(ScreenOutput())
   ;decide what to do based on the fuse status
   If fuse > 0 ;fuse is still burning so animate the embers
      fuse = fuse -1 ;countdown until next burst
      ;"a" is used to index each ember in array em(a,n)
      a = ode -1 ;start with the oldest ember

      Repeat ;this loop causes heavy cpu usage
         a = a + 1 : If a > max : a = 0 : EndIf ;wrap if needed
         
         ;erase the old version of ember "a"
         FrontColor(#Color_Black)
         LineXY(rm(a,0),rm(a,1),rm(a,2),rm(a,3))
         
         ;age the ember
         em(a,5) = em(a,5) - 1
         If em(a,5) = 0 ;ember burns out
            ;Erase the oldest ember; it doesn't have To be the one that
            ;just burned out; it will be erased eventually. No one will
            ;know the difference. :) Just paint it black.
           
            LineXY(rm(ode,0),rm(ode,1),rm(ode,2),rm(ode,3))
            ode = ode + 1 ;adjust the oldest ember pointer
            If ode > max : ode = 0 : EndIf ;wrap around if needed
         Else ;ember didn't burn out so draw a new version of ember "a"
            FrontColor(color(Int(em(a,4)))) ;set the pen's color
            LineXY(em(a,0),em(a,1),(em(a,0)-em(a,2)),(em(a,1)-em(a,3)))
           
            ;remember how it was drawn so we can erase later
            rm(a,0) = em(a,0) ;remember line x1 coord.
            rm(a,1) = em(a,1) ;remember line y1 coord.
            rm(a,2) = em(a,0)-em(a,2) ;remember line x2 coord.
            rm(a,3) = em(a,1)-em(a,3) ;remember line y2 coord.

            ;move the ember
            em(a,0) = em(a,0) + em(a,2) ;adjust ember x position
            em(a,1) = em(a,1) + em(a,3) ;adjust ember y position
            em(a,2) = em(a,2) * drag ;adjust x speed
            em(a,3) = em(a,3) * drag + gravity ;adjust y speed
         EndIf
      Until a = youngest
     
   Else ;fuse has reached the end so create a new burst
      ;set location for new burst
      x = devx - Random(devx * 2)
      y = Random(devy)

      embers = 50 + Random(100) ;set number of embers

      ;set dispersion force
       pow = embers / 6 ;larger number of embers get more pow

      cmix = Random(100) ;decide color scheme
      c1 = Random(5) : c2 = Random(5) ;choose two random colors
      shape = Random(100) ;chose the type of burst

      a = youngest
      For n = 1 To embers
         a = a + 1 : If a > max : a = 0 : EndIf ;wrap if needed

         em(a,5) = 10 + Random(60) ;set ember lifetime
         em(a,0) = x + midx ;set starting x coordinate for new ember
         em(a,1) = nomy - y ;set starting y coordinate for new ember
         alfa = tupi * RandFloat() ;2 * pi radians in a circle
         ;the initial velocities must be set to determine burst shape
         ;apply the magic formulas
         If shape > 15 ;sphere
            em(a,2) = Sin(alfa) * pow * Sin(RandFloat()*tupi) ;initial x velocity
            em(a,3) = Cos(alfa) * pow * Sin(RandFloat()*tupi) ;initial y velocity
         Else ;ellipse
            em(a,2) = Sin(alfa) * pow + Sin(RandFloat()*tupi) ;initial x velocity
            em(a,3) = Cos(alfa) * pow * 0.25 ;initial y velocity
         EndIf
         ;set color scheme
         If cmix > 75 ;use one color
            em(a,4) = c1
         ElseIf cmix < 65 ;use two colors
            If Random(1)
               em(a,4) = c1
            Else
               em(a,4) = c2
            EndIf
         Else ;use all colors
            em(a,4) = Random(5)
         EndIf
      Next n
      youngest = a ;remember which ember is youngest

      ;start fuse for next burst
      fuse = Random(15) + 25
   EndIf
   StopDrawing()
   FlipBuffers()
   Repeat
      event = WindowEvent()
   Until event = 0
   
   ;control the animation speed
   Delay(60)
   ExamineKeyboard()
Until KeyboardPushed(#PB_Key_Escape)


End

Procedure.f RandFloat()
   ;generate a random number ranging >0 and <1
   number.f = (Random(2147483645)+1) / (2147483647)
   ProcedureReturn number
EndProcedure

;Fireworks.pb by BasicallyPure
;05/24/2011
;updated 5/04/2012
;PureBasic 4.60, 4.61
;Linux users with PB 4.61, set the compiler options library subsystem to 'sdl'.

EnableExplicit

If Not InitSprite() Or Not InitKeyboard() : End : EndIf

ExamineDesktops()
Define ScreenWidth = DesktopWidth(0)
Define ScreenHeight = DesktopHeight(0)

;{ variable assignments
Define   max = 750 ; This sets the size of the ember array
Define   fuse = 0 ; countdown timer until next burst
Define   old = 0 ; index to oldest ember
Define   young = -1 ; index to youngest ember
Define   impulse = 20 ; determines average explosion force
Define.f drag = 0.97 ; 0 < drag < 1; smaller = more drag
Define.f gravity = 0.02
Define   burnTime = 150 ; determines average ember lifetime
Define   fuseTime = 25 ; determines average fuse time
Define.f tupi = 2*#PI, pow, alfa
Define   midx = ScreenWidth / 2 ; middle of screen
Define   devx = midx * 0.75 ; maximum x burst deviation from center
Define   nomy = ScreenHeight * 0.45 ; nominal y burst location
Define   devy = ScreenHeight * 0.25 ; maximum y deviation from nomy
Define   a, n, x, y, emberCount, cmix, c1, c2, shape

Structure emberStats
   x.f      ; x coordinate
   y.f      ; y coordinate
   vx.f     ; x velocity
   vy.f     ; y velocity
   color.i  ; ember color
   life.i   ; lifetime
EndStructure

Dim ember.emberStats(max)

Dim color(5) ; colors for embers
color(0) = $0000FF ; red
color(1) = $FFFF00 ; Cyan
color(2) = $FF00FF ; Pink
color(3) = $FFFFFF ; White
color(4) = $00FF00 ; Green
color(5) = $00FFFF ; Yellow
;}

If Not OpenScreen(ScreenWidth,ScreenHeight,32,"") : End : EndIf

Macro RndFloat
   ; produce a random float number (0 < number < 1)
   ((Random(2147483645)+1) / 2147483647)
EndMacro

SetFrameRate(30)

Repeat ; animation loop
   
   ;check the fuse status
   If fuse > 0 ;fuse is still burning so animate the embers
      fuse - 1 ;countdown until next burst
     
      StartDrawing(ScreenOutput())
      ;"a" is used to index each ember
      a = old - 1 ;start with the oldest ember
     
      Repeat ; update all of the embers
         a + 1 : If a > max : a = 0 : EndIf ; wrap if needed
         
         With ember(a)
            \life - 1 ; age the ember
           
            If \life = 0 ;ember burns out
               old + 1 ;adjust the oldest ember pointer
               If old > max : old = 0 : EndIf ; wrap around if needed
            Else ; ember didn't burn out so draw a new version
               FrontColor(color(\color)) ;set the pen's color
               LineXY(\x, \y, (\x - \vx), (\y - \vy))
               
               ;move the ember
               \x + \vx    ;adjust ember x position
               \y + \vy    ;adjust ember y position
               \vx * drag           ;adjust x speed
               \vy * drag + gravity ;adjust y speed
            EndIf
         EndWith
      Until a = young
     
      StopDrawing() : FlipBuffers() : ClearScreen(0)
     
   Else ; fuse has reached the end so create a new burst
      ; set location for new burst
      x = devx - Random(devx * 2)
      y = Random(devy)
     
      emberCount = 50 + Random(100) ; set number of embers
     
      ;set dispersion force
      pow = emberCount / impulse ; larger number of embers get more pow
     
      cmix = Random(100) ; decide color scheme
      c1 = Random(5) : c2 = Random(5) ; choose two random colors
      While c1 = c2 : c2 = Random(5) : Wend
      shape = Random(100) ; chose the type of burst
     
      a = young
      For n = 1 To emberCount
         a + 1 : If a > max : a = 0 : EndIf ; wrap if needed
         
         With ember(a)
            \life = 20 + Random(burnTime) ; set ember lifetime
            \x = x + midx ; set starting x coordinate for new ember
            \y = nomy - y ; set starting y coordinate for new ember
           
            alfa = tupi * RndFloat ; 2 * pi radians in a circle
           
            ; the initial velocities must be set to determine burst shape
            ; apply the magic formulas
            If shape > 15 ;sphere
               \vx = Sin(alfa) * pow * Sin(RndFloat * tupi) ; initial x velocity
               \vy = Cos(alfa) * pow * Sin(RndFloat * tupi) ; initial y velocity
            Else ; ellipse
               \vx = Sin(alfa) * pow + Sin(RndFloat * tupi) ; initial x velocity
               \vy = Cos(alfa) * pow * 0.25 ; initial y velocity
            EndIf
           
            ; apply color scheme
            If cmix > 75 ; use one color
               \color = c1
            ElseIf cmix < 65 ; use two colors
               If Random(1)
                  \color = c1
               Else
                  \color = c2
               EndIf
            Else ; use all colors
               \color = Random(5)
            EndIf
           
         EndWith
         
      Next n
      young = a ; remember which ember is youngest
     
      ; start fuse for next burst
      fuse = Random(fuseTime) + 25
   EndIf
   
   ExamineKeyboard()
Until KeyboardPushed(#PB_Key_Escape)