VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "cS2DPathfinding"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'IDEA BY THULINMA

Public S2D As cS2D_i

Dim CyclusCount As Integer
Dim NodeCount As Integer

Private Type NodeType
  x As Integer
  y As Integer
  Points As Single
  Parent As Integer
End Type

Dim Nodes() As NodeType
Dim Field() As Byte

Dim Order As Collection

Dim Npc As cS2DNPC
Dim ReachedGoal As Boolean

Private FinalPoints() As Point
Private CurrentFinalPoint As Integer

Public FinalPointsCount As Integer

Private StartX As Integer, StartY As Integer, GoalX As Integer, GoalY As Integer

Public Sub StartNewSearch(GX As Double, GY As Double, SNpc As cS2DNPC)
  
  Set Npc = SNpc
  
  StartX = Npc.x / Const_TileWidth
  StartY = Npc.y / Const_TileHeight
  GoalX = GX / Const_TileWidth
  GoalY = GY / Const_TileHeight
  
  Set Order = New Collection
  Order.Add 1
  
  ReDim Nodes(MAP.MapWidth * MAP.MapHeight)
  
  NodeCount = 1
  Nodes(1).x = StartX
  Nodes(1).y = StartY
  
  ReDim Field(MAP.MapWidth, MAP.MapHeight)
  
  Do Until ReachedGoal
  SearchPathCyclus
  Loop
  
End Sub

Public Sub SearchPathCyclus()

  Dim A As Integer, b As Integer
  Dim Parent As Integer, Points As Single, Position As Integer
  Dim Item As Variant
  
  Dim Level As cGAMLevel
  Set Level = MAP.Levels(Npc.CurrentLevel)
  Dim Layer As cGAMLayer
  Set Layer = Level.Layers(1)
  
  If Order.Count = 0 Then
'   MsgBox "Goal can't be reached from start position :-("
   ReachedGoal = True
   Exit Sub
  End If
  
  Parent = Order.Item(1)
  Order.Remove 1
  
  'Layer.MapTileX(Nodes(Parent).X, Nodes(Parent).Y) = 16
  
  For A = Nodes(Parent).x - 1 To Nodes(Parent).x + 1
  For b = Nodes(Parent).y - 1 To Nodes(Parent).y + 1
  
   If A >= 0 And A < MAP.MapWidth And b >= 0 And b < MAP.MapHeight And (A <> Nodes(Parent).x Or b <> Nodes(Parent).y) Then
    
    If A = GoalX And b = GoalY Then
    
     CalculatePath Parent
     ReachedGoal = True
     Exit Sub
      
    End If
    
    If Field(A, b) = 0 Then
    If Level.ColInf(A, b) = 0 Then
    If Not (CollideWithLevel(Npc, A * Const_TileWidth, b * Const_TileHeight, Npc.CurrentLevel) And 4) = 4 Then
    
     
     Field(A, b) = 1
      
      Points = 0.2 * CyclusCount + Sqr((A - GoalX) ^ 2 + (b - GoalY) ^ 2)
     'Points = CyclusCount
     
     NodeCount = NodeCount + 1
       
     Nodes(NodeCount).Parent = Parent
     Nodes(NodeCount).x = A
     Nodes(NodeCount).y = b
     Nodes(NodeCount).Points = Points
     
     'Layer.MapTileX(a, b) = 8
     
     Position = 0
     
     For Each Item In Order
      
      Position = Position + 1
      
      If Points < Nodes(Item).Points Then
       
       Order.Add NodeCount, , Position
       GoTo Next_
      
      End If
     
     Next
     
     Order.Add NodeCount
     
    End If
   End If
   End If
   End If
   
Next_:

  Next b
  Next A
   
  CyclusCount = CyclusCount + 1
End Sub

Private Sub CalculatePath(Index As Integer)
  On Error Resume Next
  Dim PathDistandce As Integer
  Dim Last As Integer
  
  Last = Index
  
  Dim Temp() As Point
  
  Do Until Last = 1
   PathDistandce = PathDistandce + 1
   ReDim Preserve Temp(0 To PathDistandce)
   Temp(PathDistandce).x = Nodes(Last).x
   Temp(PathDistandce).y = Nodes(Last).y
   Last = Nodes(Last).Parent
  Loop
  

  ReDim FinalPoints(0 To UBound(Temp))
  
  For i = UBound(Temp) To 1 Step -1
  
  FinalPoints(i).x = Temp(i).x * Const_TileWidth
  FinalPoints(i).y = Temp(i).y * Const_TileHeight
  Next i
  
  FinalPointsCount = UBound(Temp)
  
End Sub

Public Function GetPoint(ID As Integer) As Point

On Error Resume Next

GetPoint.x = FinalPoints(FinalPointsCount - ID).x
GetPoint.y = FinalPoints(FinalPointsCount - ID).y

End Function
