Attribute VB_Name = "Particle"
Option Explicit

'This is a particle system that use a sliding window to only go thru slots that are likely to have a particle.
'If the particle lifetimes are very different, there will be more gaps in the window that waste space but there is no
'   extra cost for rendering because destroyed Ps don't have an instance allocated in the graphics engine.

Public Const HitAction_None As Integer = 0
Public Const HitAction_Die As Integer = 1
Public Const HitAction_Explode As Integer = 2

Public Const RotationType_None As Integer = 0
Public Const RotationType_FacingCamera As Integer = 1
Public Const RotationType_Velocity As Integer = 2
Public Const RotationType_Random As Integer = 3
Public Const RotationType_FacingCamera_Deep As Integer = 4

Public Type ParticleSpawn
    ParticeTypeIndex As Long
    Count As Long
    VelocityVariation As Single
    VelocityNormalAdder As Single
End Type

Public Type ParticleSpawnList
    Count As Long
    Delay As Single
    Spawns(0 To 3) As ParticleSpawn
End Type

Public Type LightUse
    Active As Boolean
    StartLightColor As Vector3
    EndLightColor As Vector3
    StartLightRadius As Single
    EndLightRadius As Single
End Type

Public Type Particle_Type
    Model As Long
    StartSize As Single
    EndSize As Single
    StartColor As Vector4
    EndColor As Vector4
    Gravity As Vector3
    AirResistance As Single
    LifeTime As Single
    DieUnderWater As Boolean
    HitAction As Integer
    EndSound As Long
    RotationType As Integer
    SpraySpawnL As ParticleSpawnList
    EndSpawnL As ParticleSpawnList
    Light As LightUse
    WaterSplash As Boolean
    GroundSplash As Long
    TerraformRadius As Long
    DamageRadius As Single
    DirectHitDamage As Single
    HitImpulse As Single
End Type

Private Type Particle
    Exist As Boolean
    Properties As Particle_Type
    Age As Single
    SpawnTimer As Single
    Instance As Long
    Position As Vector3
    Velocity As Vector3
    LightSource As Long
    RandomMatrix As Matrix3
    ParentVehicle As Integer
End Type

Dim AllocatedParticleTypes As Long
Dim NumberOfParticleTypes As Long
Dim PTs() As Particle_Type

Dim WindowStart As Long 'The oldest particle in the window
Dim WindowLength As Long 'The number of particle slots in the window
Const MaxParticles As Long = 1024 'The maximum number of particles for saving memory and rendering time
Dim Ps(0 To MaxParticles - 1) As Particle

Public Sub Particle_Init()
    AllocatedParticleTypes = 16
    ReDim PTs(0 To AllocatedParticleTypes - 1)
End Sub

Public Function Particle_CreateParticleType(TypeData As Particle_Type) As Integer
    If NumberOfParticleTypes >= AllocatedParticleTypes Then
        AllocatedParticleTypes = AllocatedParticleTypes * 2
        ReDim Preserve PTs(0 To AllocatedParticleTypes - 1)
    End If
    PTs(NumberOfParticleTypes) = TypeData
    Particle_CreateParticleType = NumberOfParticleTypes
    NumberOfParticleTypes = NumberOfParticleTypes + 1
End Function

