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,