When you run the example you will see the dotted lines which are the tails. The object will be added to the stack but not updated (see Sub Fireworks.Draw()).
How can I get this work?
Code: Select all
'Fireworks alpha coded by UEZ
#Include "fbgfx.bi"
#Include "string.bi"
Using FB
Declare Function RandomRange(fStart As Single, fEnd As Single) As Single
Dim Shared As Integer iDW, iDH, scrw, scrh
Screencontrol GET_DESKTOP_SIZE, iDW, iDH
scrw = iDW * 0.95
scrh = iDH * 0.85
Const iParticles = 500, iParticlesTail = 30, fGravity = 0.3333, fRad = Acos(-1) / 180
Randomize , 2
Type tagParticle
As Single power
As Single x
As Single y
As Single vx
As Single vy
As Ubyte r
As Ubyte g
As Ubyte b
As Ubyte a
End Type
Type Kaboom
Public:
Declare Constructor()
Declare Destructor()
Declare Sub init()
Declare Sub update()
As Boolean detonate, set
As Single rocketx, rockety, rocketvx, rocketvy, radius, life, heigh, power
As tagParticle Particle(iParticles)
As Ubyte r, g, b, a, rr, gg, bb, aa
As Ulong Color
As Ubyte KType
End Type
Constructor Kaboom()
This.Init()
End Constructor
Destructor Kaboom()
End Destructor
Sub Kaboom.init()
This.detonate = False
This.set = False
This.rocketx = scrw / 2 + RandomRange(-scrw / 10, scrw / 10)
This.rockety = scrh
This.rocketvx = Rnd() * 4 - 2
This.rocketvy = -4 - Rnd() * 4
This.heigh = scrh * 0.15 + Rnd() * (scrh * 0.30)
This.life = 255
This.power = 0.99 - Rnd() * 0.03
This.r = &h80 + Rnd() * &h7F
This.g = &h80 + Rnd() * &h7F
This.b = &h80 + Rnd() * &h7F
This.a = &hFF
This.ktype = Cubyte(RandomRange(1, 2))
Dim As Single h, g = 360 / (iParticles - 1), r
For i As Ulong = 0 To iParticles - 1
Select Case This.ktype
Case 1
This.Particle(i).power = 0.5 + Rnd() * 8
This.Particle(i).vx = Cos(h * fRad) * This.Particle(i).power
This.Particle(i).vy = Sin(h * fRad) * This.Particle(i).power
This.Particle(i).r = This.r
This.Particle(i).g = This.g
This.Particle(i).b = This.b
This.Particle(i).a = This.a
Case 2
This.Particle(i).power = 0.5 + Rnd() * 8
This.Particle(i).vx = Cos(h * fRad) * This.Particle(i).power
This.Particle(i).vy = Sin(h * fRad) * This.Particle(i).power
This.Particle(i).r = Rnd() * &hFF
This.Particle(i).g = Rnd() * &hFF
This.Particle(i).b = Rnd() * &hFF
This.Particle(i).a = Rnd() * &hFF
End Select
h += g
Next
End Sub
Sub Kaboom.Update()
If This.rockety > This.heigh Then
This.rocketx += This.rocketvx
This.rockety += This.rocketvy
Else
If This.set = False Then
For i As Ulong = 0 To iParticles - 1
This.Particle(i).x = This.rocketx
This.Particle(i).y = This.rockety
This.set = TRUE
Next
This.detonate = TRUE
End If
For i As Ulong = 0 To iParticles - 1
This.Particle(i).x += This.Particle(i).vx
This.Particle(i).y += This.Particle(i).vy + fGravity
This.Particle(i).vx *= This.power
This.Particle(i).vy *= This.power
This.Particle(i).a = This.life
If This.Particle(i).a < &h80 Then
This.Particle(i).r = &hFF * Rnd()
This.Particle(i).g = &hFF * Rnd()
This.Particle(i).b = &hFF * Rnd()
Endif
Next
This.life -= 1
This.a = This.life * This.power
If This.life = 0 Then This.init()
EndIf
End Sub
'--------------------------------------------------------------------------------------------------
Type tagParticleTail
As Single x
As Single y
As Single vx
As Single vy
As Ubyte r
As Ubyte g
As Ubyte b
As Ubyte a
End Type
Type ParticleTail
Declare Constructor()
Declare Destructor()
Declare Sub Add(x As Single, y As Single)
As tagParticleTail ParticleTail(iParticlesTail - 1)
As Ushort count
As Ushort life
End Type
Constructor ParticleTail()
This.count = 0
End Constructor
Destructor ParticleTail()
End Destructor
Sub ParticleTail.Add(x As Single, y As Single)
For i As Ubyte = 0 To iParticlesTail - 1
ParticleTail(i).x = x
ParticleTail(i).y = y
ParticleTail(i).vx = RandomRange(-4, 4)
ParticleTail(i).vy = Rnd() * 5
ParticleTail(i).r = &h80
ParticleTail(i).g = &h80
ParticleTail(i).b = &h80
ParticleTail(i).a = &hFF
Next
This.life = 50
This.count += 1
End Sub
'--------------------------------------------------------------------------------------------------
Type _Stack
Private:
As ParticleTail aStack(Any)
As Uinteger iPos = 0
Public:
Declare Sub Init()
Declare Sub Push(oPT As ParticleTail)
Declare Function Pop() As ParticleTail
Declare Function Count() As Uinteger
Declare Function Get(iPos As Uinteger) As ParticleTail
End Type
Sub _Stack.Init()
Redim This.aStack(0 To 10000) As ParticleTail
End Sub
Sub _Stack.Push(Byref oPT As ParticleTail)
If This.iPos >= Ubound(This.aStack) Then
Redim Preserve This.aStack(0 To This.iPos + 1000)
End If
This.aStack(iPos) = oPT
This.iPos += 1
End Sub
Function _Stack.Pop() As ParticleTail
If This.iPos > 0 Then This.iPos -= 1
Return This.aStack(This.iPos)
End Function
Function _Stack.Get(iPos As Uinteger) As ParticleTail
If iPos >= 0 And iPos <= Ubound(This.aStack) Then Return This.aStack(iPos)
End Function
Function _Stack.Count() As Uinteger
Return This.iPos
End Function
'--------------------------------------------------------------------------------------------------
Type Fireworks
Declare Constructor(iAmount As Ubyte = 1)
Declare Destructor()
Declare Sub Update()
Declare Sub Draw()
Private:
As Ushort amount
As Kaboom Ptr pBuffer
As ParticleTail Ptr pBuffer2
As Image Ptr Img_Empty, Img_Fireworks, Img_Blur
As _Stack Stack
End Type
Constructor Fireworks(iAmount As Ubyte)
Img_Empty = Imagecreate(scrw, scrh, &hFF000000, 32)
Img_Fireworks = Imagecreate(scrw, scrh, , 32)
This.amount = iAmount
pBuffer = New Kaboom[This.amount]
pBuffer2 = New ParticleTail[1]
Stack.Init()
End Constructor
Destructor Fireworks()
Delete[] pBuffer
Delete[] pBuffer2
pBuffer = 0
pBuffer2 = 0
Imagedestroy This.Img_Empty
Imagedestroy This.Img_Fireworks
End Destructor
Sub Fireworks.Draw()
Put This.Img_Fireworks, (0, 0), This.Img_Empty, Pset
For y As Ushort = 0 To This.amount - 1
Select Case pBuffer[y].detonate
Case False
Circle This.Img_Fireworks, (pBuffer[y].rocketx, pBuffer[y].rockety), 2, Rgba(&hA0, &hA0, &hA0, &hF0),,,,F
pBuffer2[0].Add(pBuffer[y].rocketx, pBuffer[y].rockety)
Stack.Push(pBuffer2[0])
Case Else
For i As Ulong = 0 To iParticles - 1
Circle This.Img_Fireworks, (pBuffer[y].Particle(i).x, pBuffer[y].Particle(i).y), 1, _
Rgba(pBuffer[y].Particle(i).r, pBuffer[y].Particle(i).g, pBuffer[y].Particle(i).b, pBuffer[y].Particle(i).a),,,,F
'Circle This.Img_Fireworks, (pBuffer[y].aParticle(i, 3), pBuffer[y].aParticle(i, 4)), 1, pBuffer[y].r Shl 16 Or pBuffer[y].g Shl 8 Or pBuffer[y].b Or pBuffer[y].a Shl 24,,,,F
Next
End Select
pBuffer[y].update
Next
Dim As ParticleTail oPT
For y As Ulong = 0 To Stack.Count() - 1
oPT = Stack.Get(y)
If oPT.life = 0 Then Stack.pop()
For i As Ubyte = 0 To iParticlesTail - 1
Circle This.Img_Fireworks, (oPT.ParticleTail(i).x, oPT.ParticleTail(i).y), 1, Rgba(oPT.ParticleTail(i).r, oPT.ParticleTail(i).g, oPT.ParticleTail(i).b, oPT.ParticleTail(i).a),,,,F
oPT.ParticleTail(i).x += oPT.ParticleTail(i).vx
oPT.ParticleTail(i).y += oPT.ParticleTail(i).vy + fGravity
oPT.ParticleTail(i).a -= 1
Next
oPT.life -= 1
Next
Put (0, 0), This.Img_Fireworks, Trans
End Sub
'--------------------------------------------------------------------------------------------------
Screenres (scrw, scrh, 32, 1, GFX_ALPHA_PRIMITIVES Or GFX_NO_SWITCH Or GFX_ALWAYS_ON_TOP)
#Ifdef __Fb_win32__
#Include "windows.bi"
Dim tWorkingArea As RECT
SystemParametersInfo(SPI_GETWORKAREA, null, @tWorkingArea, null)
Screencontrol SET_WINDOW_POS, (iDW - scrw) \ 2, ((tWorkingArea.Bottom - scrh) - (iDH - tWorkingArea.Bottom)) \ 2
#Endif
Windowtitle "Simple Fireworks coded by UEZ"
Dim As Fireworks Firework
Dim As Ulong i, iFPS = 0, iFPS_current = 0
Dim As Double fTimer = Timer
Do
Screenlock
Firework.Draw
Draw String(0, 0), iFPS_current & " fps", Rgb(&hFF, &h00, &h00)
Screenunlock
If Timer - fTimer > 0.99 Then
iFPS_current = iFPS
iFPS = 0
fTimer = Timer
Else
iFPS += 1
Endif
Sleep 1
Loop Until Inkey = Chr(27)
'--------------------------------------------------------------------------------------------------
Function RandomRange(fStart As Single, fEnd As Single) As Single
Return Rnd() * (fEnd - fStart) + fStart
End Function