my one ( (c) By Luke810 and MasterXilo)
Quote: "print "left mouse button to calculate path from the current to the position you click on"
print "right and middle mouse button to change maze"
print "hold space when clicking to allow diagonal movement""
rem ******************************
rem A* Pathfinding Function
rem Example
rem -----------------
rem By Luke810
rem ******************************
rem edited by masterxilo
sz=32
` Setup
set display mode 1024,768,16
print "left mouse button to calculate path from the current to the position you click on"
print "right and middle mouse button to change maze"
print "hold space when clicking to allow diagonal movement"
input "size (def 32, 0 for maze by calcyman): ",size
if size=0 then maze=1:size=32
rem *************** INITIALIZE PATHFINDING *******************
` Dimension pre-initiation arrays
Dim NodesX(0)
Dim NodesZ(0)
Dim DirectionMode(0)
Dim MaxPathLength(0)
Dim NmbPaths(0)
` Initiate pathfinding
Astar_Init_Pathfinding(size,size,size^2,1)
` Dimension post-initiation arrays
NmbPaths = NmbPaths(0)
NodesX = NodesX(0) : NodesZ = NodesZ(0)
TotalNodes = NodesX * NodesZ
MaxPathLength = MaxPathLength(0)
Dim Astar_Grid(NodesX,NodesZ)
Dim Astar_OpenList(TotalNodes,3)
Dim Astar_ClosedList(MaxPathLength,3)
Dim Astar_Fval(TotalNodes)
Dim Astar_Gval(TotalNodes)
Dim Astar_Hval(TotalNodes)
Dim PathX(NmbPaths,MaxPathLength)
Dim PathZ(NmbPaths,MaxPathLength)
rem **********************************************************
sync on
sync rate 60
autocam off
make memblock 1,size*size
if maze
for x=0 to 32-1
for y=0 to 32-1
pos=x+y*32
read colour
if colour=0 then write memblock byte 1,pos,2:Astar_Set_Grid_Square(1,x+1,y+1)
if colour=4 then enx=x+1:eny=y+1
if colour=3 then stx=x+1:sty=y+1
next y
next x
new=1
else
stx=1:sty=1
endif
do
cls
ink rgb(255,255,255),0
for y=size-1 to 0 step -1
for x=0 to size-1
pos=x+y*size
v_byte=memblock byte(1,pos)
ink rgb(255,255,255),0
if v_byte=2 then ink rgb(0,0,0),0
if v_byte=1 then ink rgb(255,255,0),0
box 7+x*9,7+y*9,7+x*9+9,7+y*9+9
if mousex()>=7+x*9 and mousey()>=7+y*9 and mousex()<=7+x*9+8 and mousey()<=7+y*9+8
if mouseclick()=1 and new=0 and click=0
enx=x+1:eny=y+1
new=1
click=1
endif
if mouseclick()=4 then write memblock byte 1,pos,0:Astar_Set_Grid_Square(0,x+1,y+1)
if mouseclick()=2 then write memblock byte 1,pos,2:Astar_Set_Grid_Square(1,x+1,y+1)
endif
next x
next y
if mouseclick()=0
click=0
endif
ink rgb(0,255,0),0
text 0,0,"Time to Find Path: " + str$(TimeElapsed#)
if new
if spacekey()=0
Astar_Set_Search_Mode(1)
else
Astar_Set_Search_Mode(0)
endif
Time# = timer()
Astar_Find_Path(1,stx,sty,enx,eny)
TimeElapsed# = timer() - Time#
Astar_Node_Path_to_Real(1,0,0,1,1)
PathLength = Astar_Get_Path_Length(1)
for y=0 to size-1
for x=0 to size-1
pos=x+y*size
v_byte=memblock byte(1,pos)
if v_byte=1 then write memblock byte 1,pos,0
next x
next y
` Create Marker Flags
for x=1 to PathLength
pos=PathX(1,x)+PathZ(1,x)*size
write memblock byte 1,pos,1
next x
stx=enx
sty=eny
new=0
endif
sync
loop
remstart
PLACE THE FOLLOWING IN YOUR PROGRAM AND MODIFY THE
APPROPRIATE VALUES IN THE PATHFINDING INITIATION CALL
TO SETUP THE A* PATHFINDING SYSTEM IN YOUR PROGRAM
#include "AStar.dba"
` Dimension pre-initiation arrays
Dim NodesX(0)
Dim NodesZ(0)
Dim DirectionMode(0)
Dim MaxPathLength(0)
Dim NmbPaths(0)
` Initiate pathfinding
Astar_Init_Pathfinding(NodesX,NodesZ,PathLength,NmbPaths)
` Dimension post-initiation arrays
NmbPaths = NmbPaths(0)
NodesX = NodesX(0) : NodesZ = NodesZ(0)
TotalNodes = NodesX * NodesZ
MaxPathLength = MaxPathLength(0)
Dim Astar_Grid(NodesX,NodesZ)
Dim Astar_OpenList(TotalNodes,3)
Dim Astar_ClosedList(MaxPathLength,3)
Dim Astar_Fval(TotalNodes)
Dim Astar_Gval(TotalNodes)
Dim Astar_Hval(TotalNodes)
Dim PathX(NmbPaths,MaxPathLength)
Dim PathZ(NmbPaths,MaxPathLength)
AVAILABLE FUNCTIONS:
Astar_Init_Pathfinding(NodesX,NodesZ,MaxPathLength,NmbPaths)
- NodesX: the number of nodes along the x-axis or your pathfinding
grid
- NodesX: the number of nodes along the z-axis or your pathfinding
grid
- MaxPathLength: the maximum length of a path in your grid. if the
distance to the destination exceeds this the
Astar_Find_Path() function will not generate a path
- NmbPaths: the number of paths you want to have for in your system
you can also use the default path 0
Initiates the pathfinding system for your program
Astar_Node_Path_to_Real(path,grid_x,grid_z,spacing_x,spacing_z)
- Path: the path you wish to convert
- Grid_X: the real-world x coordinate of the lower left corner of the
the lower left tile in your grid
- Grid_Z: the real-world z coordinate of the lower left corner of the
the lower left tile in your grid
- Spacing_X: the distance along the x axis between nodes in your grid
- Spacing_Z: the distance along the z axis between nodes in your grid
Converts all the coordinates in the specified path from tile numbers
to real-world coordinates. This must be called every time a new route
is generated for the specified path.
Astar_Real_Path_to_Node(path,grid_x,grid_z,spacing_x,spacing_z)
- Path: the path you wish to convert
- Grid_X: the real-world x coordinate of the lower left corner of the
the lower left tile in your grid
- Grid_Z: the real-world z coordinate of the lower left corner of the
the lower left tile in your grid
- Spacing_X: the distance along the x axis between nodes in your grid
- Spacing_Z: the distance along the z axis between nodes in your grid
Reverses the effects of calling Astar_Node_Path_to_Real()
Astar_Get_Path_Length(path)
- Path: the path you wish to retrieve data for
Outputs the number of waypoints in the specified path
Astar_Find_Path(path,x1,z1,x2,z2)
- Path: the path you wish to store the generated route in
- x1: the grid x coordinate of the start sqaure
- z1: the grid z coordinate of the start sqaure
- x2: the grid x coordinate of the destination sqaure
- z2: the grid z coordinate of the destination sqaure
Finds and stores a path between the two nodes into the
specified path
Astar_Set_Grid_Sqaure(value,x,z)
- value: the grid value to set the specified node to. A non-zero value
will be recognized as unwalkable in the Astar_Find_Path call.
- x: the grid x coordinate of the sqaure
- z: the grid z coordinate of the sqaure
Astar_Get_Grid_Sqaure(x,z)
- x: the grid x coordinate of the sqaure
- z: the grid z coordinate of the sqaure
Outputs the current value of the specified node
Astar_Estimate_Dist(x1,z1,x2,z2)
- x1: the grid x coordinate of the start sqaure
- z1: the grid z coordinate of the start sqaure
- x2: the grid x coordinate of the destination sqaure
- z2: the grid z coordinate of the destination sqaure
Outputs the approximate number of nodes in a path between the specified
tiles. (The starting heretic value for the path)
Astar_Set_Search_Mode(mode)
- mode: either 0 or non-zero. Determines the search mode used when the
Astar_Find_Path() function is called
Sets the search mode used by the Astar_Find_Path() function. 0 is
diagonal mode and non-zero is restricted-diagonals mode
remend
Function Astar_Init_Pathfinding(NodesX,NodesZ,MaxPathLength,NmbPaths)
DirectionMode(0) = 0
MaxPathLength(0) = MaxPathLength
NmbPaths(0) = NmbPaths
NodesX(0) = NodesX
NodesZ(0) = NodesZ
endfunction
Function Astar_Node_Path_to_Real(path,grid_x,grid_z,spacing_x,spacing_z)
for t = 1 to PathX(path,0)
PathX(path,t) = grid_x + (spacing_x / 2) + ((PathX(path,t)-1) * spacing_x)
PathZ(path,t) = grid_z + (spacing_z / 2) + ((PathZ(path,t)-1) * spacing_z)
next t
endfunction
Function Astar_Real_Path_to_Node(path,grid_x,grid_z,spacing_x,spacing_z)
for t = 1 to MaxPathLength(0)
PathX(path,t) = (PathX(path,t) - grid_x - (spacing_x / 2)) / spacing_x
PathZ(path,t) = (PathZ(path,t) - grid_z - (spacing_z / 2)) / spacing_z
next t
endfunction
Function Astar_Get_Path_Length(path)
result = PathX(path,0)
endfunction result
Function Astar_Set_Grid_Square(flag,x,z)
Astar_Grid(x,z) = flag
endfunction
Function Astar_Get_Grid_Square(x,z)
result = Astar_Grid(x,z)
endfunction result
Function Astar_Estimate_Dist(x1,z1,x2,z2)
if DirectionMode(0) = 0
Dist = (x2-x1) + (y2-y1)
else
Dist = sqrt((x2-x1)^2+(z2-z1)^2) + 1
endif
endfunction Dist
Function Astar_Set_Search_Mode(mode)
DirectionMode(0) = mode
endfunction
Function Astar_Find_Path(path,x1,z1,x2,z2)
Astar_Fval(0) = 100000
Astar_Fval(1) = 99999
DestX = x1
DestZ = z1
CurrX = x2
CurrZ = z2
Counter1 = 2
Counter2 = 1
Finish=0
Astar_OpenList(1,0) = CurrX
Astar_OpenList(1,1) = CurrZ
G1 = 10
G2 = 14
repeat
` Find lowest f-cost square
for x = 0 to Counter1 - 1
if Astar_Fval(x) < Astar_Fval(BestTile)
BestTile = x
endif
next z
` Add it to the closed list
Astar_ClosedList(Counter2,0) = Astar_OpenList(BestTile,0)
Astar_ClosedList(Counter2,1) = Astar_OpenList(BestTile,1)
Astar_ClosedList(Counter2,2) = Astar_OpenList(BestTile,2)
Astar_ClosedList(Counter2,3) = Astar_OpenList(BestTile,3)
Astar_Fval(BestTile)=99999
` Set current tile
CurrX = Astar_ClosedList(Counter2,0)
CurrZ = Astar_ClosedList(Counter2,1)
` Increment nmb of waypoints
inc Counter2
` Check for pathlength reached
if Counter2 >= MaxPathLength(0) then exitfunction
` Set Current Tile as Parent
ParentX = CurrX
ParentZ = CurrZ
` Add Adjacent Squares to Open List
for x = -1 to 1
for y = -1 to 1
` Reset values
Run = 1
Skip = 0
CheckTile = 0
Adjacent = 0
` Get the tile to check
TileX = CurrX + x
TileY = CurrZ + y
` Check if tile is adjacent
if x = 0 or y = 0 then Adjacent = 1
` Exclude diagonals in no-diagonals mode
if DirectionMode(0) <> 0 and Adjacent = 0 then CheckTile = 1
` Check if the tile is the current tile
if TileX = CurrX and TileY = CurrZ then CheckTile = 1
` Make sure the node exists
if TileX > 0 and TileX <= NodesX(0) and TileY > 0 and TileY <= NodesZ(0) and CheckTile = 0
` Check if the destination tile has been found
if TileX = DestX and TileY = DestZ then Finish = 1
` If the tile is walkable
if Astar_Grid(TileX,TileY) = 0
` Check if the tile is already on the path...
for z = 0 to Counter2 - 1
if Astar_ClosedList(z,0) = TileX and Astar_ClosedList(z,1) = TileY then Run = 0
next z
` if not add it to the open list
if Run = 1
` Check if the tile is already on the OpenList
for z = 1 to Counter1
if Astar_OpenList(z,0) = TileX and Astar_OpenList(z,1) = TileY
Skip = 1
Zval = z
endif
next z
` If not add it, else check if this path to that square is shorter
` and if so then change the values for that square to the new values
if Skip = 0
Astar_OpenList(Counter1,0) = TileX : Astar_OpenList(Counter1,1) = TileY
Astar_OpenList(Counter1,2) = ParentX : Astar_OpenList(Counter1,3) = ParentZ
ValX = abs(TileX-DestX)
ValZ = abs(TileY-DestZ)
Astar_Hval(Counter1) = (ValX+ValZ) * 10
if Adjacent = 1 then Astar_Gval(Counter1) = Astar_Gval(BestTile) + G2 else Astar_Gval(Counter1) = Astar_Gval(BestTile)+G1
Astar_Fval(Counter1) = Astar_Hval(Counter1) + Astar_Gval(Counter1)
inc Counter1
else
if Adjacent = 1 then Gval = Astar_Gval(BestTile) + G2 else Gval = Astar_Gval(BestTile) + G1
if Gval < Astar_Gval(Zval)
Astar_OpenList(Zval,2) = ParentX : Astar_OpenList(Zval,3) = ParentZ
Astar_Gval(Zval) = Gval
Astar_Fval(Zval) = Gval + Astar_Hval(Zval)
endif
endif
endif
endif
endif
next y
next x
rem Reset BestTile
BestTile=0
until Finish=1
` Save the path to the specified path array
Max_Waypoints = 1
PathX(path,1) = DestX
PathZ(path,1) = DestZ
PathX(path,2) = Astar_ClosedList(Counter2-1,0)
PathZ(path,2) = Astar_ClosedList(Counter2-1,1)
NextX = Astar_ClosedList(Counter2-1,2)
NextZ = Astar_ClosedList(Counter2-1,3)
if NextX = 0 and NextZ = 0 then Max_Waypoints = 2
if Max_Waypoints = 1
inc Max_Waypoints
repeat
inc Max_Waypoints
PathX(path,Max_Waypoints) = NextX
PathZ(path,Max_Waypoints) = NextZ
for x = 1 to Counter2 - 1
if Astar_ClosedList(x,0) = NextX and Astar_ClosedList(x,1) = NextZ
NextX = Astar_ClosedList(x,2)
NextZ = Astar_ClosedList(x,3)
endif
next x
until NextX = 0 and NextZ = 0
endif
PathX(path,0) = Max_Waypoints
endfunction
data 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
data 0,1,1,1,1,0,1,1,1,0,1,1,1,0,1,1,1,0,1,1,1,1,1,1,1,1,1,0,1,1,1,0,
data 0,1,1,1,1,1,1,0,1,1,1,0,1,0,1,0,1,0,1,1,1,1,1,1,1,1,1,0,1,1,1,0,
data 0,0,0,0,0,0,0,0,0,0,0,0,1,0,1,0,1,0,1,0,1,1,1,1,1,1,1,0,1,1,1,0,
data 0,1,1,1,1,1,1,1,1,1,1,0,1,1,1,0,1,1,1,0,0,0,0,0,0,1,1,1,1,1,1,0,
data 0,1,1,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,1,0,1,1,1,1,0,1,1,1,1,1,1,0,
data 0,1,1,0,3,1,1,1,1,0,1,0,1,1,1,1,1,0,1,0,1,1,1,1,1,1,1,0,1,1,1,0,
data 0,1,1,0,0,0,0,0,1,0,1,0,1,0,0,0,1,0,1,0,0,0,1,1,0,1,1,0,0,0,0,0,
data 0,1,1,0,1,1,1,1,1,0,1,0,1,1,1,0,1,0,1,0,1,1,1,0,0,1,1,1,1,1,1,0,
data 0,1,1,0,0,0,1,0,0,0,1,0,0,0,1,0,1,0,1,0,1,1,0,1,0,1,1,1,1,1,1,0,
data 0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,1,0,1,0,1,1,1,1,0,1,1,1,1,1,1,0,
data 0,1,1,0,0,0,1,0,0,0,1,0,0,0,0,0,1,0,1,0,0,1,1,1,0,0,0,0,0,0,0,0,
data 0,1,1,0,1,1,1,1,1,0,1,0,1,1,1,1,1,0,1,0,1,0,1,1,1,1,1,1,1,0,1,0,
data 0,1,1,0,1,1,1,1,1,0,1,0,1,0,0,0,0,0,1,0,1,1,0,1,1,0,1,1,0,1,1,0,
data 0,1,1,0,0,0,0,0,0,0,1,0,1,0,1,1,1,1,1,0,1,0,1,0,1,1,1,0,1,1,1,0,
data 0,1,1,1,1,1,1,1,1,1,1,0,1,0,1,0,0,0,0,0,1,1,0,1,0,1,0,1,1,0,1,0,
data 0,0,0,0,0,0,0,0,0,0,0,0,1,0,1,0,1,1,0,1,1,1,1,1,1,1,1,1,1,1,1,0,
data 0,1,1,1,1,1,1,0,1,1,1,0,1,0,1,0,1,1,0,1,1,1,1,1,1,1,1,1,1,1,1,0,
data 0,1,1,1,1,1,1,0,1,1,1,0,1,0,1,0,1,1,0,1,1,0,0,0,0,0,0,0,0,1,1,0,
data 0,1,1,1,1,1,1,0,1,1,1,1,1,1,1,1,1,1,0,1,1,0,1,1,1,1,1,1,0,1,1,0,
data 0,1,1,1,1,1,1,0,0,0,0,0,1,0,0,0,0,0,0,1,1,0,1,4,1,1,1,1,0,1,1,0,
data 0,1,1,1,1,1,1,0,1,1,0,1,1,1,1,1,0,1,1,1,1,0,1,1,1,1,0,0,0,1,1,0,
data 0,0,0,0,0,0,0,0,1,1,0,1,1,1,1,1,0,1,0,0,1,0,0,1,0,0,0,1,0,1,1,0,
data 0,1,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,1,0,1,1,1,1,1,1,1,1,1,0,1,1,0,
data 0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,1,0,0,0,1,0,1,1,0,
data 0,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,1,1,1,1,0,0,0,1,1,0,
data 0,1,1,1,1,1,1,1,1,1,1,1,0,1,1,1,1,1,1,0,1,0,1,1,1,1,1,1,0,1,1,0,
data 0,1,1,1,0,1,0,0,0,0,0,1,0,1,0,0,0,0,1,0,1,0,0,0,0,0,0,0,0,1,1,0,
data 0,1,1,1,0,1,0,1,1,1,0,1,0,1,1,1,1,0,1,0,1,1,1,1,1,1,1,1,1,1,1,0,
data 0,1,1,1,0,1,0,0,0,1,0,1,0,0,0,0,1,0,1,1,1,0,1,0,1,1,1,1,1,0,0,0,
data 0,1,1,1,0,1,1,1,1,1,0,1,1,1,1,1,1,0,1,0,1,1,1,1,1,1,1,1,1,1,1,0,
data 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