Public Sub Particle_Create(InitPos As Vector3, InitVel As Vector3, InitialAge As Single, ParticleTypeIndex As Long, ParentVehicle As Integer)
    Dim NewParticleIndex As Long
    If ParticleTypeIndex < 0 Or ParticleTypeIndex > NumberOfParticleTypes - 1 Then
        MsgBox "Particle_Create: ParticleTypeIndex is out of bound. " & ParticleTypeIndex & " is not in the interval [0.." & (NumberOfParticleTypes - 1) & "]."
        Exit Sub
    End If
    If WindowLength < MaxParticles Then
        NewParticleIndex = (WindowStart + WindowLength) Mod MaxParticles
        Debug.Assert Ps(NewParticleIndex).Exist = False
        Ps(NewParticleIndex).Exist = True
        Ps(NewParticleIndex).Properties = PTs(ParticleTypeIndex)
        If PTs(ParticleTypeIndex).Model <> 0 Then
            Ps(NewParticleIndex).Instance = frmMain.DGE.Instance_Create(PTs(ParticleTypeIndex).Model): RE
        Else
            Ps(NewParticleIndex).Instance = 0
        End If
        Ps(NewParticleIndex).Velocity = InitVel
        Ps(NewParticleIndex).Position = AddVector3(InitPos, MulVector3(InitVel, InitialAge))
        Ps(NewParticleIndex).Age = InitialAge
        Ps(NewParticleIndex).SpawnTimer = 0
        Ps(NewParticleIndex).ParentVehicle = ParentVehicle
        If PTs(ParticleTypeIndex).Light.Active Then
            Ps(NewParticleIndex).LightSource = frmMain.DGE.LightSource_Create_Point_Shadowless(InitPos.X, InitPos.Y, InitPos.Z, 1, 1, 1, 1): RE
        Else
            Ps(NewParticleIndex).LightSource = 0
        End If
        If PTs(ParticleTypeIndex).RotationType = RotationType_Random Then
            Ps(NewParticleIndex).RandomMatrix = MakeAxisSystem_Polar(Rnd * PI * 2, Rnd * PI * 2)
        End If
        WindowLength = WindowLength + 1
    End If
End Sub

Public Sub Particle_Spawn(InitPos As Vector3, InitialAge As Single, SpawnL As ParticleSpawnList, Normal As Vector3, ParentVehicle As Integer)
    Dim S As Long
    Dim I As Long
    For S = 0 To SpawnL.Count - 1
        For I = 1 To SpawnL.Spawns(S).Count
            Particle_Create InitPos, AddVector3(MakeVector3(GaussianRandom * SpawnL.Spawns(S).VelocityVariation, (GaussianRandom * SpawnL.Spawns(S).VelocityVariation), GaussianRandom * SpawnL.Spawns(S).VelocityVariation), MulVector3(Normal, SpawnL.Spawns(S).VelocityNormalAdder)), InitialAge, SpawnL.Spawns(S).ParticeTypeIndex, ParentVehicle
        Next I
    Next S
End Sub

Private Sub DeactivateOldParticles()
    Do Until Ps(WindowStart).Exist Or WindowLength <= 0
        WindowStart = (WindowStart + 1) Mod MaxParticles
        WindowLength = WindowLength - 1
    Loop
End Sub

Private Sub KillParticle(P As Long, Normal As Vector3)
    Particle_Spawn AddVector3(Ps(P).Position, MulVector3(Ps(P).Velocity, Ps(P).SpawnTimer)), 0, Ps(P).Properties.EndSpawnL, Normal, -1
    If Ps(P).Properties.EndSound > 0 Then
        PlaySound_CyclicIndex_3D Ps(P).Properties.EndSound, False, (Rnd * 0.2) + 0.8, (Rnd * 0.2) + 0.8, Ps(P).Position
    End If
    If Ps(P).LightSource <> 0 Then
        frmMain.DGE.LightSource_Delete Ps(P).LightSource: RE
        Ps(P).LightSource = 0
    End If
    If Ps(P).Instance <> 0 Then
        frmMain.DGE.Instance_Delete Ps(P).Instance: RE
        Ps(P).Instance = 0
    End If
    Ps(P).Exist = False
End Sub

