Particles - Colourful and Silly

[NorbyDroid]

While watching the Coding Train - The Nature of Code, Daniel Shiffman made some particles that would pour out onto the screen. Here is my FreeBasic version that is similiar except I have it in the middle of the screen and coloured. I hope you enjoy this little insanity.

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

[badidea]

Looks good, a few remarks:
- For 'NumPart' I would use a constant so that you cannot accidentally change the value later.
- 'Sleep 5' is not guaranteed to last 5 ms. On many systems this can be 10 or 16 ms. So animation speed varies on different computers.
- I also try to keep non-graphics statements to a minimum between ScreenLock/ScreenUnLock. Which requires 2 sequential loops:

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

Const 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
	Next
	ScreenUnLock

	For p As Integer=1 To NumPart
		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

	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

- It is possible to writer something 'smarter' for this part:

Code: Select all

	... r=Particles(p).Red
	...  g=Particles(p).Green
	...  b=Particles(p).Blue
	...  a=Particles(p).Life
	... RGBA(r,g,b,a) ...

This "Coding Train" has some nice movies. Another good reason to watch some else code.