Fireworks

Applications, Games, Tools, User libs and useful stuff coded in PureBasic
User avatar
BasicallyPure
Enthusiast
Enthusiast
Posts: 539
Joined: Thu Mar 24, 2011 12:40 am
Location: Iowa, USA

Fireworks

Post by BasicallyPure »

Hello everyone, this is my first post to the forum.
I thought I'd start things off with a 'Bang' so to speak.

A bit about myself, I am a hobby programmer and have returned to programming after a period of many years without writing any code.
For the last couple of years I have been trying to catch up.
Programming has changed (a lot) since my first computing days before Windows was an operating system.

I have been using PureBasic for about three months and am very pleased with it so far.
This forum has been very useful in answering many questions I have had as a beginner.

The program I am posting here is one I wrote in a different Basic and have translated to PureBasic.
Press 'Escape' when you want it to end.

BP

Code: Select all

;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
BasicallyPure
Until you know everything you know nothing, all you have is what you believe.
Kelebrindae
Enthusiast
Enthusiast
Posts: 151
Joined: Tue Apr 01, 2008 3:23 pm

Re: Fireworks

Post by Kelebrindae »

Very nice! :D
(and welcome back to the coding community)
User avatar
FragSax
New User
New User
Posts: 9
Joined: Tue May 24, 2011 11:58 pm

Re: Fireworks

Post by FragSax »

Nice little program you've written up there, very nice!
PureBasic 4.51 User
c4s
Addict
Addict
Posts: 1981
Joined: Thu Nov 01, 2007 5:37 pm
Location: Germany

Re: Fireworks

Post by c4s »

Nice looking result!

If you want to step a little further you could try to eliminate the arrays and put the particles into a linkedlist with structure.
If any of you native English speakers have any suggestions for the above text, please let me know (via PM). Thanks!
User avatar
djes
Addict
Addict
Posts: 1806
Joined: Sat Feb 19, 2005 2:46 pm
Location: Pas-de-Calais, France

Re: Fireworks

Post by djes »

Welcome ! Very nice code, and realistic :)
User avatar
Kukulkan
Addict
Addict
Posts: 1396
Joined: Mon Jun 06, 2005 2:35 pm
Location: germany
Contact:

Re: Fireworks

Post by Kukulkan »

Very nice. :D

But with SetFrameRate(30) and Delay(1), instead of Delay(60), it is much more smooth.

Kukulkan
akee
Enthusiast
Enthusiast
Posts: 496
Joined: Wed Aug 18, 2004 9:52 am
Location: Penang, Malaysia

Re: Fireworks

Post by akee »

Nice Bang... I love it... Thanks.
User avatar
BasicallyPure
Enthusiast
Enthusiast
Posts: 539
Joined: Thu Mar 24, 2011 12:40 am
Location: Iowa, USA

Re: Fireworks

Post by BasicallyPure »

Thank you everyone for your replies to my posting.
c4s wrote:If you want to step a little further you could try to eliminate the arrays and put the particles into a linkedlist with structure.
That sounds like an excellent suggestion, unfortunately I don't know how to use linkedlists or structures yet.
I've learned a lot so far, but there is still a lot I don't know.
I presume that linkedlists and structures would make the coding easier and/or make it run faster.
Kukulkan wrote:But with SetFrameRate(30) and Delay(1), instead of Delay(60), it is much more smooth.
I tried your suggestion by placing SetFrameRate(30) on a line above Delay(1) and it seems the animation is way too fast.
I may not be using it correctly because it didn't seem to matter if I used a frame rate of 1 or 30, the speed was the same.
Only by increasing 'Delay()" could I slow the animation to a reasonable speed.

BP
BasicallyPure
Until you know everything you know nothing, all you have is what you believe.
User avatar
Kukulkan
Addict
Addict
Posts: 1396
Joined: Mon Jun 06, 2005 2:35 pm
Location: germany
Contact:

Re: Fireworks

Post by Kukulkan »

Using SetFrameRate(60) limits the speed to display a maximum of 60 frames per second. This is a good value (or 30), as most TFT's running this frequency. If your movement is to fast on 60 FPS, you better adopt your movement vectors (drag? gravity?) to fit to 60FPS. If someone uses a faster computer, he will get a maximum of 60 FPS, too. Upont his, the speed is the same for all (theoretically).

Kukulkan
xperience2003
Enthusiast
Enthusiast
Posts: 113
Joined: Tue Oct 05, 2004 9:05 pm
Location: germany
Contact:

Re: Fireworks

Post by xperience2003 »

rulez!
User avatar
BasicallyPure
Enthusiast
Enthusiast
Posts: 539
Joined: Thu Mar 24, 2011 12:40 am
Location: Iowa, USA

Re: Fireworks

Post by BasicallyPure »

It's been nearly a year since I made my first post here so I decided to revisit this one.
I have rewritten my original code using what I have learned since.

I discovered that the original code was somewhat 'twitchy' when run under Linux.
My new code seems to run fine on both Windows and Linux.
Probably good for Mac as well, but I can't test.

I'm not going to list all of the changes I made, I'll just post the code.

Code: Select all

;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)
Last edited by BasicallyPure on Sun Jun 10, 2012 5:20 pm, edited 3 times in total.
BasicallyPure
Until you know everything you know nothing, all you have is what you believe.
yrreti
Enthusiast
Enthusiast
Posts: 546
Joined: Tue Oct 31, 2006 4:34 am

Re: Fireworks

Post by yrreti »

Nice job BasicallyPure

I like this one much better than the first one, as it's much more realistic.
Thanks for sharing.
User avatar
Shardik
Addict
Addict
Posts: 2058
Joined: Thu Apr 21, 2005 2:38 pm
Location: Germany

Re: Fireworks

Post by Shardik »

BasicallyPure wrote:Probably good for Mac as well, but I can't test.
Thank you, works nice on MacOS X 10.6.8 (Snow Leopard) :wink:
Skipsy
User
User
Posts: 98
Joined: Wed Apr 30, 2003 12:26 pm
Location: France

Re: Fireworks

Post by Skipsy »

Very nice !!
Faster than the 1st version.
WW
Beware of the man who has the solution before he understands the problem...
User avatar
BasicallyPure
Enthusiast
Enthusiast
Posts: 539
Joined: Thu Mar 24, 2011 12:40 am
Location: Iowa, USA

Re: Fireworks

Post by BasicallyPure »

Skipsy wrote:Very nice !!
Faster than the 1st version.
Thanks,
After using PureBasic for a year then looking over the code I saw several
opportunities for improvement.

B.P.
BasicallyPure
Until you know everything you know nothing, all you have is what you believe.
Post Reply