Global FindPath
Const xMax = 49
Const yMax = 37
Global tileSize = 16

Global xOrigin,yOrigin ;Ursprungs-Koordinaten
Global xTarget,yTarget ;Zielkoordinaten
Dim map(xMax,yMax) ;1 = offenes Feld, 0 = Hindernis




;Richtungs-Modifikatoren einlesen ... 1-4 = "Himmelsrichtungen", 5-8 = Diagonalen
Dim dirModX(8), dirModY(8)

Restore dir_data
For a = 1 To 8
   Read dirModX(a)
   Read dirModY(a)
Next

.dir_data
Data 0,-1 ;Norden
Data -1,0 ;Westen
Data 1,0 ;Osten
Data 0,1 ;Süden

Data -1,-1 ;NW
Data 1,-1 ;NO
Data 1,1 ;SO
Data -1,1 ;SW





;Mit ganzen Zahlen arbeiten! Floats verlangsamen den Prozess!
Const costStraight = 10, costDiagonal = 14 ;Pfadkosten initialisieren (14 => angenäherte Wurzel aus 2)

Dim checkList(xMax, yMax)
Dim parentX(xMax,yMax), parentY(xMax,yMax)
Dim pathCost(3,xMax,yMax) ;1 = G-Kosten, 2 = H-Kosten, 3 = F-Kosten

Type NODE
   Field X
   Field Y
End Type



;Optional für Darstellung des Pfades:
Const maxPath = 200 ;Anzahl der Nodes, die gespeichert werden für die Darstellung
Dim drawPath_X(maxPath), drawPath_Y(maxPath)













SeedRnd MilliSecs()
Graphics 800,600,16,2
SetBuffer BackBuffer()

;zufällige Map erstellen und zeichnen
For y = 1 To yMax
   For x = 1 To xMax
      map(x,y) = limit(Rand(0,2),0,1) ;2/3-Verhältnis freie Felder zu Hindernissen
      If map(x,y) = 1 Then Rect(x-1)*tileSize,(y-1)*tileSize,tileSize,tileSize,1
   Next
Next

;zufällige Koordiaten wählen
Repeat
   xOrigin = Rand(1,xMax)
   yOrigin = Rand(1,yMax)
   xTarget = Rand(1,xMax)
   yTarget = Rand(1,yMax)
Until map(xOrigin,yOrigin) = 1 And map(xTarget,yTarget) = 1 And (Not (xOrigin = xTarget And yOrigin = yTarget))





FindPath = updatePath(xOrigin,yOrigin,xTarget,yTarget)

Color 255,0,0
If FindPath = True
   recordPath()
   drawPath()
Else
   Text 5,5,"Keinen Pfad gefunden!"
EndIf
Flip
WaitKey()
End









Function updatePath(xO,yO,xT,yT)
   Local PathExist

   ;Parameter jedesmal neu initialisieren, damit die Funktion ggf. wiederholt aufgerufen werden kann.
   Dim checkList(xMax,yMax)
   Dim parentX(xMax,yMax), parentY(xMax,yMax)
   Dim pathCost(3,xMax,yMax)
   Delete Each NODE


   
   xOrigin = xO
   yOrigin = yO
   xTarget = xT
   yTarget = yT
   ;es wird der Weg vom Ziel zum Start gesucht, da der Pfad hinterher rückwärts aufgezeichnet wird!
   ;so hat man dann automatisch die erste PathNode für die Darstellung an erster Stelle stehen!
   addOpenList(xTarget,yTarget,0,0) ;Weg wird rückwärts gesucht!!!
   PathExist = calculatePath()
   
   Return PathExist
End Function






Function calculatePath()
   Local x,y
   Local lowF
   Local lowF_X, lowF_Y
   Local tempG, tempH,tempF
   Local PathFound = False
   Local dir
   Local checkNode
   
      
   ;optionale G-Penalities für bestimmte Felder festlegen
   ;Beispiel: pathCost(1,lavaX,lavaY) = 1000
   Repeat
      ;find Low F
      node.NODE = First NODE
      If node <> Null
         lowF = pathCost(3,node\X,node\Y)
         lowF_X = node\X
         lowF_Y = node\Y   

         For node.NODE = Each NODE
            If pathCost(3,node\X,node\Y) < lowF            
               lowF = pathCost(3,node\X,node\Y)
               lowF_X = node\X
               lowF_Y = node\Y
            EndIf
         Next
      Else
         Return False
         ;optionale Konsequenz aufrufen, wenn kein Pfad gefunden wurde
      EndIf
      
      If checkList(lowF_X,lowF_Y) = 1
   
         addClosedList(lowF_X,lowF_Y)

         For dir = 1 To 8
            x = limit(lowF_X+dirModX(dir),1,xMax)
            y = limit(lowF_Y+dirModY(dir),1,yMax)
            
            If map(x,y) = 1
               ;optionale Bedingungen einfügen, ob das zu untersuchende, angrenzende Feld überhaupt legitim ist
               ;Mauern, Wasser, keine Ecken "abschneiden", etc.):
               checkNode = True
            
               If checkNode = True
                  PathFound = checkAdjacent(x,y,lowF_X,lowF_Y)
                  If PathFound = True Then Return True
               EndIf
            EndIf
         Next
      
      EndIf

   Forever
