Simple Pathfind by pedrolbs8th Oct 2011 5:48
|
|---|
|
Summary Simple pathfind function for AGK Description Code ` This code was downloaded from The Game Creators
` It is reproduced here with full permission
` http://www.thegamecreators.com
main.agc ----------------------------------------------------
#include "ast.agc"
#include "functions.agc"
SetVirtualResolution(800,500)
setPrintSize(18)
Global mapx=22
Global mapy=11
//astar arrays and type------------------------------
//node type to populate cells
Type TNode
H as Integer //distance to end
G as Integer //distance from start
ParentX as Integer //coord x of parent cell
ParentY as Integer //coord y of parent cell
EndType
//these two vectors define offset of search patterns
//directions are respectively null,N,W,S,E,NE,SE,SW,NW
Dim DsX[8] as Integer = [0,0,1,0,-1,1,1,-1,-1]
Dim DsY[8] as Integer = [0,-1,0,1,0,-1,1,1,-1]
//an array for the open list of cells
Dim OpenList[1000,1] as Integer
//an array for the closed list of cells
Dim ClosedList[1000,1] as Integer
//matrix of nodes to help calculate path
Dim MapCalc[mapx,mapy] As TNode
//----------------------------------------------------
//For the path drawing control------------------------
Dim PathSprites[1000] As Integer
Global PathSpritesCounter
//----------------------------------------------------
Dim collisionmap[mapx,mapy]
Global DiscoveredPath$=""
Global tilesize=32
Global img1,spr1,img2,spr2,img3,spr3,img4,spr4,img5,spr5
Global mx,my,mxC,myC,sxC,syC,exC,eyC,selBlock
Global selDiag,startBlock,endBlock
Global Error$
Global MouseInGrid
Dim DiagText$[2]
InitializeVariables()
LoadMedia()
InitializeMap(mapx,mapy)
DrawGrid(mapx,mapy,tilesize)
DrawButtons()
do
mx = getpointerx()
my = getpointery()
mapxb=mapx+2
mapyb=mapy+2
if mx >= tilesize and mx < tilesize * mapxb and my >= tilesize and my < tilesize * mapyb
mxC = (mx / tilesize) - 1
myC = (my / tilesize) - 1
MouseInGrid=1
else
mxC = -1
myC = -1
MouseInGrid=0
endif
if GetVirtualButtonPressed( 10 )
selBlock = spr2
SetSpriteColorAlpha( spr2, 255 )
SetSpriteColorAlpha( spr4, 122 )
SetSpriteColorAlpha( spr5, 122 )
endif
if GetVirtualButtonPressed( 11 )
selBlock = spr4
SetSpriteColorAlpha( spr4, 255 )
SetSpriteColorAlpha( spr2, 122 )
SetSpriteColorAlpha( spr5, 122 )
endif
if GetVirtualButtonPressed( 12 )
selBlock = spr5
SetSpriteColorAlpha( spr5, 255 )
SetSpriteColorAlpha( spr2, 122 )
SetSpriteColorAlpha( spr4, 122 )
endif
if GetVirtualButtonPressed( 1 )
If sxC = -1 or syC = -1 or exC = -1 or eyC = -1
Error$="Error : You need to define the start and the end cells before you find a path."
Else
DiscoveredPath$ = FindPath(sxC, syC, exC, eyC, selDiag, 1000)
DrawPath(DiscoveredPath$)
EndIf
endif
if GetVirtualButtonPressed( 2 )
//clear path
ClearPath()
endif
if GetVirtualButtonPressed( 3 )
selDiag = selDiag + 1
If selDiag = 3 then selDiag = 0
endif
if getpointerpressed() = 1 and MouseInGrid=1
If selBlock = 0
Error$="Error : Please select a block before you try to change the grid."
ElseIf selBlock=spr2
//wall spr2
If collisionmap[mxC,myC] = 0
crazy1 = (mxC+1) * tilesize
crazy2 = (myC+1) * tilesize
clonedSprite = CloneSprite ( spr2 )
SetSpritePosition(clonedSprite, crazy1, crazy2)
collisionmap[mxC,myC] = clonedSprite
Else
crazy1 = collisionmap[mxC,myC]
deletesprite(crazy1)
collisionmap[mxC,myC] = 0
EndIf
ElseIf selBlock=spr4
//startpoint spr4
If startBlock > 0 then deletesprite(startBlock)
crazy1 = (mxC+1) * tilesize
crazy2 = (myC+1) * tilesize
startBlock = CloneSprite ( spr4 )
setspriteposition(startBlock,crazy1,crazy2)
sxC = mxC
syC = myC
ElseIf selBlock=spr5
//endpoint spr5
If endBlock > 0 then deletesprite(endBlock)
crazy1 = (mxC+1) * tilesize
crazy2 = (myC+1) * tilesize
endBlock = CloneSprite ( spr5 )
setspriteposition(endBlock,crazy1,crazy2)
exC = mxC
eyC = myC
EndIf
endif
DebugInfo()
Sync()
loop
functions.agc---------------------------------------------------------
Function DrawPath(Path$)
If PathSpritesCounter > 0 Then ClearPath()
PathSpritesCounter = 0
PathX = -1
PathY = -1
PathAux$ = ""
PathAlter = 0
For i = 1 to Len(Path$)
If Mid(Path$,i,1) = "," Or i = Len(Path$)
If PathAlter = 0
PathX = Val(PathAux$)
PathAlter = 1 - PathAlter
PathAux$ = ""
Else
If i = Len(Path$) Then PathAux$ = PathAux$ + Mid(Path$,i,1)
PathY = Val(PathAux$)
PathAlter = 1 - PathAlter
PathAux$ = ""
crazy1 = (PathX+1) * tilesize
crazy2 = (PathY+1) * tilesize
clonedSprite = CloneSprite ( spr3 )
SetSpritePosition(clonedSprite, crazy1, crazy2)
PathSprites[PathSpritesCounter] = clonedSprite
PathSpritesCounter = PathSpritesCounter + 1
EndIf
Else
PathAux$ = PathAux$ + Mid(Path$,i,1)
EndIf
Next i
EndFunction
Function ClearPath()
If PathSpritesCounter = 0 Then exit
For cp = 0 to PathSpritesCounter - 1
If PathSprites[cp] > -1
DeleteSprite(PathSprites[cp])
PathSprites[cp]=-1
EndIf
Next
EndFunction
function DrawButtons()
if GetVirtualButtonExists( 10 ) = 0 then AddVirtualButton( 10, 42, 470, 25 )
SetSpriteColorAlpha( spr2, 122 )
SetSpritePosition ( spr2, 60, 455)
if GetVirtualButtonExists( 11 ) = 0 then AddVirtualButton( 11, 122, 470, 25 )
SetSpriteColorAlpha( spr4, 122 )
SetSpritePosition ( spr4, 140, 455)
if GetVirtualButtonExists( 12 ) = 0 then AddVirtualButton( 12, 202, 470, 25 )
SetSpriteColorAlpha( spr5, 122 )
SetSpritePosition ( spr5, 220, 455)
if GetVirtualButtonExists( 1 ) = 0 then AddVirtualButton( 1, 622, 470, 50 )
SetVirtualButtonText( 1, "Find Path" )
if GetVirtualButtonExists( 2 ) = 0 then AddVirtualButton( 2, 742, 470, 50 )
SetVirtualButtonText( 2, "Clear Path" )
if GetVirtualButtonExists( 3 ) = 0 then AddVirtualButton( 3, 352, 470, 25 )
endfunction
function DebugInfo
If GetTextExists( 10 ) = 0 then CreateText(10,"")
SetTextSize( 10, 14 )
SetTextPosition( 10, 32, 1 )
SetTextColor( 10, 0, 255, 0, 255 )
SetTextString( 10, "Mouse x,y : " + str(mx) + "," + str(my))
If GetTextExists( 11 ) = 0 then CreateText(11,"")
SetTextSize( 11, 14 )
SetTextPosition( 11, 232, 1 )
SetTextColor( 11, 0, 255, 0, 255 )
SetTextString( 11, "Mouse Cell x,y : " + str(mxC) + "," + str(myC))
If GetTextExists( 12 ) = 0 then CreateText(12,"")
SetTextSize( 12, 12 )
SetTextPosition( 12, 32, 436 )
SetTextString( 12, "Path returned : " + DiscoveredPath$)
If GetTextExists( 13 ) = 0 then CreateText(13,"")
SetTextSize( 13, 14 )
SetTextPosition( 13, 32, 416 )
SetTextColor( 13, 255, 0, 0, 255 )
SetTextString( 13, Error$)
If GetTextExists( 14 ) = 0 then CreateText(14,"")
SetTextSize( 14, 14 )
SetTextPosition( 14, 452, 1 )
SetTextColor( 14, 0, 255, 0, 255 )
SetTextString( 14, "Diagonals : " + DiagText$[selDiag])
If GetTextExists( 15 ) = 0 then CreateText(15,"")
SetTextSize( 15, 14 )
SetTextPosition( 15, 370, 463 )
SetTextString( 15, "Toggle diagonals")
If GetTextExists( 16 ) = 0 then CreateText(16,"")
SetTextSize( 16, 12 )
SetTextPosition( 16, 140, 487 )
SetTextString( 16, str(sxC)+","+str(syC))
If GetTextExists( 17 ) = 0 then CreateText(17,"")
SetTextSize( 17, 12 )
SetTextPosition( 17, 220, 487 )
SetTextString( 17, str(exC)+","+str(eyC))
endfunction
function DrawGrid(columns,rows,tsize)
for x = -1 to columns
for y = -1 to rows
if x = -1 and y >= 0
iTextIndex = CreateText ( str(y) )
SetTextSize( iTextIndex, 16 )
SetTextAlignment( iTextIndex, 1 )
SetTextPosition( iTextIndex, tsize/2, (y + 1) * tsize + (tsize/4) )
elseif y = -1 and x >= 0
iTextIndex = CreateText ( str(x) )
SetTextSize( iTextIndex, 16 )
SetTextPosition( iTextIndex, (x + 1) * tsize + (tsize/4), tsize/2 )
elseif x >= 0 and y >= 0
clonedSprite = CloneSprite ( spr1 )
SetSpritePosition ( clonedSprite, (x + 1) * tsize, (y + 1) * tsize)
endif
next y
next x
endfunction
function InitializeMap(columns,rows)
for x = 0 to columns
for y = 0 to rows
If collisionmap[columns,rows]>0
auxsprite = collisionmap[columns,rows]
DeleteSprite( auxsprite )
collisionmap[columns,rows]=0
EndIf
next y
next x
endfunction
function LoadMedia()
img1 = LoadImage ("cell001.png")
spr1 = CreateSprite ( img1 )
setspritedepth(spr1,10000)
setspriteposition(spr1,-100,-100)
img2 = LoadImage ("cell002.png")
spr2 = CreateSprite ( img2 )
setspritedepth(spr2,9999)
setspriteposition(spr2,-100,-100)
img3 = LoadImage ("cell003.png")
spr3 = CreateSprite ( img3 )
setspritedepth(spr3,9998)
setspriteposition(spr3,-100,-100)
img4 = LoadImage ("cellStart.png")
spr4 = CreateSprite ( img4 )
setspritedepth(spr4,9997)
setspriteposition(spr4,-100,-100)
img5 = LoadImage ("cellEnd.png")
spr5 = CreateSprite ( img5 )
setspritedepth(spr5,9996)
setspriteposition(spr5,-100,-100)
endfunction
Function InitializeVariables()
MouseInGrid=0
Error$=""
selBlock=0
startBlock = 0
endBlock = 0
sxC=-1
syC=-1
exC=-1
eyC=-1
selDiag = 0
DiagText$[0] = "no"
DiagText$[1] = "yes but no cutting corners"
DiagText$[2] = "yes and can cut corners"
For ps = 0 to 1000
PathSprites[ps]=-1
Next ps
PathSpritesCounter = 0
EndFunction
ast.agc---------------------------------------------------------------------------
Function FindPath(sX, sY, eX, eY, Diag, MaxSteps)
// Parameters
// sX - x coord of origin cell
// sY - y coord of origin cell
// eX - x coord of destination cell
// eY - y coord of destination cell
// Diag
// 0 - No diagonals
// 1 - Allow diagonals without cutting corners
// 2 - Allow all diagonals
// MaxSteps - max number of steps you allow the function to run
//
// This function is counting on the existence of 3 globals
// mapx - integer - size x of the map
// mapy - integer - size y of the map
// collisionmap[mapx,mapy] - integers - matrix holding collision info
//This var will define how many directions we will be searching from each parent cell
Dirs=4
//if diagonals are allowed we update the amount of directions to search
If Diag>0 then Dirs=8
//these two vars a and b will help search the open list for the next node
a=0
b=0
//will help to check if there are any more path possibilities
CountOpenCells=0
//these four vars will help find the way back
//from end cell to start cell
CamX=-1
CamY=-1
CamXaux = -1
CamYaux = -1
//this var will hold the path returned by the function
FoundPath$=""
//will help to check if we reached the end of the path search
TerminationFlag = 0
//x coord of point being examined starts being the x of the starting point
Px=sX
//y coord of point being examined starts being the y of the starting point
Py=sY
//step counter
StepCounter=0
//node holding our currently examined parent cell
P as TNode
//node holding the cells examined around the parent cell
NewP as TNode
//and here we say there is one element in the open list
OpenCounter=1
//here we say there are zero elements in the closed list
ClosedCounter=0
//this tells the function we are currently using element 0 of the open list
OpenCurrent = 0
//dont search if start equals end
If sX=eX and sY=eY then FoundPath$="already at target"
//dont search if end is a wall
If FoundPath$="" and collisionmap[eX,eY]>0 then FoundPath$="impossible path"
If FoundPath$="" and collisionmap[sX,sY]>0 then FoundPath$="impossible path"
//if we passed the first checks we are ready for the actual search
If FoundPath$=""
//this will initialize MapCalc to -1 in all four values of each node
P.G=-1
P.H=-1
P.ParentX=-1
P.ParentY=-1
For i = 0 to mapx
For j = 0 to mapy
MapCalc[i,j] = P
Next j
Next i
//here we define the starting cell as the first
//element of the open list
OpenList[0,0]=sX
OpenList[0,1]=sY
//these four lines define the node of the starting cell
P.G=0
P.H=10*(Abs(Px-eX)+Abs(Py-eY))
P.ParentX = 666
P.ParentY = 666
//and this one puts the node in the starting coords
MapCalc[sX,sY]=P
//lets start the search
Do
//increment step counter
StepCounter = StepCounter + 1
//iterator for direction offsets
For i = 1 to Dirs
//first we acquire the coords of the cell to be examined
NewPx = Px + DsX[i]
NewPy = Py + DsY[i]
//we start assuming its walkable
Walkable = 1
//then we will define it as not walkable if...
//if the coordinates are off the grid
If NewPx<0 or NewPx>mapx or NewPy<0 or NewPy>mapy then Walkable = 0
If Walkable = 1
//if there is a wall at this new cell
If collisionmap[NewPx,NewPy]>0 then Walkable = 0
//if this is a diagonal direction but we cant cut corners and we would have to
If NewPy + 1 <= mapy and NewPx - 1 >= 0
If Diag = 1 and i=5 and (collisionmap[NewPx,NewPy+1]>0 Or collisionmap[NewPx-1,NewPy]>0) then Walkable = 0
EndIf
If NewPy - 1 >= 0 and NewPx - 1 >= 0
If Diag = 1 and i=6 and (collisionmap[NewPx,NewPy-1]>0 Or collisionmap[NewPx-1,NewPy]>0) then Walkable = 0
EndIf
If NewPy - 1 >= 0 and NewPx + 1 <= mapx
If Diag = 1 and i=7 and (collisionmap[NewPx,NewPy-1]>0 Or collisionmap[NewPx+1,NewPy]>0) then Walkable = 0
EndIf
If NewPy + 1 <= mapy and NewPx + 1 <= mapx
If Diag = 1 and i=8 and (collisionmap[NewPx,NewPy+1]>0 Or collisionmap[NewPx+1,NewPy]>0) then Walkable = 0
EndIf
//if the cell is already in the closed list
for j=0 to ClosedCounter -1
if ClosedList[j,0] = NewPx and ClosedList[j,1] = NewPy then Walkable = 0
next j
EndIf
//if none of the previous checks was positive then the cell is walkable for sure
If Walkable = 1
//so we define the node values that will occupy it
NewP.ParentX = Px
NewP.ParentY = Py
// the following penalizes a diagonal movement
If i <= 4
NewP.G=P.G+10
Else
NewP.G=P.G+14
EndIf
NewP.H=10*(Abs(NewPx-eX)+Abs(NewPy-eY))
//lets check if the cell is already in the open list
OpenExists = -1
for j=0 to OpenCounter -1
if OpenList[j,0] = NewPx and OpenList[j,1] = NewPy then OpenExists = j
next j
if OpenExists = -1
//if it is not then we give it the values of the new node
//and we put the cell in the open list also incrementing the open list counter
OpenList[OpenCounter,0] = NewPx
OpenList[OpenCounter,1] = NewPy
OpenCounter = OpenCounter + 1
MapCalc[NewPx,NewPy] = NewP
//if by any chance we spotted the end cell lets raise a termination flag
If NewPx=eX and NewPy=eY then TerminationFlag=1
else
//if the cell is already in the open list we check to
//see if this new way of reaching it is better tahn the one
//previously found
if MapCalc[NewPx,NewPy].G > NewP.G then MapCalc[NewPx,NewPy] = NewP
endif
//finished dealing with this walkable cell
EndIf
//lets go and check the next neighbour of our current cell
Next i
//at this point we checked every possible neighbour of the currently examined cell
//if the termination flag was raised
//we build the path string and exit the function
If TerminationFlag=1
//we start at the end cell
FoundPath$=str(eX)+","+str(eY)
CamX=eX
CamY=eY
//we will repeat the following steps until we reach the starting node
repeat
FoundPath$=FoundPath$+","
CamXaux = CamX
CamYaux = CamY
//we make CamX and CamY point to the parent cell of the current cell
CamX=MapCalc[CamXaux,CamYaux].ParentX
CamY=MapCalc[CamXaux,CamYaux].ParentY
//and we put those coords in the path string
FoundPath$=FoundPath$+str(CamX)+","+str(CamY)
until CamX=sX and CamY=sY
//and we exit the do loop cycle to exit the function
exit
EndIf
//if we went over the step limit we issue an error and leave the function
If StepCounter>=MaxSteps
FoundPath$="step limit exceeded"
Exit
EndIf
//this invalidates the element of the open list we were examining
OpenList[OpenCurrent,0] = -1
OpenList[OpenCurrent,1] = -1
//this adds that element to the closed list and increments the closed list counter
ClosedList[ClosedCounter,0] = Px
ClosedList[ClosedCounter,1] = Py
ClosedCounter = ClosedCounter + 1
//here starts the process that will find the best
//possible candidate to become the next current cell to be examined
//initialize the comparison values to high values
MinimoF = 999999
MinimoH = 999999
//initialize the counter of valid elements in the open list
CountOpenCells=0
for i = 0 to OpenCounter - 1
//will only check the element if its valid
If OpenList[i,0] > -1
//increments the counter of valid elements
CountOpenCells=CountOpenCells+1
//retrieves the coords of the open list element
a = OpenList[i,0]
b = OpenList[i,1]
//now we check the values of these coordinates
AuxValue = MapCalc[a,b].G + MapCalc[a,b].H
AuxValue2 = MapCalc[a,b].H
//and we compare them to the best we found so far
If AuxValue <= MinimoF and AuxValue2 < MinimoH
//if they are better we prepare the cell to be examined next
MinimoF = AuxValue
MinimoH = AuxValue2
OpenCurrent = i
Px = a
Py = b
P = MapCalc[a,b]
endif
endif
next i
//if there are no valid elements in the open list we have no path to
//help us reach the end cell
if CountOpenCells = 0
FoundPath$="no path to target"
exit
endif
// now that we have a new cell to examine we go back to
// start checking its neighbours
Loop
EndIf
EndFunction FoundPath$
|