Private Sub MoveParticle(P As Long, TimeStep As Single)
    Dim T As Single
    Dim GroundHeight As Single
    Dim SpraySpawnL As ParticleSpawnList
    Dim StartPosition As Vector3
    Dim ExtrapolatedStartPosition As Vector3
    If Ps(P).Exist Then
        'Accelerate
        Ps(P).Velocity = MulVector3(AddVector3(Ps(P).Velocity, MulVector3(Ps(P).Properties.Gravity, TimeStep)), (1 - Ps(P).Properties.AirResistance) ^ TimeStep)
        
        'Remember previous location
        StartPosition = Ps(P).Position
        
        'Extrapolate the start position to catch moving surfaces
        ExtrapolatedStartPosition = AddVector3(StartPosition, MulVector3(SubVector3(StartPosition, Ps(P).Position), Min_Float(1, Ps(P).Age / TimeStep)))
        
        'Move
        Ps(P).Position = AddVector3(Ps(P).Position, MulVector3(Ps(P).Velocity, TimeStep))
        
        'Age
        Ps(P).Age = Ps(P).Age + TimeStep
        
        'Calculate relative age
        T = Ps(P).Age / Ps(P).Properties.LifeTime
        
        'Spawn other particles
        SpraySpawnL = Ps(P).Properties.SpraySpawnL
        If SpraySpawnL.Count > 0 Then
            Ps(P).SpawnTimer = Ps(P).SpawnTimer + TimeStep
            Do Until Ps(P).SpawnTimer < SpraySpawnL.Delay
                Ps(P).SpawnTimer = Ps(P).SpawnTimer - SpraySpawnL.Delay
                Particle_Spawn Ps(P).Position, Ps(P).SpawnTimer, SpraySpawnL, MakeVector3(0, 1, 0), -1
            Loop
        End If
        
        'Collision detection
        Dim Die As Boolean
        Die = False
        If Ps(P).Properties.HitAction <> HitAction_None Then
            'Line intersection with the world
            Dim IR As IntersectionResult
            Dim AdvancedIntersection As Boolean
            AdvancedIntersection = (Ps(P).Properties.HitAction = HitAction_Explode Or Ps(P).Properties.DirectHitDamage > 0)
            IR = LineIntersection(ExtrapolatedStartPosition, Ps(P).Position, True, AdvancedIntersection, AdvancedIntersection, Ps(P).ParentVehicle)
            
            If IR.Collided Then
                'Place the particle at the point of the intersection
                Ps(P).Position = IR.Position
                
                'Cause damage to the item that was hit
                If Ps(P).Properties.DirectHitDamage > 0 Then
                    'This must be done before IR.Index change it's meaning
                    Dim VehicleDirectHitIndex As Integer
                    Select Case IR.Type
                    Case IRT_Item
                        Item_Damage IR.X, IR.Z, IR.Index, Ps(P).Properties.DirectHitDamage
                        VehicleDirectHitIndex = -1
                    Case IRT_Vehicle
                        VehicleDirectHitIndex = IR.Index
                    Case Else
                        VehicleDirectHitIndex = -1
                    End Select
                    Vehicle_Damage VehicleDirectHitIndex, Ps(P).Properties.DirectHitDamage, IR.Position, Ps(P).Properties.DamageRadius, MulVector3(NormalVector3(Ps(P).Velocity), Ps(P).Properties.HitImpulse)
                End If
                
                'Create an explosion
                If Ps(P).Properties.HitAction = HitAction_Explode Then
                    'Don't allow going below the sphere if it was not below before
                    Terrain_Explode Ps(P).Position.X, Ps(P).Position.Y, Ps(P).Position.Z, Ps(P).Properties.TerraformRadius
                    '¤¤¤¤ Create indirect damage to vehicles and apply forces
                End If
                
                Select Case Ps(P).Properties.HitAction
                Case HitAction_Die, HitAction_Explode
                    If Terrain_OnRoad(IR.Position.X, IR.Position.Z) Then
                        'Spray particles from the road
                        '¤¤¤¤
                    Else
                        'Spray particles from the ground
                        If IR.Type = IRT_Ground And IR.Position.Y > Terrain_WaterLevel Then
                            GroundEffect IR.Position, IR.Normal, Ps(P).Properties.GroundSplash
                        End If
                    End If
                    
                    'Destroyed by hitting ground
                    Die = True
                End Select
            End If
        End If
        
        'Splash water
        If Ps(P).Properties.WaterSplash Then
            If StartPosition.Y > Terrain_WaterLevel And Ps(P).Position.Y <= Terrain_WaterLevel Then
                WaterEffect LerpVector3(StartPosition, Ps(P).Position, InverseLerp(StartPosition.Y, Ps(P).Position.Y, Terrain_WaterLevel))
            End If
        End If
        
        'Collide with water
        If Ps(P).Properties.DieUnderWater Then
            If Ps(P).Position.Y < Terrain_WaterLevel - 0.01 Then
                'Destroyed by hitting water
                Die = True
            End If
        End If
        
        'Kill particle
        If Die Then
            KillParticle P, IR.Normal
            Exit Sub
        End If
        
        If T > 1 Then
            'Destroyed by time
            KillParticle P, MakeVector3(0, 0, 0)
            Exit Sub
        End If
    End If