End Function






Function addOpenList(xx,yy,pX,pY)
   checkList(xx,yy) = 1
   node.NODE = New NODE
   node\X = xx
   node\Y = yy
   parentX(xx,yy) = pX
   parentY(xx,yy) = pY
End Function






Function addClosedList(xx,yy)
   checkList(xx,yy) = -1
   For node.NODE = Each NODE
      If node\X = xx And node\Y = yy
         Delete node
         Return
      EndIf
   Next
End Function






Function checkAdjacent(xx,yy,pX,pY)
   Local nodeCost = costStraight
   If xx <> pX And yy <> pY Then nodeCost = costDiagonal

   If checkList(xx,yy) = 1
      ;checken, ob der Weg zum bereits bekannten Feld über den neuen Pfad kürzer ist.
      checkNewPath(xx,yy,pX,pY)
   EndIf
   If checkList(xx,yy) = 0
      addOpenList(xx,yy,pX,pY)   
      pathCost(1,xx,yy) = pathCost(1,xx,yy) + pathCost(1,pX,pY) + nodeCost
      pathCost(2,xx,yy) = (Abs(xx-xOrigin) + Abs(yy-yOrigin)) * costStraight      ;Ausreichend für eine Approximation.
                                                               ;Genauer wäre eine Distanz-Berechnung mit dem Satz des Pythagoras,
                                                               ;der führt aber zu Fließkommazahlen, die man tunlichst vermeiden sollte!
      pathCost(3,xx,yy) = pathCost(1,xx,yy) + pathCost(2,xx,yy)
   EndIf
   
   If xx = xOrigin And yy = yOrigin Then Return True ;Weg wird rückwärts gesucht (Origin = Enemy)
   
   Return False
End Function






Function checkNewPath(xx,yy,pX,pY)
   Local nodeCost = costStraight
   If xx <> pX And yy <> pY Then nodeCost = costDiagonal

   ;checken, ob der Weg zum bereits bekannten Feld über den neuen Pfad kürzer ist.
   ;Wenn ja, dann Parent-Koordinaten des bekannten Feldes "umleiten".
   
   If (pathCost(1,pX,pY) + nodeCost) < pathCost(1,xx,yy)
      pathCost(1,xx,yy) = pathCost(1,pX,pY) + nodeCost
      pathCost(3,xx,yy) = pathCost(1,xx,yy) + pathCost(2,xx,yy)
      parentX(xx,yy) = pX
      parentY(xx,yy) = pY   
   EndIf
End Function





Function limit(var,min,max)
   If var > max Then Return max
   If var < min Then Return min
   
   Return var
End Function











;Optionale Funktionen für Darstellung des Pfades

Function recordPath()
   Local var
   Local pX_last, pY_last

        ;Variablen für Darstellung jedesmal neu initialisieren (falls Funktion mehrfach aufgerufen wird)
   For var = 1 To maxPath
      drawPath_X(var) = 0
      drawPath_Y(var) = 0
   Next

   drawPath_X(1) = xOrigin
   drawPath_Y(1) = yOrigin
   pX_last = xOrigin
   pY_last = yOrigin
   For var = 2 To maxPath
      drawPath_X(var) = parentX(pX_last,pY_last)
      drawPath_Y(var) = parentY(pX_last,pY_last)
      pX_last = drawPath_X(var)
      pY_last = drawPath_Y(var)
      
      If pX_last = 0 Then Exit
   Next
End Function





Function drawPath()
   Local lastX, lastY
   Local nextNode
   
   nextNode = 2
   lastX = xOrigin
   lastY = yOrigin
   
   Oval (xTarget-1)*tileSize,(yTarget-1)*tileSize,tileSize,tileSize,0
   Oval (xOrigin-1)*tileSize,(yOrigin-1)*tileSize,tileSize,tileSize,0
   
   Repeat
      Line ((lastX-1) * tileSize) + (tileSize/2),((lastY-1) * tileSize) + (tileSize/2),((drawPath_X(nextNode)-1) * tileSize) + (tileSize/2), ((drawPath_Y(nextNode)-1) * tileSize) + (tileSize/2)
      lastX = drawPath_X(nextNode)
      lastY = drawPath_Y(nextNode)
      nextNode = nextNode +1
   Until nextNode = maxPath Or drawPath_X(nextNode) = 0
End Function