Attribute VB_Name = "modCollision"

Option Explicit

Public Function CollideWithLevel(Npc As cS2DNPC, _
                                 ByVal newx As Double, _
                                 ByVal newy As Double, _
                                 ByVal LvlID As Integer) As Double

    If LvlID = 0 Then Exit Function
    If Not TypeOf Map.Levels(LvlID) Is cGAMLevel Then Exit Function

    Dim o        As Long
    
    Dim mapX     As Long, mapY  As Long, mapW     As Long, mapH     As Long

    Dim npcWidth As Long, npcHeight As Long, npcDC As Long, tileDC As Long
    
    Dim x        As Integer, y        As Integer
    
    Dim lvl      As cGAMLevel
    
    Set lvl = Map.Levels(LvlID)
    
    npcWidth = Npc.Width
    npcHeight = Npc.Height
    npcDC = Npc.MyDC
    tileDC = ColTiles.MyDC
    
    mapX = (newx - (newx Mod Const_TileWidth)) / Const_TileWidth
    mapY = (newy - (newy Mod Const_TileHeight)) / Const_TileHeight
    mapW = (npcWidth + (Const_TileWidth - (npcWidth Mod Const_TileWidth))) / Const_TileWidth
    mapH = (npcHeight + (Const_TileHeight - (npcHeight Mod Const_TileHeight))) / Const_TileHeight
    
    If mapX < 0 Then mapX = 0
    If mapY < 0 Then mapY = 0
    If mapX + mapW >= Map.MapWidth Then mapW = Map.MapWidth - mapX
    If mapY + mapH >= Map.MapHeight Then mapH = Map.MapHeight - mapY

    Dim cInf As Integer
    
    For x = mapX To mapX + mapW
        For y = mapY To mapY + mapH
            
            cInf = lvl.ColInf(x, y)
            If ((o And (2 ^ cInf)) = 0) Then If CollisionDetect(newx, newy, npcWidth, npcHeight, 0, 0, npcDC, x * Const_TileWidth, y * Const_TileHeight, Const_TileWidth, Const_TileHeight, lvl.ColTileX(x, y) * Const_TileWidth, lvl.ColTileY(x, y) * Const_TileHeight, tileDC) Then o = o Or (2 ^ cInf)
        Next y
    Next x

    CollideWithLevel = o
End Function

Public Function CollideWithNPC(Npc As cS2DNPC, _
                               X1 As Double, _
                               Y1 As Double, _
                               Z1 As Double, _
                               NPC2 As cS2DNPC) As Boolean
If Npc Is NPC2 Then Exit Function

If Not (Npc.Blocking And NPC2.Blocking) Then Exit Function

If Abs(NPC2.Z + NPC2.ZPlus - Z1) <= NPC2.Depth Then
    CollideWithNPC = CollisionDetect(X1 + 1000, Y1 + 1000, Npc.SourceWidth, Npc.SourceHeight, Npc.SourceX, Npc.SourceY, Npc.MyDC, NPC2.x + 1000, NPC2.y + 1000, NPC2.SourceWidth, NPC2.SourceHeight, NPC2.SourceX, NPC2.SourceY, NPC2.MyDC)
End If

End Function

Public Sub MoveObject(Npc As cS2DNPC, _
                      ByVal newx As Double, _
                      ByVal newy As Double)


    Npc.x = newx
    Npc.y = newy

End Sub

Public Function MoveObjectIfPossible(Npc As cS2DNPC, _
                                     ByVal xdir As Double, _
                                     ByVal ydir As Double) As Integer

    Dim oldx    As Double
    Dim oldy    As Double
    Dim newx    As Double
    Dim newy    As Double
    Dim newX2   As Double
    Dim newY2   As Double
    Dim curlvlz As Long


    If Not Npc.CurrentLevel = 0 Then curlvlz = Map.Levels(Npc.CurrentLevel).Z
    oldx = Npc.x
    oldy = Npc.y
    newx = oldx + xdir
    newy = oldy + ydir
    newX2 = newx
    newY2 = newy
    
  
  
    If (CollideWithLevel(Npc, newx, newy - curlvlz, Npc.CurrentLevel) And 4) = 4 Then
        If (CollideWithLevel(Npc, oldx, newy - curlvlz, Npc.CurrentLevel) And 4) = 0 Then
            newX2 = oldx
            MoveObjectIfPossible = 1
        ElseIf (CollideWithLevel(Npc, newx, oldy - curlvlz, Npc.CurrentLevel) And 4) = 0 Then 'NOT (COLLIDEWITHLEVEL(NPC,...
            newY2 = oldy
            MoveObjectIfPossible = 1
        End If
    End If

  
    Dim i As Integer
    Dim n As cS2DNPC

    For i = 1 To Map.m_NPCs.Count
        Set n = Map.m_NPCs(i)

        'If Distance(npc.x + (npc.Width / 2), npc.y + (npc.Height / 2), n.x + (n.Width / 2), n.y + (n.Height / 2)) < Sqr((npc.Width * npc.Width) * (npc.Height * npc.Height)) Then
        If RectangleCollide(Npc.x, Npc.y, Npc.Width, Npc.Height, n.x, n.y, n.Width, n.Height) Then
            If CollideWithNPC(Npc, newX2, newY2, Npc.Z, n) Then

                If Debug_Collision Then Log "NPC Collision: '" & Npc.Name & "' & '" & n.Name & "'", ltInformation

                Npc.Script.CallFunc "OnTouch"
                n.Script.CallFunc "OnTouch"
    
                MoveObjectIfPossible = 1
    
                If CollideWithNPC(Npc, oldx, newY2, Npc.Z, n) = False Then
                    newX2 = oldx
                ElseIf CollideWithNPC(Npc, newX2, oldy, Npc.Z, n) = False Then
                    newY2 = oldy
                End If
    
                If CollideWithNPC(Npc, newX2, newY2, Npc.Z, n) Then newX2 = oldx: newY2 = oldy
    
            End If
        End If

    Next i


    If CollideWithNPC(Npc, newX2, newY2, Npc.Z, Player) Then newX2 = oldx: newY2 = oldy: MoveObjectIfPossible = 1



    If (CollideWithLevel(Npc, newX2, newY2 - curlvlz, Npc.CurrentLevel) And 4) = 0 Then

        MoveObject Npc, newX2, newY2

    End If

End Function


Function RectangleCollide(X1 As Integer, Y1 As Integer, Width1 As Integer, Height1 As Integer, X2 As Integer, Y2 As Integer, Width2 As Integer, Height2 As Integer) As Boolean

If (X1 >= X2 And X1 <= X2 + Width2) And (Y1 >= Y2 And Y1 <= Y2 + Height2) Then
RectangleCollide = True
Exit Function
End If

If (X1 + Width1 >= X2 And X1 + Width1 <= X2 + Width2) And (Y1 >= Y2 And Y1 <= Y2 + Height2) Then
RectangleCollide = True
Exit Function
End If

If (X1 >= X2 And X1 <= X2 + Width2) And (Y1 + Height1 >= Y2 And Y1 + Height1 <= Y2 + Height2) Then
RectangleCollide = True
Exit Function
End If

If (X1 + Width1 >= X2 And X1 + Width1 <= X2 + Width2) And (Y1 + Height1 >= Y2 And Y1 + Height1 <= Y2 + Height2) Then
RectangleCollide = True
Exit Function
End If

RectangleCollide = False
End Function

Function Distance(X1 As Double, Y1 As Double, X2 As Double, Y2 As Double) As Double
    Distance = Sqr(Abs(X1 - X2) ^ 2 + Abs(Y1 - Y2) ^ 2)
End Function
