A* Pathfinding Demo
A* Pathfinding Demo
Source here: http://www.execulink.com/~coder/freebasic/astar.html
(need at least fbc-0.17)
This is an A* pathfinding demonstration written in FreeBASIC that generates a display similar to the excellent beginners tutorial by Patrick Lester found at http://www.policyalmanac.org/games/aStarTutorial.htm
You can use the mouse buttons to set the starting and ending tiles, plus toggle the solid tiles.
Enjoy!
(need at least fbc-0.17)
This is an A* pathfinding demonstration written in FreeBASIC that generates a display similar to the excellent beginners tutorial by Patrick Lester found at http://www.policyalmanac.org/games/aStarTutorial.htm
You can use the mouse buttons to set the starting and ending tiles, plus toggle the solid tiles.
Enjoy!
-
- Posts: 444
- Joined: Mar 10, 2006 19:22
The demo is just one way A* could be implemented which I think is easy to read, but likely not fast/efficient enough for a large grid or many paths. There are probably a dozen or more ways to implement the concept of nodes on an OPEN or CLOSED list. There are reference links on the tutorial's page that go in more depth to implementing the algorithm. Thanks for the positive feedback guys. :)
Very cool. Here's something I made a long time ago after reading that same tutorial and adding a few ideas of my own and a few things to make it faster. You'll have to use -lang QB to compile it, but it's still pretty cool I think. :p
http://copy-pasta.com/pasta2052
http://copy-pasta.com/pasta2052
-
- Posts: 5494
- Joined: Sep 12, 2005 20:06
- Location: California
-
- Posts: 8586
- Joined: May 28, 2005 3:28
- Contact:
@coderJeff
thanx the tutorial is super simple while you wrote it for FB i wrote it for Basic4GL
the exe apath.zip
Joshy
thanx the tutorial is super simple while you wrote it for FB i wrote it for Basic4GL
the exe apath.zip
Joshy
Code: Select all
' A* Pathfinder
'
' usage:
' left mouse button set PathStart (green)
' right mouse button set PathEnd (red)
' midle mouse button togle Walkable (blue)
struc VECTOR2D
dim x,y
end struc
struc COSTS
dim f,g,h
endstruc
struc CELL
dim VECTOR2D Position
dim VECTOR2D Array
dim COSTS Cost
dim State ' NONE / OPEN / CLOSED
dim CELL &Parent
dim Walkable ' True/False
dim Index
endstruc
struc DIRECTIONS
dim VECTOR2D Add
dim Cost,Flag
end struc
' cost,xadd,yadd,direction
DataDirs:
Data 1000, 0,-1, 1 ' north
Data 1000, 1, 0, 2 ' east
Data 1000, 0, 1, 4 ' south
Data 1000,-1, 0, 8 ' west
Data 1414, 1,-1, 3 ' north east
Data 1414, 1, 1, 6 ' south east
Data 1414,-1, 1,12 ' south west
Data 1414,-1,-1, 9 ' north west
const _XCELLS=4*10,_YCELLS=3*10
const _LASTCELL=_XCELLS*_YCELLS-1
const _NONE =0,_OPEN=1,_CLOSED=2
dim CELL Terain(_LASTCELL)
dim CELL &PathStart
dim CELL &PathEnd
dim CELL &Cell
dim CELL &Parent
dim CellWidth#,CellHeight#
dim Index,CellIndex,NewCellIndex
dim DIRECTIONS Test
dim DIRECTIONS Dirs(7),DIndex,DirFlag
dim MustUpdate
Gosub InitOpenGL2D
Gosub InitTerain
Gosub InitDirections
MustUpdate=True
' init any PathStart and PathEnd
Index =int(_YCELLS*0.25)*_XCELLS+int(_XCELLS*0.25)
&PathStart=&Terain(Index)
Index =int(_YCELLS*0.75)*_XCELLS+int(_XCELLS*0.75)
&PathEnd =&Terain(Index)
' draw a wall in center of the Terain
Index =int(_YCELLS*0.1 )*_XCELLS+int(_XCELLS*0.5 )
while Index<int(_YCELLS*0.9 )*_XCELLS+int(_XCELLS*0.5 )
Terain(Index).Walkable=False:Index=Index+_XCELLS
wend
'
' main loop
'
while True
if Mouse_Button(MOUSE_LBUTTON) then
' set new PathStart (green)
Gosub GetNewCellIndex
if NewCellIndex<>CellIndex then
if &PathEnd<>&Terain(NewCellIndex) then
CellIndex=NewCellIndex:&PathStart=&Terain(CellIndex)
Terain(CellIndex).Walkable=True:MustUpdate=True
endif
endif
elseif Mouse_Button(MOUSE_RBUTTON) then
' set new PathEnd (red)
Gosub GetNewCellIndex
if NewCellIndex<>CellIndex then
if &PathStart<>&Terain(NewCellIndex) then
CellIndex=NewCellIndex:&PathEnd=&Terain(CellIndex)
Terain(CellIndex).Walkable=True:MustUpdate=True
endif
endif
elseif Mouse_Button(MOUSE_MBUTTON) then
' make TerainCell as Walkable (blue) or not (rectangle)
Gosub GetNewCellIndex
if NewCellIndex<>CellIndex then
if (&Terain(NewCellIndex)<>&PathStart) land (&Terain(NewCellIndex)<>&PathEnd) then
CellIndex=NewCellIndex:MustUpdate=True
Terain(CellIndex).Walkable= not Terain(CellIndex).Walkable
endif
endif
endif
if MustUpdate=True then
glClear(GL_COLOR_BUFFER_BIT)
Gosub DrawTerain
Gosub GetPath
Gosub DrawPath
MustUpdate=False
SwapBuffers()
else
Sleep(10)
endif
wend
InitOpenGL2D:
glMatrixMode (GL_PROJECTION)
glLoadIdentity()
glOrtho (0,WindowWidth(),WindowHeight(),0, 0,1)
glMatrixMode (GL_MODELVIEW)
glLoadIdentity()
glDisable (GL_DEPTH_TEST)
glDisable (GL_CULL_FACE)
glMatrixMode (GL_MODELVIEW)
CellWidth# =WindowWidth ()/_XCELLS
CellHeight#=WindowHeight()/_YCELLS
return
InitDirections:
Reset DataDirs
for DIndex=0 to 7
read Dirs(DIndex).Cost
read Dirs(DIndex).Add.x
read Dirs(DIndex).Add.y
read Dirs(DIndex).Flag
next
return
InitTerain:
' get center of all TerainCells
for Index=0 to _LASTCELL
Terain(Index).Index = Index
Terain(Index).Array.x = (Index % _XCELLS)
Terain(Index).Array.y = (Index / _XCELLS)
Terain(Index).Position.x = (CellWidth# *0.5)+Terain(Index).Array.x*CellWidth#
Terain(Index).Position.y = (CellHeight#*0.5)+Terain(Index).Array.y*CellHeight#
Terain(Index).Walkable = True
next
return
ClearTerain:
' clear all cost and set to STATE_NONE
for Index=0 to _LASTCELL
&Terain(Index).Parent = NULL
Terain(Index).Cost.f = 0
Terain(Index).Cost.g = 0
Terain(Index).Cost.h = 0
Terain(Index).State = _NONE
next
return
DrawTerain:
for Index=0 to _LASTCELL
if &Terain(Index)=&PathStart then
glColor3f(0,.75,0):Gosub DrawQuad
elseif &Terain(Index)=&PathEnd then
glColor3f(.75,0,0):Gosub DrawQuad
elseif Terain(Index).Walkable=False then
glColor3f(0,0,.75):Gosub DrawQuad
endif
glColor3f(.75,.75,.75):Gosub DrawRectangle
next
return
DrawPath:
&Cell=&PathEnd
while (&Cell.Parent<>NULL)
if (&Cell<>&PathEnd) then
Index=Cell.Index
glColor3f(.75,.75,0):Gosub DrawDiamond
endif
&Cell=&Cell.Parent
wend
return
DrawQuad:
glPushMatrix ()
glTranslatef (Terain(Index).Position.x,Terain(Index).Position.y, 0)
glScalef (CellWidth#,CellHeight#, 1)
glBegin (GL_QUADS)
glVertex2f (-0.5, 0.5)
glVertex2f (-0.5,-0.5)
glVertex2f ( 0.5,-0.5)
glVertex2f ( 0.5, 0.5)
glEnd()
glPopMatrix()
return
DrawDiamond:
glPushMatrix ()
glTranslatef (Terain(Index).Position.x,Terain(Index).Position.y, 0)
glScalef (CellWidth#,CellHeight#, 1)
glBegin (GL_QUADS)
glVertex2f ( 0, 0.25)
glVertex2f (-0.25, 0)
glVertex2f ( 0,-0.25)
glVertex2f ( 0.25, 0)
glEnd()
glPopMatrix()
return
DrawRectangle:
glPushMatrix()
glTranslatef (Terain(Index).Position.x,Terain(Index).Position.y, 0)
glScalef (CellWidth#,CellHeight#, 1)
glBegin (GL_LINE_LOOP)
glVertex2f (-0.5, 0.5)
glVertex2f (-0.5,-0.5)
glVertex2f ( 0.5,-0.5)
glVertex2f ( 0.5, 0.5)
glEnd()
glPopMatrix()
return
GetNewCellIndex:
' get TerainCell from curent Mouse position
NewCellIndex= int((Mouse_x()*WindowWidth() )/CellWidth#)
NewCellIndex=NewCellIndex+int((Mouse_y()*WindowHeight())/CellHeight#)*_XCELLS
return
GetMinCost:
&Parent=NULL
for Index=0 to _LASTCELL
if Terain(Index).State=_OPEN then
if &Parent=NULL then
&Parent = &Terain(Index)
elseif Terain(Index).Cost.F < Parent.Cost.F then
&Parent = &Terain(Index)
endif
end if
next
return
TestNeighbour:
Test.Flag=False
if Test.add.X< 0 then return:endif
if Test.add.X>=_XCELLS then return:endif
if Test.add.Y< 0 then return:endif
if Test.add.Y>=_YCELLS then return:endif
Index=Test.add.X+Test.add.Y*_XCELLS
&Cell=&Terain(Index)
if Cell.Walkable=False then return:endif
if Cell.State<>_NONE then
if (Parent.Cost.g+Test.Cost)<Cell.Cost.g then
Cell.State=_NONE
endif
endif
if Cell.State=_NONE then
&Cell.Parent = &Parent
Cell.State = _OPEN
Cell.Cost.h = ABS(Cell.Position.x-PathEnd.Position.x)*1000
Cell.Cost.h = Cell.Cost.h + ABS(Cell.Position.y-PathEnd.Position.y)*1000
Cell.Cost.g = Parent.Cost.g + Test.Cost
Cell.Cost.f = Cell.Cost.g + Cell.Cost.h
endif
Test.Flag=True
return
TestNeighbours:
DirFlag =0
For DIndex=0 to 7
Test.Cost=Dirs(DIndex).Cost
Test.add.X=Parent.Array.x+Dirs(DIndex).Add.x
Test.add.Y=Parent.Array.y+Dirs(DIndex).Add.y
if DIndex<4 then
Gosub TestNeighbour
if Test.Flag=True then
DirFlag=DirFlag or Dirs(DIndex).Flag
endif
else
if (DirFlag and Dirs(DIndex).Flag)=Dirs(DIndex).Flag then
Gosub TestNeighbour
endif
endif
next
return
GetPath:
' Calc a Path between PathEnd and PathStart
Gosub ClearTerain
PathStart.State=_OPEN
Do
Gosub GetMinCost
if (&Parent=NULL) lor (&Parent=&PathEnd) then return:endif
Parent.State=_CLOSED
Gosub TestNeighbours
Loop
return
-
- Posts: 9
- Joined: Aug 07, 2008 6:26
-
- Posts: 444
- Joined: Mar 10, 2006 19:22
Nice work D.J.Peters, one thing I am curious about is in the first 'here' example at the first turn, the solution takes 9 steps to move from one junction to the next however the eastern route at the first junction would result in 5 steps. The path looks good and reaches its destination but why was the more optimal route not taken?
I believe that comes down to the heuristic used- which calculates the distance between two cells. Good heuristics are slow, so maybe a fast/innacurate one was used.
I think this is the offending code:
http://theory.stanford.edu/~amitp/GameP ... stics.html
I think this is the offending code:
Looks like manhatten method. Changing the 1000 can affect the result I believe- however if you wish to try other methods, this page is helpful:Code: Select all
Cell.Cost.h = Abs(Cell.Position.x-PathEnd.Position.x)*1000 Cell.Cost.h = Cell.Cost.h + Abs(Cell.Position.y-PathEnd.Position.y)*1000
http://theory.stanford.edu/~amitp/GameP ... stics.html