New Years Eve / Fireworks Particle Effect (Revision)

[kevin]

New Years Eve / Fireworks Particle Effect (Revision)

   This is the second version of the New Years Eve fireworks particle sprite demo.   The first version had clipping bug in it that I didn't notice until I was editing the video and given how long it took to generate the animation, I didn't have time to fix it and start again.  Was hoping to catch New Years Eve almost exactly , but by the time it was uploaded, it was probably 1am..   Oh well...  


Video:

Music By: https://bensound.com



Source Code:

PlayBASIC Code: [Select]

            ; path to dump this as a series of frames
             destpath$="D:\Video-Editing\_Anim_Recording\"


 openscreen 1280,720,32,1

;Setfps 61.7
#include "savebitmap"
#include "blitimage"

//Variables
GLOBAL Speed#
GLOBAL parax#
GLOBAL paray#
GLOBAL paraz#
GLOBAL Angle1#
GLOBAL Angle2#

GLOBAL switch = 0
GLOBAL NbFeu = 500
GLOBAL Temps = 0


//Types

TYPE FeuArtifice
   SpriteIndex
   x#
     y#
     z#
     vy#
     xd#
     yd#
     zd#
     size#
ENDTYPE

DIM Pouf AS FeuArtifice LIST

Dim ImageUsageCounters($ffff)


ParticleImage=MakeBall()

Screen=NewFXIMage(GetScreenWidth(),GetScreenHeight())



Global Screen_Width    = GetScreenWidth()
Global Screen_Height   = GetScreenHeight()




// Boucle principale
REPEAT
   RendertoIMage Screen


;   for pass=1 to 2
      IF Temps   = 0
         parax# = RNDrange(-150,150)
          paray# = RNDRange(-120,60)
          paraz# = RNDRange( 150,400)
   
         IF swith = 0
            Temps = rndrange(10,60)
         ENDIF

         ; pick a colour for this batch      
         ThisRGB=RNDRGB()
         THisImage=PreColourIMage(ParticleImage,ThisRGB)
         
         FOR i = 1 TO NbFeu
               NewFeu(parax#,paray#,paraz#,ThisImage,THisRGB)
         NEXT

      ENDIF
   
      t=timer()
         FOR EACH Pouf()
            if AfficheFeu()=0
                  KillParticle()
            endif
         NEXT
         tt1#+=(timer()-t)
      Temps--


;   next


      t=timer()
         ;DRAWALLSPRITES   
         TEST_MultiPass(Screen,Sprites_DRaw_mode,6)
      tt2#+=(timer()-t)


   rendertoscreen



      if 1=1

         MaxFramesInDemo=60*50
         if CurrentSaveFrame<MaxFramesInDemo
            Render_Logos(Screen,CurrentSaveFrame,MaxFramesInDemo)
            
            if folderexist(DestPath$)
               file$=destpath$+"Frame"+Digits$(CurrentSaveFrame,6)+".bmp"
               ;SaveBitmap file$,Screen
               CurrentSaveFrame++
            endif
         else
               end
         endif
      
      endif
      

   BlitImageAlphaPostMultColour(Screen,0,0,$F0D8D8)
;   BlitImageAlpha50Colour(Screen,0,0,$010101)

   setcursor 0,0
;
   SYNC
   
UNTIL ESCKEY() = 1



   end
   



Psub KillParticle()

      ThisSprite=Pouf.SpriteIndex
      if ThisSprite

            ThisImage=GetSpriteImage(THisSprite)

            COunt=ImageUsageCounters(ThisIMage)-1
            if Count<1
                  DeleteImage ThisImage
                  Count=0
            endif

Login required to view complete source code

Particle Demo Links:


      - New Years Eve 2021 -  Firework   Particle   Animation - Source Code
      - New Years Eve 2020 -  Firework   Particle   Animation - Source Code
      - New Years Eve / Fireworks Particle Effect (Revision)