End Sub

'Precondition: Position.y = Terrain_WaterLevel
Private Sub WaterEffect(Position As Vector3)
    'Create a circle on the surface
    Particle_Create AddVector3(Position, MakeVector3(0, 0.01, 0)), MakeVector3(0, 0, 0), 0, ParticleType_WaterCircle, -1
    
    'Splash water
    Particle_Create Position, MakeVector3(GaussianRandom * 3, 5 + GaussianRandom, GaussianRandom * 3), 0, ParticleType_WaterSplash, -1
    
    'Play a 3D splash sound
    PlaySound_CyclicIndex_3D SoundBuffer_Splatt, False, (Rnd * 0.5) + 0.5, (Rnd * 0.2) + 0.8, Position
End Sub

Private Sub GroundEffect(Position As Vector3, Normal As Vector3, Count As Long)
    Dim I As Long
    'Splash dirt
    For I = 1 To Count
        Particle_Create Position, AddVector3(MulVector3(Normal, 5), GaussianRandom3D(4)), 0, ParticleType_DirtSplash, -1
    Next I
End Sub

Private Sub PrepareParticle(P As Long, FacingCameraMatrix As Matrix3)
    Dim T As Single
    Dim Size As Single
    If Ps(P).Exist Then
        T = Ps(P).Age / Ps(P).Properties.LifeTime
        
        'Handle light sources
        If Ps(P).LightSource <> 0 Then
            'Place it
            frmMain.DGE.LightSource_SetPos Ps(P).LightSource, Ps(P).Position.X, Ps(P).Position.Y, Ps(P).Position.Z: RE
            
            'Interpolate light color
            frmMain.DGE.LightSource_SetColor Ps(P).LightSource, _
              Lerp(Ps(P).Properties.Light.StartLightColor.X, Ps(P).Properties.Light.EndLightColor.X, T), _
              Lerp(Ps(P).Properties.Light.StartLightColor.Y, Ps(P).Properties.Light.EndLightColor.Y, T), _
              Lerp(Ps(P).Properties.Light.StartLightColor.Z, Ps(P).Properties.Light.EndLightColor.Z, T): RE
            
            'Interpolate light radius
            frmMain.DGE.LightSource_SetRadius Ps(P).LightSource, Lerp(Ps(P).Properties.Light.StartLightRadius, Ps(P).Properties.Light.EndLightRadius, T): RE
        End If
        
        If Ps(P).Instance <> 0 Then
            'Interpolate size
            Size = Lerp(Ps(P).Properties.StartSize, Ps(P).Properties.EndSize, T)
            
            'Place it
            If Ps(P).Properties.RotationType = RotationType_FacingCamera_Deep Then
                Dim CloserPosition As Vector3
                CloserPosition = SubVector3(Ps(P).Position, MulVector3(FacingCameraMatrix.ZAxis, Size * 0.25))
                frmMain.DGE.Instance_SetPosition Ps(P).Instance, CloserPosition.X, CloserPosition.Y, CloserPosition.Z: RE
            Else
                frmMain.DGE.Instance_SetPosition Ps(P).Instance, Ps(P).Position.X, Ps(P).Position.Y, Ps(P).Position.Z: RE
            End If
            
            'Interpolate color and opacity
            frmMain.DGE.Instance_SetColor Ps(P).Instance, _
              Lerp(Ps(P).Properties.StartColor.X, Ps(P).Properties.EndColor.X, T), _
              Lerp(Ps(P).Properties.StartColor.Y, Ps(P).Properties.EndColor.Y, T), _
              Lerp(Ps(P).Properties.StartColor.Z, Ps(P).Properties.EndColor.Z, T), _
              Lerp(Ps(P).Properties.StartColor.W, Ps(P).Properties.EndColor.W, T): RE
            
            'Rotate
            Select Case Ps(P).Properties.RotationType
            Case RotationType_FacingCamera, RotationType_FacingCamera_Deep
                SetInstanceAxisSystem Ps(P).Instance, MulMatVec3(FacingCameraMatrix, MakeVector3(Size, Size, Size))
            Case RotationType_Velocity
                SetInstanceAxisSystem Ps(P).Instance, MulMatVec3(MakeAxisSystem_Directed(Ps(P).Velocity), MakeVector3(Size, Size, Size))
            Case RotationType_None
                frmMain.DGE.Instance_SetXAxis Ps(P).Instance, Size, 0, 0: RE
                frmMain.DGE.Instance_SetYAxis Ps(P).Instance, 0, Size, 0: RE
                frmMain.DGE.Instance_SetZAxis Ps(P).Instance, 0, 0, Size: RE
            Case RotationType_Random
                SetInstanceAxisSystem Ps(P).Instance, MulMatVec3(Ps(P).RandomMatrix, MakeVector3(Size, Size, Size))
            End Select
        End If
    End If
