;Steps for the colors
Const FarbSchritte# = 99

;particle type
Type particle
   Field x#,y#
   Field sx#,sy#
   Field ltime#,mltime#
   Field farb.farbe,farb_hex,typ
   Field lw#
End Type

;color type
Type farbe
   Field farb_hex[FarbSchritte]
End Type


;Globals
Global Gravity_X# = 0
Global Gravity_Y# = 0.5
Global PGR_SizeX#,PGR_SizeY#
Global PGR_Buffer
Global P_Count
Global S_x#,S_y#,S_w#,S_h#
Global D_x#,D_y#,D_w#,D_h#
Global P_Farb_Pat.farbe,P_Farb_Hex,P_Typ

;Create normal-color
Global NormalFarbe.Farbe = New Farbe
   For i = 0 To FarbSchritte
      AddFarbInfo(NormalFarbe,i,255 -(i * (255 / FarbSchritte)),255 -(i * (255 / FarbSchritte)),255 -(i * (255 / FarbSchritte)))
   Next
   
P_Farb_Pat = NormalFarbe
   

;InitParticle(Gravity_Y#, Gravity_X#, DrawBuffer)
Function InitParticle(YGrav#=0.5,XGrav#=0,DrawBuffer=0)
   If YGrav <> Gravity_Y Gravity_Y = YGrav
   If XGrav <> Gravity_X Gravity_X = XGrav
   PGR_SizeX = GraphicsWidth()
   PGR_SizeY = GraphicsHeight()
   PGR_Buffer= DrawBuffer
   If PGR_Buffer = 0 PGR_Buffer = BackBuffer()
   SetSeeArea(0,0,PGR_SizeX,PGR_SizeY)
   SetDelArea(0,0,PGR_SizeX,PGR_SizeY)
End Function

;AddParticle(XSTartPosition, YStartPosition, XStartSpeed, YStartSpeed, MaxLifetime, StartLifeTime, Airmoving)
Function AddParticle(xPos#,yPos#,XSpeed#,YSpeed#,Lifetime=100,StartLTime=0,lw#=1)
   p.particle = New particle
   p\x = xPos
   p\y = yPos
   p\sx = XSpeed
   p\sy = YSpeed
   p\ltime = StartLTime
   p\mltime = LifeTime
   p\farb = P_Farb_Pat
   If p\farb = Null
      p\farb_hex = P_Farb_Hex
   EndIf
   p\lw = lw
   p\typ = P_Typ
   P_count = P_count + 1
End Function

;AddFarbe.farbe()
Function AddFarbe.Farbe()
   f.farbe = New Farbe
   Return f
End Function


;AddFarbInfo(color_type.farbe, position[0-Farbschritte],Redcolor,greencolor,bluecolor)
Function AddFarbInfo(f.farbe,stelle,r=255,g=255,b=255)
   If f = Null Return
   If stelle > FarbSchritte Return
   If stelle < 0 Return
   If r < 0 r = 0
   If r > 255 r = 255
   If g < 0 g = 0
   If g > 255 g = 255
   If b < 0 b = 0
   If b > 255 b = 255
   f\farb_hex[stelle] = FarbToHex(r,g,b)
End Function

Function SetParticleColor(F.farbe,FHex=$FFFFFFFF)
   P_Farb_Pat = F
   P_Farb_Hex = FHex
   If P_Farb_Pat = Null P_Typ = 1 Else P_Typ = 0
End Function

Function SetSeeArea(XPos#,YPos#,Width#,Height#)
   If XPos < 1 XPos = 1
   If YPos < 1 YPos = 1
   If Width > PGR_SizeX-1 Width = PGR_SizeX-1
   If Height> PGR_SizeY-1 Height= PGR_SizeY-1
   S_x = XPos
   S_y = YPos
   S_w = Width
   S_h = Height
End Function

Function SetDelArea(XPos#,YPos#,Width#,Height#)
   D_x = XPos
   D_y = YPos
   D_w = Width
   D_h = Height
End Function

;UpdateParticles(LoopSpeed, XScroll#, YScroll#)
Function UpdateParticles(LoopSpeed#=1,XPos#=0,YPos#=0)
   LockBuffer PGR_Buffer
   For p.particle = Each particle
      p\x = p\x + p\sx  * LoopSpeed
      p\y = p\y + p\sy  * LoopSpeed
      If Gravity_X <> 0 p\sx = p\sx + Gravity_X * p\lw * LoopSpeed
      If Gravity_Y <> 0 p\sy = p\sy + Gravity_Y * p\lw * LoopSpeed
      del = 0
      xx = p\x+XPos
      yy = p\y+YPos
      If xx > S_x And xx < S_x+S_w
         If yy > S_y And yy < S_y+S_h            
            If p\typ = 0
               num = Floor(Float(p\ltime) / Float(p\mltime) * FarbSchritte)   
               WritePixelFast(xx,yy,p\farb\farb_hex[num],PGR_Buffer)
            Else
               WritePixelFast(xx,yy,p\farb_hex,PGR_Buffer)
            EndIf
         EndIf
      EndIf
      If p\x < D_x Or p\x > D_x+D_w p\ltime = p\mltime
      If p\y < D_y Or p\y > D_y+D_h p\ltime = p\mltime
      p\ltime = p\ltime + 1.0*LoopSpeed
      If p\ltime => p\mltime Delete p.particle : P_Count = P_Count - 1
   Next
   UnlockBuffer PGR_Buffer
End Function


Function FarbToHex(r=255,g=255,b=255)
   Return 1*$1000000+r*$10000+g*$100+b
End Function