New Years Eve 2020 - Firework Particle Animation - Source Code Music: https://BenSound.com
[pbcode]
; PROJECT : New Years eve Anim 2020 Edition
; AUTHOR :
; CREATED : 31/12/2019
; EDITED : 31/12/2019
; ---------------------------------------------------------------------
destpath$="C:\_NYE-ANIMATION-2020\"
openscreen 1280,720,32,1
#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)
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
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)*4
; 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,5.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.0020
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.03
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
RenderToIMage OldSurface
EndPsub ThisImage
Psub MakeBall()
Size=32
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#*20)
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
message$="Happy New Year 2020"
ShadedText(Screen,GetSCreenHeight()*0.41,Message$)
FadeTime=150
; FadeScreen(-1,FadeTime,CurrentFrame)
; FadeScreen(MaxFramesInDemo-FadeTime,MaxFramesInDemo,CurrentFrame,1)
rendertoimage OldSurface
setfont OldFONT
EndFUnction
Function ShadedText(Screen,Ypos,Message$)
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=$90
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
Rgb1=rgb(20,70,170)
Rgb2=rgb(220,230,230)
Rows=GetTextHeight("|")
For lp =0 to Rows
scaler#=float(lp)/Rows
scaler#*= cos(WobbleAngle#)+0.5
ThisRGB=RgbAlphaBlend(Rgb1,RGB2,Scaler#*100) and $00ffffff
ink $f0000000 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]