''''''''''''''''''''''''' 'A General A* Pathfinder' 'Coded by Curtastic 2007' 'Coded in Lightning IDE.' ''''''''''''''''''''''''' SuperStrict Type TPathfinder Abstract '1 if diaognal movement is allowed. Cutting corners is allowed. '0 otherwise. Global Diagonals:Int 'The higher this number, the more the path will randomly differ from what is optimum. Global Randomity:Float 'Use SetMap() to set these. Global MapWidth:Int Global MapHeight:Int 'Map is a float. The closer to 1 the harder it is to move into this tile. 'All values 1 or greater are considered walls. Global Map:Float[, ] 'The amount of steps in the route. (Read only) Global Paths:Int 'The resulting path is a 'resliced' route[]. ' as [x0, y0, x1, y1, x2, y2, x3, y3, ..etc. .. xn,yn] ' The size of this array is paths*2. Global Route:Int[] 'Private Global PathMap:TPath[, ] Const Root2:Float = 1.4142 Function SetMap(Array:Float[, ], Width:Int, Height:Int) Map = Array MapWidth = Width MapHeight = Height EndFunction 'Returns 1 if successful and 0 if unseccessful. 'Fills the route[] array if successful. Function FindPath:Int(StartX:Int, StartY:Int, EndX:Int, EndY:Int) Assert Not(StartX < 0 Or StartY < 0 Or StartX >= MapWidth Or StartY >= MapHeight), .. "Starting point out of bounds: " + StartX + "," + StartY Assert Not(EndX < 0 Or EndY < 0 Or EndX >= MapWidth Or EndY >= MapHeight), .. "End point out of bounds: " + EndX + "," + EndY Assert Map <> Null, .. "SetMap() must be called before FindPath" Paths = 0 'already on target If StartX = EndX And StartY = EndY Then Return 1 'target is a wall. If Map[EndX, EndY] >= 1 Then Return 0 Local P:TPath Local P2:TPath Local NewP:TPath Local NewX:Int Local NewY:Int Local Dir:Int Local DirMax:Int Local Done:Int Local PHead:TPath Local MapHere:Float PathMap = New TPath[MapWidth, MapHeight] 'make first path node at start P = New TPath PHead = P P.X = StartX P.Y = StartY PathMap[StartX, StartY] = P If Diagonals Then DirMax = 7 Else DirMax = 3 EndIf Repeat If KeyDown(key_space) Then DebugStop For Dir = 0 To DirMax 'move based on direction Select Dir Case 0; NewX = P.X + 1; NewY = P.Y Case 1; NewX = P.X ; NewY = P.Y + 1 Case 2; NewX = P.X - 1; NewY = P.Y Case 3; NewX = P.X ; NewY = P.Y - 1 Case 4; NewX = P.X + 1; NewY = P.Y + 1 Case 5; NewX = P.X - 1; NewY = P.Y + 1 Case 6; NewX = P.X - 1; NewY = P.Y - 1 Case 7; NewX = P.X + 1; NewY = P.Y - 1 EndSelect 'check if it is ok to make a new path node here. If NewX >= 0 And NewY >= 0 And NewX < MapWidth And NewY < MapHeight Then MapHere = Map[NewX, NewY] If MapHere < 1 Then If Diagonals = 2 And Dir > 3 Then If Map[NewX, P.Y] >= 1 Then Continue If Map[P.X, NewY] >= 1 Then Continue EndIf P2 = PathMap[NewX, NewY] 'check if there already is a path here If P2 = Null Then 'DrawRect newx*29,newy*29,29,29 'Flip 'If KeyHit(key_escape) Then End 'make new node NewP = New TPath PathMap[NewX, NewY] = NewP NewP.Parent = P NewP.X = NewX NewP.Y = NewY 'cost is slightly more for diagnols If Dir < 4 Then NewP.Cost = P.Cost + .1 + MapHere + Rnd(0, Randomity) Else NewP.Cost = P.Cost + (.1 + MapHere + Rnd(0, Randomity)) * Root2 EndIf 'set distance from end If Diagonals Then NewP.Dist = ((NewX - EndX) * (NewX - EndX) + (NewY - EndY) * (NewY - EndY)) / 240.0 Else NewP.Dist = (Abs(NewX - EndX) + Abs(NewY - EndY)) / 8.0 EndIf 'insert node at appropriate spot in list P2 = P Repeat If P2.After = Null Then P2.After = NewP Exit EndIf If P2.After.Dist + P2.After.Cost > NewP.Dist + NewP.Cost Then NewP.After = P2.After P2.After = NewP Exit EndIf P2 = P2.After Forever 'check if found end If NewX = EndX And NewY = EndY Then Done = 1 Exit EndIf Else 'overwrite existing path node if this way costs less. If P2.Cost > P.Cost + .1 + MapHere * Root2 + Randomity Then P2.Parent = P 'cost is slightly more for diagnols If Dir < 4 Then P2.Cost = P.Cost + .1 + MapHere + Rnd(0, Randomity) Else P2.Cost = P.Cost + (.1 + MapHere + Rnd(0, Randomity)) * Root2 EndIf EndIf EndIf EndIf EndIf Next If Done = 1 Then Exit P = P.After If P = Null Then Exit Forever If Done Then 'count how many paths P2 = NewP Repeat Paths:+ 1 P2 = P2.Parent If P2 = Null Then Exit If KeyDown(key_space) Then DebugStop Forever 'make route from end to start Route = New Int[Paths * 2] Local i:Int = 0 P2 = NewP Repeat Route[i] = P2.X i:+ 1 Route[i] = P2.Y i:+ 1 P2 = P2.Parent If P2 = Null Then Exit Forever EndIf 'nullify pointers so mem will be deallocated. P = PHead Repeat P.Parent = Null P = P.After If P = Null Then Exit Forever Return Done EndFunction EndType 'Private Type TPath Field X:Int Field Y:Int Field Parent:TPath Field Cost:Float Field Dist:Float Field After:TPath EndType
Example of how to use:
'Click to make walls. 'Rightclick to change starting point. Strict Import "pathfinder.bmx" Graphics 800, 600 Local Grid:Float[20, 20] TPathfinder.Diagonals = 2 TPathfinder.Randomity = 0 TPathfinder.SetMap(Grid, 20, 20) Const TS = 29 Local fx, fy Local my, mx Local startx = 1, starty = 1 Local i Local z, g:Float MoveMouse 111, 111 Repeat mx = MouseX() / TS my = MouseY() / TS mx=Max(mx,0); mx=Min(mx,19) my=Max(my,0); my=Min(my,19) If MouseDown(1) Then Grid[mx, my] = 1 If MouseHit(2) Then startx = mx starty = my EndIf TPathfinder.FindPath(startx, starty, mx, my) 'use mousewheel to change tile speeds g = Grid[mx, my] + (MouseZ() - z) / 10.0 z = MouseZ() If g < 0 Then g = 0 If g > 1 Then g = 1 Grid[mx, my] = g 'Draw grid tiles For fy = 0 To 19 For fx = 0 To 19 If Grid[fx, fy] > 0 Then SetColor Grid[fx, fy] * 255, 0, 0 DrawRect fx * TS, fy * TS, TS, TS EndIf Next Next 'Draw grid lines SetColor 255, 255, 255 For fx = 0 To 20 DrawRect fx * TS, 0, 1, 20 * TS DrawRect 0, fx * TS, 20 * TS, 1 Next 'Draw path SetColor 0, 255, 0 For i = 0 To (TPathfinder.Paths - 1) * 2 Step 2 DrawRect TPathfinder.Route[i] * TS + 5, TPathfinder.Route[i + 1] * TS + 5, 5, 5 Next DrawText TPathfinder.Paths, 0, 0 Flip Cls If KeyHit(key_escape) Then End Forever