New Years Eve 2021 - Firework Particle Animation - Source Code [pbcode]
// Path to write the frames into.. uncomment the SaveBitmap statement bellow to actually save the anim.
destpath$="G:\Video-Editing\2020-12-31 - New Years Eve Animation\Anim\"
randomize 1510982349
#print timer()-(30*1000)
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 = 600
GLOBAL Temps = 0
//Types
TYPE FeuArtifice
SpriteIndex
x#
y#
z#
vy#
xd#
yd#
zd#
size#
ENDTYPE
DIM Pouf AS FeuArtifice LIST
Dim ImageUsageCounters($ffff)
Dim ParticlesImages(1)
ParticleImage=MakeBall()
ParticlesImages(0) = ParticleImage
ParticlesImages(1) = LoadNewAFXimage("logos\2020-128by128.png")
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()
inkmode 1+64
imageviewport getsurface(),0,0,getSurfacewidth(),GetSurfaceHeight()
boxc 0,0,getSurfacewidth(),GetSurfaceHeight(),true,$080808 ;rgbalphamult(ThisRGB,$2f2f2f)
inkmode 1
// PushParticles(parax#,paraz#)
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,$F8f0e0)
; BlitImageAlpha50Colour(Screen,0,0,$010101)
setcursor 0,0
;
SYNC
UNTIL ESCKEY() = 1 or Spacekey()=1
end
psub PushParticles(OriginX,OriginY)
t=timer()
FOR EACH Pouf()
X=pouf.x
y=pouf.z
Dist#=GetDistance2d(x,y,originX,originY)
angle#=GetAngle2d(originX,originY,x,y)+180
// vx#=OriginX-X
// vy#=OriginY-y
speed#=20-(Dist#/100 )
pouf.x += cos(Angle#)*Speed#
pouf.z += sin(Angle#)*Speed#
NEXT
EndPsub
Psub KillParticle()
ThisSprite=Pouf.SpriteIndex
if ThisSprite
ThisImage=GetSpriteImage(THisSprite)
COunt=ImageUsageCounters(ThisIMage)-1
if Count<1
DeleteImage ThisImage
Count=0
endif
ImageUsageCounters(ThisIMage)=Count
DELETESPRITE ThisSprite
Pouf = null
endif
EndPsub
//Sub & Functions
PSUB NewFeu(x#,y#,z#,ThisIMage,ThisRGB)
; Allocate new list element
Pouf = NEW FeuArtifice
; assign the size of the sprite
Pouf.size# = rnd#(0.20)*3.5
; bump the number of sprites that use this image
ImageUsageCounters(ThisImage)++
; CReate a sprite offset the screen
ThisSprite=NEWSPRITE(-150,-150,ThisIMage)
; init the drawmode
SPRITEDRAWMODE ThisSprite,02+16
;spritemaskcolourcompression ThisSprite,off
; store sprite Id in our list
Pouf.SpriteIndex = ThisSprite
; movement angles + speed
Angle1# = RND#(360)
Angle2# = RND#(360)
Speed# = rndrange#(2.50,6.00)
; Init it's position in 3d space
Pouf.x# = X#
Pouf.y# = Y#
Pouf.z# = Z#
Pouf.xd# = COS(Angle1#) * COS(Angle2#) * Speed#
Pouf.yd# = COS(Angle1#) * SIN(Angle2#) * Speed#
Pouf.zd# = SIN(Angle1#) * Speed#
;Pouf.xd# *= 5.0
;Pouf.yd# *= 5.0
;Pouf.zd# *= 5.0
ENDPSUB
PSUB AfficheFeu()
State =0
Pouf.size# -= 0.002
IF Pouf.size# >0
x# =Pouf.x# + Pouf.xd#
z# =Pouf.z#+ Pouf.zd#
if Z#>0
yd# =Pouf.yd#
y# =Pouf.y#+ yd#
Pouf.x#=x#
Pouf.y#=y#
Pouf.z#=z#
Pouf.yd#=yd#+0.04
z#=500/z#
posY# = (Screen_Height/2) + (y#*z#)
PosX# = (Screen_Width/2) + (x#*z#)
ThisSprite =Pouf.SpriteIndex
SCALESPRITE ThisSprite,Pouf.size#
POSITIONSPRITE ThisSprite,posx#,posy#
State=PosY#<Screen_Height
State|= Range(POsX#,-50,Screen_Width)
endif
endif
ENDPSUB State
Psub PreColourIMage(BallImage,ThisRGB)
oldsurface=getsurface()
w=getimagewidth(BallImage)
h=getimageHeight(BallImage)
ThisImage=NewFxIMage(w,h)
rendertoimage THisIMage
drawimage BallImage,0,0,false
inkmode 1+2048
boxc 0,0,w,h,true,ThisRGB
inkmode 1
for lp=0 to 16
inkmode 1+2048
circlec rnd(w),rnd(h),rndrange(8,64),true,$01f0f0f0
inkmode 1
next
RenderToIMage OldSurface
EndPsub ThisImage
Psub MakeBall()
Size=128
Ball=NewFXImage(Size,Size)
rendertoimage Ball
cls 0
Radius#=Size*0.6
lockbuffer
ThisRGB=point(0,0)
For Ylp=0 to Size-1
For Xlp=0 to Size-1
Dist#=GetDistance2d(Size/2,Size/2,Xlp,Ylp)
if Dist#<Radius#
Dist#=(Radius#-Dist#)/Radius#
Dist#*=90
Dist#=sin(Dist#)
ThisRGB=RgbAlphaBlend(0,-1,Dist#*10)
FastDot Xlp,ylp,THisRGB
endif
next
next
unlockbuffer
rendertoscreen
EndPsub Ball
function Render_Logos(Screen,CurrentFrame,MaxFramesInDemo)
oldfont =getCurrentFont()
oldsurface =GetSurface()
if GetFontStatus(50)=false
LoadFont "Agency FB",50,148,1,8
FontDrawmode 50,1
endif
rendertoimage Screen
setfont 50
if mousebutton()
inkmode 1+16
imageviewport getsurface(),0,0,getSurfacewidth(),GetSurfaceHeight()
boxc 0,0,getSurfacewidth(),GetSurfaceHeight(),true,rndrgb()
inkmode 1
endif
message$="Happy New Year 2021"
FadeLevel#=rnd#(1)
static FadeAngle#, FadeMode, FadeDelay
select FadeMode
case 0
FadeAngle#=0
FadeDelay = 60*4
FadeMode ++
case 1,3
FadeDelay--
if FadeDelay<00
FadeDelay=0
FadeMode ++
Endif
case 2
FadeAngle#=wrapangle(fadeAngle#,0.5)
if FadeAngle#=>90
FadeAngle#=90
FadeMode++
fadeDelay = 60*5
endif
case 4
FadeAngle#=wrapangle(fadeAngle#,-0.5)
if FadeAngle#<1
FadeAngle#=0
FadeMode=0
fadeDelay = 60*4
endif
endselect
#print fadeMode
FadeLevel#=sin(FadeAngle#)
ShadedText(Screen,GetSCreenHeight()*0.41,Message$,fadeLevel#)
FadeTime=150
; FadeScreen(-1,FadeTime,CurrentFrame)
; FadeScreen(MaxFramesInDemo-FadeTime,MaxFramesInDemo,CurrentFrame,1)
rendertoimage OldSurface
setfont OldFONT
EndFUnction
Function ShadedText(Screen,Ypos,Message$, FadeLevel#)
oldSurface =getSurface()
Static WobbleAngle#
Static WobbleAngle2#
rendertoimage screen
screenwidth =GetSurfaceWidth()
screenHeight=GetSurfaceHeight()
imageviewport Screen,0,0,screenWidth,ScreenHeight
TW=GetTextWidth(Message$)
Xpos=(ScreenWidth/2)-(TW/2)
ThisRGB=rgb(50,50,50)
Level = Cliprange( ($90*FadeLevel#) , 0,255)
if level>8
for lp =0 to 2
ink rgbfade(ThisRgB,40) or Argb(Level,0,0,0)
text Xpos,Ypos,Message$
Level+=$16
Xpos+=2
Ypos+=1
next
endif
Rgb1=rgb(20,70,170)
Rgb2=rgb(220,230,250)
Rows=GetTextHeight("|")
Alpha = Cliprange( ($ff*FadeLevel#) , 0,255)
For lp =0 to Rows
scaler#=float(lp)/Rows
scaler#*= cos(WobbleAngle#)+0.5
ThisRGB=RgbAlphaBlend(Rgb1,RGB2,Scaler#*100) and $00ffffff
ink lsl32(Alpha,24) or ThisRGB
Ypos2=Ypos+lp
imageviewport Screen,0,ypos2,ScreenWidth,ypos2+1
OffsetX =Cos(WobbleAngle#+(lp*1))*5
OffsetX +=Sin(WobbleAngle2#-(lp/5))*3
text Xpos+OFFSETX,Ypos,Message$
next
imageviewport Screen,0,0,screenWidth,ScreenHeight
WobbleAngle#=wrapangle(WobbleAngle#,2.5)
WobbleAngle2#=wrapangle(WobbleAngle2#,1.5)
rendertoimage oldSurface
endFunction
Function FadeScreen(StartFrame,EndFrame,CurrentFrame,Direction=0)
Scale#=1
if CurrentFrame>=StartFrame
if CurrentFrame<EndFrame
FramesPast=Currentframe-StartFrame
TotalFrames =EndFrame-StartFrame
if TotalFrames
Scale# =float(framesPast)/TotalFrames
else
Scale#=0
endif
if Direction=0
Scale#=1-Scale#
endif
Scale#=cliprange#(Scale#,0,1)
endif
endif
if Scale#<1.0
oldAlpha#=GetInkAlpha()
oldinkmode=GetInkMode()
inkAlpha Scale#
; inkAlpha 0.5 ;Scale#
inkmode 1+16
boxc 0,0,getSurfacewidth(),GetSurfaceHeight(),true,$000000
inkmode oldInkMode
inkAlpha oldAlpha#
endif
EndFunction
function TEST_MultiPass(Screen,Sprites_DRaw_mode,passes)
Ih=GetImageHeight(Screen)
ChunkHeight=iH/passes
if ChunkHeight*Passes < Ih
Passes++
endif
rendertoimage Screen
ViewPortY1=0
ViewPortY2=ChunkHeight
for pass=0 to Passes -1
ViewPortY1=ChunkHeight*(Pass)
ViewPortY2=ChunkHeight*(Pass+1)
if ViewPortY1 < IH
imageviewport Screen,0,ViewPortY1,GetImageWidth(Screen),ViewPortY2
; Tell PB to render All the Sprites now,
;and ignore their Z depths.
DrawAllSprites
endif
next
rendertoscreen
drawimage Screen,0,0,false
setcursor 0,0
Ink $ff0000
Print "MULTI PASS"
EndFunction
[/pbcode]
Related Links - New Years Eve 2022 - Firework Particle Animation - Source Code (https://www.underwaredesign.com/forums/index.php?topic=4616.0)
- New Years Eve 2020 - Firework Particle Animation - Source Code (https://www.underwaredesign.com/forums/index.php?topic=4513.0)
- New Years Eve / Fireworks Particle Effect (Revision) (https://www.underwaredesign.com/forums/index.php?topic=4464.0)