End Sub

Public Sub Particle_Time(TimeStep As Single)
    Dim I As Long
    If WindowStart + (WindowLength - 1) > MaxParticles - 1 Then
        For I = WindowStart To MaxParticles - 1
            Debug.Assert I >= 0
            Debug.Assert I < MaxParticles
            MoveParticle I, TimeStep
        Next I
        For I = 0 To (WindowStart + (WindowLength - 1)) - MaxParticles
            Debug.Assert I >= 0
            Debug.Assert I < MaxParticles
            MoveParticle I, TimeStep
        Next I
    Else
        For I = WindowStart To WindowStart + (WindowLength - 1)
            Debug.Assert I >= 0
            Debug.Assert I < MaxParticles
            MoveParticle I, TimeStep
        Next I
    End If
    DeactivateOldParticles
    Debug.Assert WindowStart >= 0
    Debug.Assert WindowStart < MaxParticles
    Debug.Assert WindowLength >= 0
    Debug.Assert WindowLength <= MaxParticles
End Sub

Public Sub Particle_PrepareForRender(Camera As Long)
    Dim I As Long
    Dim CameraDir As Vector3
    Dim FacingCameraMatrix As Matrix3
    frmMain.DGE.Camera_GetDirection_OutV3 Camera: RE: CameraDir = GetVector3FromMatrixBuffer
    FacingCameraMatrix = MakeAxisSystem_Directed(CameraDir)
    If WindowStart + (WindowLength - 1) > MaxParticles - 1 Then
        For I = WindowStart To MaxParticles - 1
            Debug.Assert I >= 0
            Debug.Assert I < MaxParticles
            PrepareParticle I, FacingCameraMatrix
        Next I
        For I = 0 To (WindowStart + (WindowLength - 1)) - MaxParticles
            Debug.Assert I >= 0
            Debug.Assert I < MaxParticles
            PrepareParticle I, FacingCameraMatrix
        Next I
    Else
        For I = WindowStart To WindowStart + (WindowLength - 1)
            Debug.Assert I >= 0
            Debug.Assert I < MaxParticles
            PrepareParticle I, FacingCameraMatrix
        Next I
    End If
    Debug.Assert WindowStart >= 0
    Debug.Assert WindowStart < MaxParticles
    Debug.Assert WindowLength >= 0
    Debug.Assert WindowLength <= MaxParticles
End Sub
