Code: Select all
WindowTitle "Vector Experiments"
#Include "fbgfx.bi"
Randomize Timer
Const As Integer wScreen=1280
Const As Integer hScreen=1024
Type pVector
x As Double
y As Double
End Type
Type Particle
pLoc As pVector
pVel As pVector
pAcc As pVector
Red As Integer
Green As Integer
Blue As Integer
Life As Double
End Type
Declare Function NewParticle As Particle
Dim As Integer NumPart=1000
Dim Particles(NumPart) As Particle
For p As Integer=1 To NumPart
Particles(p)=NewParticle
Next
ScreenRes(wScreen,hScreen,32)
While InKey<>Chr(27)
ScreenLock
Line(0,0)-(wScreen-1,hScreen-1),RGB(255,255,255),bf
For p As Integer=1 To NumPart
Dim As Integer r=Particles(p).Red
Dim As Integer g=Particles(p).Green
Dim As Integer b=Particles(p).Blue
Dim As Integer a=Particles(p).Life
Circle(Particles(p).pLoc.x,Particles(p).pLoc.y),6,RGBA(r,g,b,a),,,,F
' Note: Using RGBA to try and have the circle fade but it doesn't work
If Particles(p).Life>0 Then
Particles(p).pVel.x+=Particles(p).pAcc.x
Particles(p).pVel.y+=Particles(p).pAcc.y
Particles(p).pLoc.x+=Particles(p).pVel.x
Particles(p).pLoc.y+=Particles(p).pVel.y
Particles(p).Life-=Abs(Particles(p).pVel.y)
Else
Particles(p)=NewParticle
End If
Next
ScreenUnLock
Sleep 5
Wend
Sleep
Function NewParticle As Particle
Dim As Particle GetParticle
GetParticle.Life=255.0
GetParticle.pAcc.x=0.0
GetParticle.pAcc.y=0.005
GetParticle.pVel.x=3*Rnd-1
GetParticle.pVel.y=3*Rnd-2
GetParticle.pLoc.x=wScreen/2-3
GetParticle.pLoc.y=hScreen/2-3
GetParticle.Red=Int(256*rnd)
GetParticle.Green=Int(256*rnd)
GetParticle.Blue=Int(256*rnd)
NewParticle=GetParticle
End Function