Guest User

Untitled

a guest
Sep 12th, 2018
209
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. '''''''''''''''''''''''''
  2. 'A General A* Pathfinder'
  3. 'Coded by Curtastic 2007'
  4. 'Coded in Lightning IDE.'
  5. '''''''''''''''''''''''''
  6. 'Strict
  7.  
  8. Type TPathfinder Abstract
  9.     '1 if diaognal movement is allowed. Cutting corners is allowed.
  10.     '0 otherwise.
  11.     Global Diagonals:Int
  12.    
  13.     'The higher this number, the more the path will randomly differ from what is optimum.
  14.     Global Randomity:Float
  15.    
  16.     'Use SetMap() to set these.
  17.     Global MapWidth:Int
  18.     Global MapHeight:Int
  19.     'Map is a float. The closer to 1 the harder it is to move into this tile.
  20.     'All values 1 or greater are considered walls.
  21.     Global Map:Float[, ]
  22.    
  23.     'The amount of steps in the route. (Read only)
  24.     Global Paths:Int
  25.    
  26.     'The resulting path is a 'resliced' route[].
  27.     ' as [x0, y0, x1, y1, x2, y2, x3, y3, ..etc. .. xn,yn]
  28.     ' The size of this array is paths*2.
  29.     Global Route:Int[]
  30.    
  31.     'Private
  32.     Global PathMap:TPath[, ]
  33.     Const Root2:Float = 1.4142
  34.    
  35.    
  36.     Function SetMap(Array:Float[, ], Width:Int, Height:Int)
  37.         Map = Array
  38.         MapWidth = Width
  39.         MapHeight = Height
  40.     EndFunction
  41.    
  42.     'Returns 1 if successful and 0 if unseccessful.
  43.     'Fills the route[] array if successful.
  44.     Function FindPath:Int(StartX:Int, StartY:Int, EndX:Int, EndY:Int)
  45.        
  46.         Assert Not(StartX < 0 Or StartY < 0 Or StartX >= MapWidth Or StartY >= MapHeight), ..
  47.          "Starting point out of bounds: " + StartX + "," + StartY
  48.         Assert Not(EndX < 0 Or EndY < 0 Or EndX >= MapWidth Or EndY >= MapHeight), ..
  49.          "End point out of bounds: " + EndX + "," + EndY
  50.         Assert Map <> Null, ..
  51.          "SetMap() must be called before FindPath"
  52.        
  53.         Paths = 0
  54.        
  55.         'already on target
  56.         If StartX = EndX And StartY = EndY Then Return 1
  57.         'target is a wall.
  58.         If Map[EndX, EndY] >= 1 Then Return 0
  59.        
  60.        
  61.         Local P:TPath
  62.         Local P2:TPath
  63.         Local NewP:TPath
  64.         Local NewX:Int
  65.         Local NewY:Int
  66.         Local Dir:Int
  67.         Local DirMax:Int
  68.         Local Done:Int
  69.         Local PHead:TPath
  70.         Local MapHere:Float
  71.        
  72.         PathMap = New TPath[MapWidth, MapHeight]
  73.        
  74.         'make first path node at start
  75.         P = New TPath
  76.         PHead = P
  77.         P.X = StartX
  78.         P.Y = StartY
  79.         PathMap[StartX, StartY] = P
  80.        
  81.         If Diagonals Then
  82.             DirMax = 7
  83.         Else
  84.             DirMax = 3
  85.         EndIf
  86.        
  87.         Repeat
  88.            
  89.            
  90.            
  91.             For Dir = 0 To DirMax
  92.                
  93.                 'move based on direction
  94.                 Select Dir
  95.                 Case 0; NewX = P.X + 1; NewY = P.Y
  96.                 Case 1; NewX = P.X    ; NewY = P.Y + 1
  97.                 Case 2; NewX = P.X - 1; NewY = P.Y
  98.                 Case 3; NewX = P.X    ; NewY = P.Y - 1
  99.                 Case 4; NewX = P.X + 1; NewY = P.Y + 1
  100.                 Case 5; NewX = P.X - 1; NewY = P.Y + 1
  101.                 Case 6; NewX = P.X - 1; NewY = P.Y - 1
  102.                 Case 7; NewX = P.X + 1; NewY = P.Y - 1
  103.                 EndSelect
  104.                
  105.                 'check if it is ok to make a new path node here.
  106.                 If NewX >= 0 And NewY >= 0 And NewX < MapWidth And NewY < MapHeight Then
  107.                     MapHere = Map[NewX, NewY]
  108.                     If MapHere < 1 Then
  109.                        
  110.                         If Diagonals = 2 And Dir > 3 Then
  111.                             If Map[NewX, P.Y] >= 1 Then Continue
  112.                             If Map[P.X, NewY] >= 1 Then Continue
  113.                         EndIf
  114.                        
  115.                         P2 = PathMap[NewX, NewY]
  116.                        
  117.                         'check if there already is a path here
  118.                         If P2 = Null Then
  119.                            
  120.                             'DrawRect newx*29,newy*29,29,29
  121.                             'Flip
  122.                             'If KeyHit(key_escape) Then End
  123.                            
  124.                             'make new node
  125.                             NewP = New TPath
  126.                             PathMap[NewX, NewY] = NewP
  127.                             NewP.Parent = P
  128.                             NewP.X = NewX
  129.                             NewP.Y = NewY
  130.                            
  131.                             'cost is slightly more for diagnols
  132.                             If Dir < 4 Then
  133.                                 NewP.Cost = P.Cost + .1 + MapHere + Rnd(0, Randomity)
  134.                             Else
  135.                                 NewP.Cost = P.Cost + (.1 + MapHere + Rnd(0, Randomity)) * Root2
  136.                             EndIf
  137.                            
  138.                             'set distance from end
  139.                             If Diagonals Then
  140.                                 NewP.Dist = ((NewX - EndX) * (NewX - EndX) + (NewY - EndY) * (NewY - EndY)) / 240.0
  141.                             Else
  142.                                 NewP.Dist = (Abs(NewX - EndX) + Abs(NewY - EndY)) / 8.0
  143.                             EndIf
  144.                            
  145.                             'insert node at appropriate spot in list
  146.                             P2 = P
  147.                             Repeat
  148.                                 If P2.After = Null Then
  149.                                     P2.After = NewP
  150.                                     Exit
  151.                                 EndIf
  152.                                 If P2.After.Dist + P2.After.Cost > NewP.Dist + NewP.Cost Then
  153.                                     NewP.After = P2.After
  154.                                     P2.After = NewP
  155.                                     Exit
  156.                                 EndIf
  157.                                 P2 = P2.After
  158.                             Forever
  159.                            
  160.                             'check if found end
  161.                             If NewX = EndX And NewY = EndY Then
  162.                                 Done = 1
  163.                                 Exit
  164.                             EndIf
  165.                         Else
  166.                             'overwrite existing path node if this way costs less.
  167.                             If P2.Cost > P.Cost + .1 + MapHere * Root2 + Randomity Then
  168.                                 P2.Parent = P
  169.                                 'cost is slightly more for diagnols
  170.                                 If Dir < 4 Then
  171.                                     P2.Cost = P.Cost + .1 + MapHere + Rnd(0, Randomity)
  172.                                 Else
  173.                                     P2.Cost = P.Cost + (.1 + MapHere + Rnd(0, Randomity)) * Root2
  174.                                 EndIf
  175.                             EndIf
  176.                         EndIf
  177.                     EndIf
  178.                 EndIf
  179.             Next
  180.            
  181.             If Done = 1 Then Exit
  182.            
  183.             P = P.After
  184.             If P = Null Then Exit
  185.            
  186.         Forever
  187.        
  188.        
  189.         If Done Then
  190.             'count how many paths
  191.             P2 = NewP
  192.             Repeat
  193.                 Paths:+ 1
  194.                 P2 = P2.Parent
  195.                 If P2 = Null Then Exit
  196.                 'If KeyDown(key_space) Then DebugStop
  197.  
  198.             Forever
  199.            
  200.             'make route from end to start
  201.             Route = New Int[Paths * 2]
  202.             Local i:Int = 0
  203.             P2 = NewP
  204.             Repeat
  205.                 Route[i] = P2.X
  206.                 i:+ 1
  207.                 Route[i] = P2.Y
  208.                 i:+ 1
  209.                 P2 = P2.Parent
  210.                 If P2 = Null Then Exit
  211.             Forever
  212.         EndIf
  213.        
  214.         'nullify pointers so mem will be deallocated.
  215.         P = PHead
  216.         Repeat
  217.             P.Parent = Null
  218.             P = P.After
  219.             If P = Null Then Exit
  220.         Forever
  221.        
  222.         Return Done
  223.     EndFunction
  224. EndType
  225.  
  226.  
  227. 'Private
  228. Type TPath
  229.     Field X:Int
  230.     Field Y:Int
  231.     Field Parent:TPath
  232.     Field Cost:Float
  233.     Field Dist:Float
  234.     Field After:TPath
  235. EndType
Add Comment
Please, Sign In to add comment