Graphics 640,480,16,1
SetBuffer BackBuffer()
SeedRnd MilliSecs()
;##############################################################
Global Anz
Type TParticle
   Field x#,y#      ;position
   Field vx#,vy#   ;geschw.
   Field r,g,b      ;color
   Field alter, maxAlter
End Type

Function CreateParticle(x#,y#,vx#,vy#,r,g,b)
   p.TParticle = New TParticle
   p\x=x
   p\y=y
   p\vx=vx
   p\vy=vy
   p\r=r
   p\g=g
   p\b=b
   p\maxAlter=Rand(30,50)
End Function

Function UpdateParticle()
   Anz=0
   For p.TParticle = Each TParticle
      p\alter=p\alter+1
      If p\alter = p\maxAlter Then
         Delete p
      Else
         p\x=p\x+p\vx
         p\y=p\y+(p\vy +  p\alter*0.075)
         p\r=p\r-(255/p\MaxAlter)
      EndIf
      Anz=Anz+1
   Next
End Function

Function RenderParticle()
   For p.TParticle = Each TParticle
      Color p\r,p\g,p\b
      Oval p\x,p\y,p\alter*0.1,p\alter*0.1,1
   Next
End Function

;##############################################################

Type TEmitter
   Field x#,y#   ,vx#,vy#      
   Field alter,maxAlter
End Type

Function UpdateEmitter()
   For p.TEmitter = Each TEmitter
      p\alter=p\alter+1
      If p\alter = p\maxAlter Then
         Delete p
      Else
         p\x=p\x+p\vx
         p\y=p\y+(p\vy)
         For i=0 To 20
            CreateParticle(p\x,p\y,Rand(0,100)*0.04-2,Rand(0,100)*0.04-2,255,0,0)
         Next
      EndIf
   Next
End Function

;##############################################################

While Not KeyHit(1)
   Cls
   If MouseHit(1) Then
      g.TEmitter = New TEmitter
      g\x=MouseX()
      g\y=MouseY()
      g\vx=Rand(0,100)*0.01-0.5
      g\vy=Rand(0,100)*0.01-0.5
      g\maxAlter=Rand(40,60)
   EndIf
   UpdateEmitter()
   UpdateParticle()
   RenderParticle()
   Text 0,0, Anz
   Flip
Wend
End