New Years Eve / Fireworks Particle Effect (Revision)

Started by kevin, January 01, 2019, 08:25:54 AM

Previous topic - Next topic

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)