fb:porticula NoPaste
Kleines Partikelsystem für Explosionen
Uploader: | DonStevone |
Datum/Zeit: | 18.12.2011 19:09:43 |
#Define PSMaxParticles 5000
#Define PSMaxSpeed 10
#Define PSMaxLifeTime 300
#Define PSMinLifeTime 120
Type Particle
X as Double
Y as Double
LX as Double
LY as Double
XV as Double
YV as Double
Active as Byte
Col as Integer
LifeTime as Integer
End Type
'###############################################################################
Type ParticleSystem
ENumber as Integer
Explosion(0 to 9) as Particle PTR
Declare Constructor()
Declare Destructor()
Declare Sub NewExplosion(XPos as Integer, YPos as Integer)
Declare Sub G()
Declare Sub GClear()
Declare Sub Control()
End Type
'###############################################################################
Constructor ParticleSystem()
Dim a as Integer
For a = 0 to 9
Explosion(a) = Allocate(PSMaxParticles * SizeOf(Particle))
If Explosion(a) = 0 then
Print "[ERROR] Zero pointer exception in Constructor ParticleSystem"
Endif
Next a
Randomize Timer
End Constructor
'###############################################################################
Destructor ParticleSystem()
Dim a as Integer
For a = 0 to 9
Deallocate Explosion(a)
Next a
End Destructor
'###############################################################################
Sub ParticleSystem.NewExplosion(XPos as Integer, YPos as Integer)
Dim a as Integer
Dim Temp as Double
Dim TempRND as Double
For a = 0 to PSMaxParticles - 1
Explosion(ENumber)[a].X = XPos
Explosion(ENumber)[a].Y = YPos
Explosion(ENumber)[a].LX = Explosion(ENumber)[a].X
Explosion(ENumber)[a].LY = Explosion(ENumber)[a].Y
Temp = (RND * PSMaxSpeed) - PSMaxSpeed / 2
If a <= PSMaxParticles / 3 * 2 then TempRND = PSMaxSpeed Else TempRND = RND * PSMaxSpeed
Explosion(ENumber)[a].XV = Sin(Temp) * TempRND
Explosion(ENumber)[a].YV = Cos(Temp) * TempRND
Explosion(ENumber)[a].Active = 1
Explosion(ENumber)[a].Col = RGB((RND * 255) + 1, (RND * 255) + 1, (RND * 255) + 1)
Explosion(ENumber)[a].LifeTime = (RND * PSMaxLifeTime) - PSMinLifeTime
Next a
ENumber += 1
If ENumber > 9 then ENumber = 0
End Sub
'###############################################################################
Sub ParticleSystem.G()
Dim a as Integer
Dim b as Integer
For a = 0 to 9
For b = 0 to PSMaxParticles - 1
'If Explosion(a)[b].Active then PSet(Explosion(a)[b].X, Explosion(a)[b].Y), Explosion(a)[b].Col
If Explosion(a)[b].Active then Circle(Explosion(a)[b].X, Explosion(a)[b].Y), 1, Explosion(a)[b].Col
Next b
Next a
End Sub
'###############################################################################
Sub ParticleSystem.Control()
Dim a as Integer
Dim b as Integer
For a = 0 to 9
For b = 0 to PSMaxParticles - 1
If Explosion(a)[b].Active = 1 then
Explosion(a)[b].LX = Explosion(a)[b].X
Explosion(a)[b].LY = Explosion(a)[b].Y
Explosion(a)[b].X += Explosion(a)[b].XV
Explosion(a)[b].Y += Explosion(a)[b].YV
Explosion(a)[b].LifeTime -= 1
If Explosion(a)[b].LifeTime <= 0 then
Explosion(a)[b].Active = 0
PSet(Explosion(a)[b].LX, Explosion(a)[b].LY), &h000000
Endif
Endif
Next b
Next a
End Sub
'###############################################################################
Screenres 1024, 786, 32
Dim as ParticleSystem PS
Dim as Integer MX, MY, MB
Dim as Byte MLock
While(NOT Multikey(&h01))
GetMouse(MX, MY,, MB)
If MLock = 0 then
If MB = 1 then PS.NewExplosion(MX, MY) : MLock = 1
Endif
If MB = 0 then MLock = 0
PS.Control()
ScreenLock
CLS
PS.G()
ScreenUnlock
Sleep 10
Wend
Sleep 500, 1