IanM's A* library [DBC] - GameCreators Forum

Author

Message

Mattman

20

Years of Service

User Offline

Joined: 5th Jun 2003

Location: East Lansing

Posted: 14th Jun 2004 18:24 Edited at: 14th Jun 2004 23:56

Link

I succesfully converted IanM's A* library from DBP to DBC (Dang types!)

Have fun with it!

` MapAndSearch.dba

` Map and search routines

remstart
AVAILABLE FUNCTIONS*********************************************************************

CreateSearchMap(Width,Height)
   Create the map of the size specified

CreateSearchPathList(NoOfPaths)
   Create the paths of the quantity specified

SetSearchMap(X,Y,Value)
   Set an entry within the map (> 0 is not walkable)

GetSearchMap(X,Y)
   Read an entry from the map

GetSearchPathX(Path,Move)
   Get a X coordinate from the path specified

GetSearchPathY(Path,Move)
   Get a Y coordinate from the path specified

SearchPathSize(Path)
   Get the length of the specified path

SetSearchRestrictDiagonals(Mode)
   Only affects the 8 diection searches. If set to non-zero, will avoid diagonals
   between blocked cells.

SetMaximumCost(Cost)
   Will stop searching if the target is not reached within the required cost. Set to
   zero to deactivate.

SearchMapAStar4(Path,StartX,StartY,FinishX,FinishY)
   Run an 4 direction A* search, and store the results within the selected path

SearchMapAStar8(Path,StartX,StartY,FinishX,FinishY)
   Run an 8 direction A* search, and store the results within the selected path

SearchMapFlood4(Path,StartX,StartY,FinishX,FinishY)
   Run a 4 direction flood search, and store the results within the selected path

SearchMapFlood8(Path,StartX,StartY,FinishX,FinishY)
   Run an 8 direction flood search, and store the results within the selected path

GetFloodCost(FinishX,FinishY)
   Uses the previous Flood4 search to identify the cost of the specified target

****************************************************************************************
remend

` ***********************
` Conditional Compilation
` ***********************

` Uncomment these three lines and comment the following three to enable the 'swap array items'.
` This command is a part of the matrix1array TPC DLL, and makes this stuff marginally faster.
`#constant FASTSWAP_OFF  :
`#constant FASTSWAP_ON   remstart
`#constant FASTSWAP_END  remend
`#constant FASTSWAP_OFF  remstart
`#constant FASTSWAP_ON   remend
`#constant FASTSWAP_END  :

` ********************
` UDTs used internally
` ********************

dim SEARCH_Positionx(1,1)
dim SEARCH_Positiony(1,1)

` Status,G,H,F,ParentX,ParentY
dim SEARCH_TileInformation(1)

` F,X,Y
dim SEARCH_OpenListItemf(1)
dim SEARCH_OpenListItemx(1)
dim SEARCH_OpenListItemy(1)

` *************************************
` Global variables for library use only
` *************************************

SEARCH_MapWidth# = 0
SEARCH_MapHeight# = 0
SEARCH_MaxPaths# = 0
dim SEARCH_CurrentPositionx(1)
dim SEARCH_CurrentPositiony(1)

` This is used for the new HEAP format using in A*
SEARCH_OpenListSize# = 0

` These are used for the flood4 search
SEARCH_OpenListTop# = 0
SEARCH_OpenListBottom# = 0

` Optimisation for flood4 search system
dim SEARCH_PreviousStartx(1)
dim SEARCH_PreviousStarty(1)

` General search parameters
SEARCH_RestrictedDiagonals# = 0
SEARCH_MaximumCost# = 0
SEARCH_ParametersChanged# = 0
SEARCH_LastSearch# = 0

dim SEARCH_SearchPathx(SEARCH_MapPaths,SEARCH_MapWIDTH * SEARCH_MapHeight)
dim SEARCH_SearchPathy(SEARCH_MapPaths,SEARCH_MapWIDTH * SEARCH_MapHeight)

` Note: these dims never actually get run - they are just here to declare the existance of the
`       arrays.
`       They are actually dimensioned in the Create* functions.
`       *This* is how you declare arrays in included files, and arrays where you don't know the
`       dimensions to use until run-time.

dim SEARCH_Map(SEARCH_MapWidth, SEARCH_MapHeight)

dim SEARCH_TileInfo_Stat(SEARCH_MapWidth, SEARCH_MapHeight) 
dim SEARCH_TileInfo_G(SEARCH_MapWidth, SEARCH_MapHeight)
dim SEARCH_TileInfo_H(SEARCH_MapWidth, SEARCH_MapHeight)
dim SEARCH_TileInfo_F(SEARCH_MapWidth, SEARCH_MapHeight)
dim SEARCH_TileInfo_ParX(SEARCH_MapWidth, SEARCH_MapHeight)
dim SEARCH_TileInfo_ParY(SEARCH_MapWidth, SEARCH_MapHeight)

dim SEARCH_OpenList_Stat(SEARCH_MapWidth * SEARCH_MapHeight)
dim SEARCH_OpenList_G(SEARCH_MapWidth * SEARCH_MapHeight)
dim SEARCH_OpenList_H(SEARCH_MapWidth * SEARCH_MapHeight)
dim SEARCH_OpenList_F(SEARCH_MapWidth * SEARCH_MapHeight)
dim SEARCH_OpenList_ParX(SEARCH_MapWidth * SEARCH_MapHeight)
dim SEARCH_OpenList_ParY(SEARCH_MapWidth * SEARCH_MapHeight)

dim SEARCH_SearchPath_Stat(SEARCH_MaxPaths, SEARCH_MapWidth * SEARCH_MapHeight)
dim SEARCH_SearchPath_G(SEARCH_MaxPaths, SEARCH_MapWidth * SEARCH_MapHeight)
dim SEARCH_SearchPath_H(SEARCH_MaxPaths, SEARCH_MapWidth * SEARCH_MapHeight)
dim SEARCH_SearchPath_F(SEARCH_MaxPaths, SEARCH_MapWidth * SEARCH_MapHeight)
dim SEARCH_SearchPath_ParX(SEARCH_MaxPaths, SEARCH_MapWidth * SEARCH_MapHeight)
dim SEARCH_SearchPath_ParY(SEARCH_MaxPaths, SEARCH_MapWidth * SEARCH_MapHeight)

dim SEARCH_PathSize(SEARCH_MaxPath)

` Initialised flags - by default DBPro sets them to zero. If they are not zero, then
` we are initialised.
SEARCH_PathsInitialised# = 0
SEARCH_MapInitialised# = 0

` ****************
` Public functions
` ****************

function CreateSearchMap(X#,Y#)
   SEARCH_MapWidth = X#
   SEARCH_MapHeight = Y#

SEARCH_PreviousStartx(1) = -9999
   SEARCH_PreviousStarty(1) = -9999

undim SEARCH_Map()
   undim SEARCH_TileInfo_Stat()
   undim SEARCH_TileInfo_G()
   undim SEARCH_TileInfo_H()
   undim SEARCH_TileInfo_F()
   undim SEARCH_TileInfo_ParX()
   undim SEARCH_TileInfo_ParY()

undim SEARCH_OpenList_Stat()
   undim SEARCH_OpenList_G()
   undim SEARCH_OpenList_H()
   undim SEARCH_OpenList_F()
   undim SEARCH_OpenList_ParX()
   undim SEARCH_OpenList_ParY()

dim SEARCH_Map#(X#,Y#)

dim SEARCH_TileInfo_Stat(X#,Y#)
   dim SEARCH_TileInfo_G(X#,Y#)
   dim SEARCH_TileInfo_H(X#,Y#)
   dim SEARCH_TileInfo_F(X#,Y#)
   dim SEARCH_TileInfo_ParX(X#,Y#)
   dim SEARCH_TileInfo_ParY(X#,Y#)

dim SEARCH_OpenList_Stat(X# * Y#)
   dim SEARCH_OpenList_G(X# * Y#)
   dim SEARCH_OpenList_H(X# * Y#)
   dim SEARCH_OpenList_F(X# * Y#)
   dim SEARCH_OpenList_ParX(X# * Y#)
   dim SEARCH_OpenList_ParY(X# * Y#)

SEARCH_MapInitialised=1
endfunction

function CreateSearchPathLists(Paths#)
   SEARCH_MaxPaths = Paths#

undim SEARCH_SearchPath_Stat()
	undim SEARCH_SearchPath_G()
   undim SEARCH_SearchPath_H()
	undim SEARCH_SearchPath_F()
   undim SEARCH_SearchPath_ParX()
	undim SEARCH_SearchPath_ParY()
   undim SEARCH_PathSize()

dim SEARCH_SearchPathx(SEARCH_MapPaths,SEARCH_MapWIDTH * SEARCH_MapHeight)
   dim SEARCH_SearchPathy(SEARCH_MapPaths,SEARCH_MapWIDTH * SEARCH_MapHeight)

dim SEARCH_PathSize(SEARCH_MaxPaths)

SEARCH_PathsInitialised = 1
endfunction

function SetSearchMap(X#,Y#,Value#)
   if SEARCH_MapInitialised = 0 then exitfunction
   if X# < 0 or X# >= SEARCH_MapWidth then exitfunction
   if Y# < 0 or Y# >= SEARCH_MapHeight then exitfunction
   SEARCH_PreviousStartx(1) = -9999
   SEARCH_Map(X#,Y#) = Value#
endfunction

function GetSearchMap(X#,Y#)
   if SEARCH_MapInitialised = 0 then exitfunction
   if X# < 0 or X# >= SEARCH_MapWidth then exitfunction 0
   if Y# < 0 or Y# >= SEARCH_MapHeight then exitfunction 0
   exitfunction SEARCH_Map(X#,Y#)
endfunction 0

function GetSearchPathX(Path#,Move#)
   if SEARCH_PathsInitialised = 0 then exitfunction -1
   if Path# < 0 or Path# > SEARCH_MaxPaths then exitfunction -1
   if Move# < 0 or Move# > SEARCH_PathSize(Path#) then exitfunction -1
   exitfunction SEARCH_SearchPathx(Path, SEARCH_PathSize(Path)-Move)
endfunction -1

function GetSearchPathY(Path#,Move#)
   if SEARCH_PathsInitialised = 0 then exitfunction -1
   if Path# < 0 or Path# > SEARCH_MaxPaths then exitfunction -1
   if Move# < 0 or Move# > SEARCH_PathSize(Path#) then exitfunction -1
   exitfunction SEARCH_SearchPathy(Path, SEARCH_PathSize(Path)-Move)
endfunction -1

function SearchPathSize(Path#)
   if SEARCH_PathsInitialised = 0 then exitfunction -1
   if Path# >= 0 or Path# <= SEARCH_MaxPaths then exitfunction SEARCH_PathSize(Path#)
endfunction -1

function SetSearchRestrictDiagonals(Mode#)
   if SEARCH_RestrictedDiagonals <> Mode#
      SEARCH_RestrictedDiagonals = Mode#
      SEARCH_ParametersChanged = 1
   endif
endfunction

function SetSearchMaximumCost(Cost#)
   if SEARCH_MaximumCost <> Cost#*10
      SEARCH_MaximumCost = Cost# * 10
      SEARCH_ParametersChanged = 1
   endif
endfunction

function SearchMapAStar4(Path#,SX#,SY#,TX#,TY#)
   locX# = 0
   locY# = 0
   locXOffset# = 0
   locYOffset# = 0
   locNewCost# = 0

if SEARCH_MapInitialised = 0 then exitfunction -1
   if SEARCH_PathsInitialised = 0 then exitfunction -1
   if Path# < 0 or Path# > SEARCH_MaxPaths then exitfunction -1

SEARCH_LastSearch = 0
   SEARCH_InitialiseTileInfo(SX#,SY#)

while SEARCH_GetLowestCostOpen() > 0

for locXOffset# = -1 to 1

locX# = SEARCH_CurrentPositionx(1) + locXOffset#
         if locX# >= 0 and locX# < SEARCH_MapWidth

for locYOffset# = -1 to 1

if (locXOffset# = 0) and (locYOffset# = 0)
                  locY# = SEARCH_CurrentPositiony(1) + locYOffset#

if locY# >= 0 and locY# < SEARCH_MapHeight

if SEARCH_TileInfo_Stat(locX#,locY#) = 0
                        SEARCH_TileInfo_ParX(locX#,locY#) = SEARCH_CurrentPositionx(1)
                        SEARCH_TileInfo_ParY(locX#,locY#) = SEARCH_CurrentPositiony(1)
                        if locX# = TX# then if locY# = TY# then exitfunction SEARCH_BuildPath(Path#,SX#,SY#,TX#,TY#)
                        SEARCH_TileInfo_G(locX#,locY#) = SEARCH_TileInfo_G(SEARCH_CurrentPositionx(1),SEARCH_CurrentPositiony(1))  + 10
                        SEARCH_TileInfo_H(locX#,locY#) = SEARCH_EstimateDistance(locX#,locY#,TX#,TY#)
                        SEARCH_TileInfo_F(locX#,locY#) = SEARCH_TileInfo_G(locX#,locY#) + SEARCH_TileInfo_H(locX#,locY#)
                        if SEARCH_MaximumCost = 0 or Cost < SEARCH_MaximumCost
                           SEARCH_AddToOpenList(locX#,locY#)
                           SEARCH_TileInfo_Stat(locX#,locY#) = 1
                        endif
                     else
                        if SEARCH_TileInfo_Stat(locX#,locY#) = 1
                           NewCost = SEARCH_TileInfo_G(SEARCH_CurrentPositionx(1),SEARCH_CurrentPositiony(1)) + 10
                           if SEARCH_TileInfo_G(locX#,locY#) > NewCost
                              SEARCH_TileInfo_ParX(locX#,locY#) = SEARCH_CurrentPositionx(1)
                              SEARCH_TileInfo_Pary(locX#,locY#) = SEARCH_CurrentPositiony(1)
                              SEARCH_TileInfo_G(locX#,locY#) = NewCost
                              SEARCH_TileInfo_F(locX#,locY#) = NewCost + SEARCH_TileInfo_H(locX#,locY#)
                              SEARCH_AddToOpenList(locX#,locY#)
                           endif
                        endif
                     endif
                  endif
               endif
            next locYOffset#
         endif
      next locXOffset#
   endwhile

exitfunction SEARCH_ClearPath(Path#,SX#,SY#)
endfunction 0

function SearchMapAStar8(Path#,SX#,SY#,TX#,TY#)
   locX# = 0
   locY# = 0
   locXOffset# = 0
   locYOffset# = 0
   locNewCost# = 0

if SEARCH_MapInitialised = 0 then exitfunction -1
   if SEARCH_PathsInitialised = 0 then exitfunction -1
   if Path# < 0 or Path# > SEARCH_MaxPaths then exitfunction -1

SEARCH_LastSearch = 1
   SEARCH_InitialiseTileInfo(SX#,SY#)

while SEARCH_GetLowestCostOpen() > 0

for locXOffset# = -1 to 1

locX# = SEARCH_CurrentPositionx(1) + locXOffset#
         if locX# >= 0 and X < SEARCH_MapWidth

for locYOffset# = -1 to 1

if ( (locXOffset# < 0) or ( (locXOffset# > 0) ) or (locYOffset# < 0) )
                  Y = SEARCH_CurrentPositiony(1) + locYOffset#

if ( (locXOffset# = 0) or (locYOffset# = 0) )
                     Y=-1
                  else
                     ` Restrict diagonals
                     if SEARCH_RestrictedDiagonals
                        if locXOffset# <> 0 then if locYOffset# <> 0
                           if SEARCH_TileInfo_Stat(locX#, SEARCH_CurrentPositiony(1)) = 2
                              ` This bit depends on Y *not* being set to -1
                              if SEARCH_TileInfo_Stat(SEARCH_CurrentPositionx(1), locY#) = 2
                                 locY#=-1
                              endif
                           endif
                        endif
                     endif
                  endif

if locY# >= 0 and locY# < SEARCH_MapHeight

if SEARCH_TileInfo_Stat(locX#,locY#) = 0
                        SEARCH_TileInfo_ParX(locX#,locY#) = SEARCH_CurrentPositionx(1)
                        SEARCH_TileInfo_ParY(locX#,locY#) = SEARCH_CurrentPositiony(1)
                        if locX# = TX# then if locY# = TY# then exitfunction SEARCH_BuildPath(Path#,SX#,SY#,TX#,TY#)
                        SEARCH_TileInfo_G(locX#,locY#) = SEARCH_TileInfo_G(SEARCH_CurrentPositionx(1),SEARCH_CurrentPositiony(1)) + SEARCH_SingleStepCost(locXOffset#,locYOffset#)
                        SEARCH_TileInfo_H(locX#,locY#) = SEARCH_EstimateDistance(locX#,locY#,TX#,TY#)
                        SEARCH_TileInfo_F(locX#,locY#) = SEARCH_TileInfo_G(locX#,locY#) + SEARCH_TileInfo_H(locX#,locY#)
                        if SEARCH_MaximumCost = 0 or SEARCH_TileInfo_G(locX#,locY#) < SEARCH_MaximumCost
                           SEARCH_AddToOpenList(locX#,locY#)
                           SEARCH_TileInfo_Stat(locX#,locY#) = 1
                        endif
                     else
                        if SEARCH_TileInfo_Stat(locX#,locY#) = 1
                           NewCost = SEARCH_TileInfo_G(SEARCH_CurrentPositionx(1),SEARCH_CurrentPositiony(1) + SEARCH_SingleStepCost(locXOffset#,locYOffset#))
                           if SEARCH_TileInfo_G(locX#,locY#) > NewCost
                              SEARCH_TileInfo_ParX(locX#,locY#) = SEARCH_CurrentPositionx(1)
                              SEARCH_TileInfo_ParY(locX#,locY#) = SEARCH_CurrentPositiony(1)
                              SEARCH_TileInfo_G(locX#,locY#) = NewCost
                              SEARCH_TileInfo_F(locX#,locY#) = NewCost + SEARCH_TileInfo_H(locX#,locY#)
                              SEARCH_AddToOpenList(locX#,locY#)
                           endif
                        endif
                     endif

endif
               endif

next locYOffset#

endif

next locXOffset#
   endwhile

exitfunction SEARCH_ClearPath(Path#,SX#,SY#)
endfunction 0

function SearchMapFlood4(Path#,SX#,SY#,TX#,TY#)
   locXOffset# = 0
   locYOffset# = 0
   locX# = 0
   locY# = 0

if SEARCH_MapInitialised = 0 then exitfunction -1
   if SEARCH_PathsInitialised = 0 then exitfunction -1
   if Path# < 0 or Path# > SEARCH_MaxPaths then exitfunction -1

if SEARCH_ParametersChanged = 1 or SEARCH_LastSearch <> 2
      SEARCH_ParametersChanged = 0
      SEARCH_PreviousStartx(1) = -9999
      SEARCH_LastSearch = 2
   endif

if SX <> SEARCH_PreviousStartx(1) or SY <> SEARCH_PreviousStarty(1)
      SEARCH_PreviousStartx(1) = SX
      SEARCH_PreviousStartx(1) = SY

SEARCH_PopulateTileInfo()

SEARCH_OpenListTop=-1
      SEARCH_OpenListBottom=-1

SEARCH_TileInfo_Stat( SX#, SY# ) = 1
      SEARCH_TileInfo_ParX( SX#, SY# ) = SX#
      SEARCH_TileInfo_ParY( SX#, SY# ) = SY#
      SEARCH_TileInfo_F( SX#, SY# ) = 0
      SEARCH_QueueOntoOpen(SX#, SY#)

while SEARCH_UnqueueFromOpen() > 0
         for locXOffset# = -1 to 1

locX# = SEARCH_CurrentPositionx(1) + locXOffset#
            if locX# >= 0 and locX# < SEARCH_MapWidth

for locYOffset# = -1 to 1

if ( (locXOffset# = 0) and (locYOffset# = 0) )
                     locY# = SEARCH_CurrentPositiony(1) + locYOffset#

if locY# >= 0 and locY# < SEARCH_MapHeight

if SEARCH_TileInfo_Stat( locX#, locY# ) = 0
                           SEARCH_TileInfo_Stat( locX#, locY# ) = 1
                           SEARCH_TileInfo_ParX( locX#, locY# ) = SEARCH_CurrentPositionx(1)
                           SEARCH_TileInfo_ParY( locX#, locY# ) = SEARCH_CurrentPositiony(1)
                           SEARCH_TileInfo_F( locX#, locY# ) = SEARCH_TileInfo_F( SEARCH_CurrentPositionx(1), SEARCH_CurrentPositiony(1) ) + 10
                           if SEARCH_MaximumCost = 0 or SEARCH_TileInfo_F( locX#, locY# ) < SEARCH_MaximumCost
                              SEARCH_QueueOntoOpen(locX#, locY#)
                           endif
                        endif

endif
                  endif

next locYOffset#

endif

next locXOffset#

endwhile
   endif

if SEARCH_TileInfo_Stat(TX#,TY#) > 0 then exitfunction SEARCH_BuildPath(Path#,SX#,SY#,TX#,TY#)

exitfunction SEARCH_ClearPath(Path#,SX#,SY#)
endfunction 0

function SearchMapFlood8(Path#, SX#, SY#, TX#, TY#)
   locXOffset# = 0
   locYOffset = 0
   locX = 0
   locY = 0
   locCost = 0

if SEARCH_MapInitialised = 0 then exitfunction -1
   if SEARCH_PathsInitialised = 0 then exitfunction -1
   if Path# < 0 or Path# > SEARCH_MaxPaths then exitfunction -1

if SEARCH_ParametersChanged = 1 or SEARCH_LastSearch <> 3
      SEARCH_ParametersChanged = 0
      SEARCH_PreviousStartx(1) = -9999
      SEARCH_LastSearch = 3
   endif

if SX# <> SEARCH_PreviousStartx(1) or SY# <> SEARCH_PreviousStarty(1)
      SEARCH_PreviousStartx(1) = SX#
      SEARCH_PreviousStarty(1) = SY#

SEARCH_PopulateTileInfo()

SEARCH_TileInfo_Stat( SX#, SY# ) = 1
      SEARCH_TileInfo_ParX( SX#, SY# ) = SX#
      SEARCH_TileInfo_ParY( SX#, SY# ) = SY#
      SEARCH_TileInfo_F( SX#, SY# ) = 0
      SEARCH_AddToOpenList(SX#,SY#)

SEARCH_SearchMode = 0

while SEARCH_GetLowestCostOpen() > 0
         for locXOffset# = -1 to 1

locX# = SEARCH_CurrentPositionx(1) + locXOffset#

if locX# >= 0 and locX# < SEARCH_MapWidth

for locYOffset# = -1 to 1

locY# = SEARCH_CurrentPositiony(1) + locYOffset#

` Not the current cell (offsets both zero)
                  if ( (locXOffset# = 0) or (YOffset# = 0) )
                     locY#=-1
                  else
                     ` Restrict diagonals
                     if SEARCH_RestrictedDiagonals
                        if locXOffset# <> 0 then if locYOffset# <> 0
                           if SEARCH_TileInfo_Stat(locX#, SEARCH_CurrentPositiony(1)) = 2
                              ` This bit depends on Y *not* being set to -1
                              if SEARCH_TileInfo_Stat(SEARCH_CurrentPositionx(1), locY#) = 2
                                 locY#=-1
                              endif
                           endif
                        endif
                     endif
                  endif

if locY# >= 0 then if locY# < SEARCH_MapHeight then if SEARCH_TileInfo_Stat(locX#,locY#) = 0
                     SEARCH_TileInfo_Stat( locX#, locY# ) = 1
                     SEARCH_TileInfo_ParX( locX#, locY# ) = SEARCH_CurrentPositionx(1)
                     SEARCH_TileInfo_ParY( locX#, locY# ) = SEARCH_CurrentPositiony(1)
                     Cost = SEARCH_TileInfo_F( SEARCH_CurrentPositionx(1), SEARCH_CurrentPositiony(1)) + SEARCH_SingleStepCost(locXOffset#,locYOffset#)
                     SEARCH_TileInfo_F( locX#, locY# ) = Cost#
                     if SEARCH_MaximumCost = 0 or Cost# < SEARCH_MaximumCost
                        SEARCH_AddToOpenList(locX#,locY#)
                     endif
                  endif

next locYOffset#

endif

next locXOffset#

endwhile
   endif

if SEARCH_TileInfo_Stat(TX#,TY#) > 0 then exitfunction SEARCH_BuildPath(Path#,SX#,SY#,TX#,TY#)

exitfunction SEARCH_ClearPath(Path#,SX#,SY#)
endfunction 0

function GetFloodCost(TX#, TY#)
   if SEARCH_MapInitialised = 0 then exitfunction -1
   if SEARCH_PathsInitialised = 0 then exitfunction -1
   if SEARCH_PreviousStartx(1) <> -9999 then exitfunction SEARCH_TileInfo_F(TX#,TY#)
endfunction -1

` **********************
` Internal-use functions
` **********************

function SEARCH_SingleStepCost(X#, Y#)
   if X# = 0 or Y# = 0 then exitfunction 10
endfunction 14

function SEARCH_EstimateDistance(X#, Y#, TX#, TY#)
   locDistance# = 0
   locDistance# = (abs(X# - TX#) + abs(Y# - TY#))*10
endfunction locDistance#

function SEARCH_InitialiseTileInfo(SX#, SY#)
   SEARCH_OpenListSize=0

SEARCH_PopulateTileInfo()

SEARCH_TileInfo_G(SX#, SY#) = 0
   SEARCH_TileInfo_H(SX#, SY#) = SEARCH_EstimateDistance(SX#, SY#, TX#, TY#)
   SEARCH_TileInfo_F(SX#, SY#) = SEARCH_TileInfo_H(SX#, SY#)
   SEARCH_TileInfo_Stat(SX#, SY#) = 1
   SEARCH_TileInfo_ParX(SX#, SY#) = SX#
   SEARCH_TileInfo_ParY(SX#, SY#) = SY#

SEARCH_AddToOpenList(SX#, SY#)
endfunction

function SEARCH_PopulateTileInfo()
   locX# = 0
   locY# = 0

for locX# = 0 to SEARCH_MapWidth
      for locY# = 0 to SEARCH_MapHeight
         SEARCH_TileInfo_F(locX#,locY#) = 0
         if SEARCH_Map(locX#,locY#) > 0
            SEARCH_TileInfo_Stat(locX#,locY#) = 2
         else
            SEARCH_TileInfo_Stat(locX#,locY#) = 0
         endif
      next locY#
   next locX#
endfunction

function SEARCH_AddToOpenList(X#, Y#)
   locParent = 0
   locChild = 0
   locCost = 0

locChild# = SEARCH_OpenListSize
   inc SEARCH_OpenListSize

locCost# = SEARCH_TileInfo_F(X#,Y#)

do
      if locChild# <= 0 then exit

locParent#=(locChild# - 1)/2

if SEARCH_OpenList_F(locParent#) < locCost# then exit

`      FASTSWAP_OFF
         SEARCH_OpenListItemf(locChild#) = SEARCH_OpenListItemf(locParent#)
         SEARCH_OpenListItemx(locChild#) = SEARCH_OpenListItemx(locParent#)
         SEARCH_OpenListItemy(locChild#) = SEARCH_OpenListItemy(locParent#)
`      FASTSWAP_ON
`         swap array items SEARCH_OpenList(), locChild#, locParent#
`      FASTSWAP_END

locChild# = locParent#
   loop

SEARCH_OpenListItemf(locChild#) = locCost#
   SEARCH_OpenListItemx(locChild#) = X#
   SEARCH_OpenListItemy(locChild#) = Y#
endfunction

function SEARCH_GetLowestCostOpen()
   locParent# = 0
   locChild# = 0
   locCost# = 0

if SEARCH_OpenListSize <= 0 then exitfunction 0

dec SEARCH_OpenListSize

SEARCH_CurrentPositionx(1) = SEARCH_OpenListItemx(0)
   SEARCH_CurrentPositiony(1) = SEARCH_OpenListItemy(0)

Cost = SEARCH_OpenList_F( SEARCH_OpenListSize )

`   FASTSWAP_OFF
      X = SEARCH_OpenListItemx( SEARCH_OpenListSize )
      Y = SEARCH_OpenListitemy( SEARCH_OpenListSize )
`   FASTSWAP_ON
`   FASTSWAP_END

locParent#=0
   do
      locChild#=(2 * locParent#) + 1
      if locChild# >= SEARCH_OpenListSize then exit

if locChild#+1 < SEARCH_OpenListSize
         if SEARCH_OpenList_F(locChild#) > SEARCH_OpenList_F(locChild# + 1) then inc locChild#
      endif

if SEARCH_OpenList_F(locChild#) < locCost#

`         FASTSWAP_OFF
            SEARCH_OpenListItemf(locParent#) = SEARCH_OpenListItemf(locChild#)
            SEARCH_OpenListItemx(locParent#) = SEARCH_OpenListItemx(locChild#)
            SEARCH_OpenListItemy(locParent#) = SEARCH_OpenListItemy(locChild#)
`         FASTSWAP_ON
`            swap array items SEARCH_OpenList(), locChild#, locParent#
`         FASTSWAP_END

locParent# = locChild#
      else
         exit
      endif
   loop

`   FASTSWAP_OFF
      SEARCH_OpenListItemf(locParent#) = locCost#
      SEARCH_OpenListItemx(locParent#) = X
      SEARCH_OpenListItemy(locParent#) = Y
`   FASTSWAP_ON
`      swap array items SEARCH_OpenList(), locParent#, SEARCH_OpenListSize
`   FASTSWAP_END

if SEARCH_TileInfo_Stat(SEARCH_CurrentPositionx(1),SEARCH_CurrentPositiony(1)) = 2 then exitfunction SEARCH_GetLowestCostOpen()

SEARCH_TileInfo_Stat(SEARCH_CurrentPositionx(1),SEARCH_CurrentPositiony(1)) = 2
endfunction 1

function SEARCH_QueueOntoOpen(X#, Y#)
   inc SEARCH_OpenListTop
   SEARCH_OpenListItemx( SEARCH_OpenListTop ) = X#
   SEARCH_OpenListItemy( SEARCH_OpenListTop ) = Y#
endfunction

function SEARCH_UnqueueFromOpen()
   if SEARCH_OpenListBottom => SEARCH_OpenListTop then exitfunction 0

inc SEARCH_OpenListBottom
   SEARCH_CurrentPositionx(1) = SEARCH_OpenListItemx( SEARCH_OpenListBottom )
   SEARCH_CurrentPositiony(1) = SEARCH_OpenListItemy( SEARCH_OpenListBottom )
endfunction 1

function SEARCH_BuildPath(Path#, SX#, SY#, TX#, TY#)
   Moves# = 0
   X# = TX#
   Y# = TY#
   SEARCH_SearchPathx(Path#, Moves#) = X#
   SEARCH_SearchPathy(Path#, Moves#) = Y#

repeat
      inc Moves#
      SEARCH_SearchPathx(Path#, Moves#) = SEARCH_TileInfo_ParX(X#,Y#)
      SEARCH_SearchPathy(Path#, Moves#) = SEARCH_TileInfo_ParY(X#,Y#)
      X# = SEARCH_SearchPathx(Path#, Moves#)
      Y# = SEARCH_SearchPathy(Path#, Moves#)
   until X# = SX# and Y# = SY#

SEARCH_PathSize(Path#) = Moves#
endfunction Moves

function SEARCH_ClearPath(Path#, SX#, SY#)
   SEARCH_SearchPathx(Path#, 0)=SX#
   SEARCH_SearchPathy(Path#, 1)=SY#
   SEARCH_PathSize(Path#)=0
endfunction 0

+ Code Snippet

` MapAndSearch.dba

` Map and search routines

remstart
AVAILABLE FUNCTIONS*********************************************************************

CreateSearchMap(Width,Height)
   Create the map of the size specified

CreateSearchPathList(NoOfPaths)
   Create the paths of the quantity specified

SetSearchMap(X,Y,Value)
   Set an entry within the map (> 0 is not walkable)

GetSearchMap(X,Y)
   Read an entry from the map

GetSearchPathX(Path,Move)
   Get a X coordinate from the path specified

GetSearchPathY(Path,Move)
   Get a Y coordinate from the path specified

SearchPathSize(Path)
   Get the length of the specified path

SetSearchRestrictDiagonals(Mode)
   Only affects the 8 diection searches. If set to non-zero, will avoid diagonals
   between blocked cells.

SetMaximumCost(Cost)
   Will stop searching if the target is not reached within the required cost. Set to
   zero to deactivate.

SearchMapAStar4(Path,StartX,StartY,FinishX,FinishY)
   Run an 4 direction A* search, and store the results within the selected path

SearchMapAStar8(Path,StartX,StartY,FinishX,FinishY)
   Run an 8 direction A* search, and store the results within the selected path

SearchMapFlood4(Path,StartX,StartY,FinishX,FinishY)
   Run a 4 direction flood search, and store the results within the selected path

SearchMapFlood8(Path,StartX,StartY,FinishX,FinishY)
   Run an 8 direction flood search, and store the results within the selected path

GetFloodCost(FinishX,FinishY)
   Uses the previous Flood4 search to identify the cost of the specified target

****************************************************************************************
remend

` ***********************
` Conditional Compilation
` ***********************

` Uncomment these three lines and comment the following three to enable the 'swap array items'.
` This command is a part of the matrix1array TPC DLL, and makes this stuff marginally faster.
`#constant FASTSWAP_OFF  :
`#constant FASTSWAP_ON   remstart
`#constant FASTSWAP_END  remend
`#constant FASTSWAP_OFF  remstart
`#constant FASTSWAP_ON   remend
`#constant FASTSWAP_END  :


` ********************
` UDTs used internally
` ********************

dim SEARCH_Positionx(1,1)
dim SEARCH_Positiony(1,1)

` Status,G,H,F,ParentX,ParentY
dim SEARCH_TileInformation(1)


` F,X,Y
dim SEARCH_OpenListItemf(1)
dim SEARCH_OpenListItemx(1)
dim SEARCH_OpenListItemy(1)

` *************************************
` Global variables for library use only
` *************************************

SEARCH_MapWidth# = 0
SEARCH_MapHeight# = 0
SEARCH_MaxPaths# = 0
dim SEARCH_CurrentPositionx(1)
dim SEARCH_CurrentPositiony(1)

` This is used for the new HEAP format using in A*
SEARCH_OpenListSize# = 0

` These are used for the flood4 search
SEARCH_OpenListTop# = 0
SEARCH_OpenListBottom# = 0

` Optimisation for flood4 search system
dim SEARCH_PreviousStartx(1)
dim SEARCH_PreviousStarty(1)

` General search parameters
SEARCH_RestrictedDiagonals# = 0
SEARCH_MaximumCost# = 0
SEARCH_ParametersChanged# = 0
SEARCH_LastSearch# = 0

dim SEARCH_SearchPathx(SEARCH_MapPaths,SEARCH_MapWIDTH * SEARCH_MapHeight)
dim SEARCH_SearchPathy(SEARCH_MapPaths,SEARCH_MapWIDTH * SEARCH_MapHeight)


` Note: these dims never actually get run - they are just here to declare the existance of the
`       arrays.
`       They are actually dimensioned in the Create* functions.
`       *This* is how you declare arrays in included files, and arrays where you don't know the
`       dimensions to use until run-time.

dim SEARCH_Map(SEARCH_MapWidth, SEARCH_MapHeight)

dim SEARCH_TileInfo_Stat(SEARCH_MapWidth, SEARCH_MapHeight) 
dim SEARCH_TileInfo_G(SEARCH_MapWidth, SEARCH_MapHeight)
dim SEARCH_TileInfo_H(SEARCH_MapWidth, SEARCH_MapHeight)
dim SEARCH_TileInfo_F(SEARCH_MapWidth, SEARCH_MapHeight)
dim SEARCH_TileInfo_ParX(SEARCH_MapWidth, SEARCH_MapHeight)
dim SEARCH_TileInfo_ParY(SEARCH_MapWidth, SEARCH_MapHeight)

dim SEARCH_OpenList_Stat(SEARCH_MapWidth * SEARCH_MapHeight)
dim SEARCH_OpenList_G(SEARCH_MapWidth * SEARCH_MapHeight)
dim SEARCH_OpenList_H(SEARCH_MapWidth * SEARCH_MapHeight)
dim SEARCH_OpenList_F(SEARCH_MapWidth * SEARCH_MapHeight)
dim SEARCH_OpenList_ParX(SEARCH_MapWidth * SEARCH_MapHeight)
dim SEARCH_OpenList_ParY(SEARCH_MapWidth * SEARCH_MapHeight)

dim SEARCH_SearchPath_Stat(SEARCH_MaxPaths, SEARCH_MapWidth * SEARCH_MapHeight)
dim SEARCH_SearchPath_G(SEARCH_MaxPaths, SEARCH_MapWidth * SEARCH_MapHeight)
dim SEARCH_SearchPath_H(SEARCH_MaxPaths, SEARCH_MapWidth * SEARCH_MapHeight)
dim SEARCH_SearchPath_F(SEARCH_MaxPaths, SEARCH_MapWidth * SEARCH_MapHeight)
dim SEARCH_SearchPath_ParX(SEARCH_MaxPaths, SEARCH_MapWidth * SEARCH_MapHeight)
dim SEARCH_SearchPath_ParY(SEARCH_MaxPaths, SEARCH_MapWidth * SEARCH_MapHeight)

dim SEARCH_PathSize(SEARCH_MaxPath)

` Initialised flags - by default DBPro sets them to zero. If they are not zero, then
` we are initialised.
SEARCH_PathsInitialised# = 0
SEARCH_MapInitialised# = 0

` ****************
` Public functions
` ****************

function CreateSearchMap(X#,Y#)
   SEARCH_MapWidth = X#
   SEARCH_MapHeight = Y#

   SEARCH_PreviousStartx(1) = -9999
   SEARCH_PreviousStarty(1) = -9999

   undim SEARCH_Map()
   undim SEARCH_TileInfo_Stat()
   undim SEARCH_TileInfo_G()
   undim SEARCH_TileInfo_H()
   undim SEARCH_TileInfo_F()
   undim SEARCH_TileInfo_ParX()
   undim SEARCH_TileInfo_ParY()

   undim SEARCH_OpenList_Stat()
   undim SEARCH_OpenList_G()
   undim SEARCH_OpenList_H()
   undim SEARCH_OpenList_F()
   undim SEARCH_OpenList_ParX()
   undim SEARCH_OpenList_ParY()

   dim SEARCH_Map#(X#,Y#)

   dim SEARCH_TileInfo_Stat(X#,Y#)
   dim SEARCH_TileInfo_G(X#,Y#)
   dim SEARCH_TileInfo_H(X#,Y#)
   dim SEARCH_TileInfo_F(X#,Y#)
   dim SEARCH_TileInfo_ParX(X#,Y#)
   dim SEARCH_TileInfo_ParY(X#,Y#)

   dim SEARCH_OpenList_Stat(X# * Y#)
   dim SEARCH_OpenList_G(X# * Y#)
   dim SEARCH_OpenList_H(X# * Y#)
   dim SEARCH_OpenList_F(X# * Y#)
   dim SEARCH_OpenList_ParX(X# * Y#)
   dim SEARCH_OpenList_ParY(X# * Y#)

   SEARCH_MapInitialised=1
endfunction

function CreateSearchPathLists(Paths#)
   SEARCH_MaxPaths = Paths#

   undim SEARCH_SearchPath_Stat()
	undim SEARCH_SearchPath_G()
   undim SEARCH_SearchPath_H()
	undim SEARCH_SearchPath_F()
   undim SEARCH_SearchPath_ParX()
	undim SEARCH_SearchPath_ParY()
   undim SEARCH_PathSize()

   dim SEARCH_SearchPathx(SEARCH_MapPaths,SEARCH_MapWIDTH * SEARCH_MapHeight)
   dim SEARCH_SearchPathy(SEARCH_MapPaths,SEARCH_MapWIDTH * SEARCH_MapHeight)

   dim SEARCH_PathSize(SEARCH_MaxPaths)

   SEARCH_PathsInitialised = 1
endfunction

function SetSearchMap(X#,Y#,Value#)
   if SEARCH_MapInitialised = 0 then exitfunction
   if X# < 0 or X# >= SEARCH_MapWidth then exitfunction
   if Y# < 0 or Y# >= SEARCH_MapHeight then exitfunction
   SEARCH_PreviousStartx(1) = -9999
   SEARCH_Map(X#,Y#) = Value#
endfunction

function GetSearchMap(X#,Y#)
   if SEARCH_MapInitialised = 0 then exitfunction
   if X# < 0 or X# >= SEARCH_MapWidth then exitfunction 0
   if Y# < 0 or Y# >= SEARCH_MapHeight then exitfunction 0
   exitfunction SEARCH_Map(X#,Y#)
endfunction 0

function GetSearchPathX(Path#,Move#)
   if SEARCH_PathsInitialised = 0 then exitfunction -1
   if Path# < 0 or Path# > SEARCH_MaxPaths then exitfunction -1
   if Move# < 0 or Move# > SEARCH_PathSize(Path#) then exitfunction -1
   exitfunction SEARCH_SearchPathx(Path, SEARCH_PathSize(Path)-Move)
endfunction -1

function GetSearchPathY(Path#,Move#)
   if SEARCH_PathsInitialised = 0 then exitfunction -1
   if Path# < 0 or Path# > SEARCH_MaxPaths then exitfunction -1
   if Move# < 0 or Move# > SEARCH_PathSize(Path#) then exitfunction -1
   exitfunction SEARCH_SearchPathy(Path, SEARCH_PathSize(Path)-Move)
endfunction -1

function SearchPathSize(Path#)
   if SEARCH_PathsInitialised = 0 then exitfunction -1
   if Path# >= 0 or Path# <= SEARCH_MaxPaths then exitfunction SEARCH_PathSize(Path#)
endfunction -1

function SetSearchRestrictDiagonals(Mode#)
   if SEARCH_RestrictedDiagonals <> Mode#
      SEARCH_RestrictedDiagonals = Mode#
      SEARCH_ParametersChanged = 1
   endif
endfunction

function SetSearchMaximumCost(Cost#)
   if SEARCH_MaximumCost <> Cost#*10
      SEARCH_MaximumCost = Cost# * 10
      SEARCH_ParametersChanged = 1
   endif
endfunction

function SearchMapAStar4(Path#,SX#,SY#,TX#,TY#)
   locX# = 0
   locY# = 0
   locXOffset# = 0
   locYOffset# = 0
   locNewCost# = 0

   if SEARCH_MapInitialised = 0 then exitfunction -1
   if SEARCH_PathsInitialised = 0 then exitfunction -1
   if Path# < 0 or Path# > SEARCH_MaxPaths then exitfunction -1

   SEARCH_LastSearch = 0
   SEARCH_InitialiseTileInfo(SX#,SY#)

   while SEARCH_GetLowestCostOpen() > 0

      for locXOffset# = -1 to 1

         locX# = SEARCH_CurrentPositionx(1) + locXOffset#
         if locX# >= 0 and locX# < SEARCH_MapWidth

            for locYOffset# = -1 to 1

              if (locXOffset# = 0) and (locYOffset# = 0)
                  locY# = SEARCH_CurrentPositiony(1) + locYOffset#

                  if locY# >= 0 and locY# < SEARCH_MapHeight

                     if SEARCH_TileInfo_Stat(locX#,locY#) = 0
                        SEARCH_TileInfo_ParX(locX#,locY#) = SEARCH_CurrentPositionx(1)
                        SEARCH_TileInfo_ParY(locX#,locY#) = SEARCH_CurrentPositiony(1)
                        if locX# = TX# then if locY# = TY# then exitfunction SEARCH_BuildPath(Path#,SX#,SY#,TX#,TY#)
                        SEARCH_TileInfo_G(locX#,locY#) = SEARCH_TileInfo_G(SEARCH_CurrentPositionx(1),SEARCH_CurrentPositiony(1))  + 10
                        SEARCH_TileInfo_H(locX#,locY#) = SEARCH_EstimateDistance(locX#,locY#,TX#,TY#)
                        SEARCH_TileInfo_F(locX#,locY#) = SEARCH_TileInfo_G(locX#,locY#) + SEARCH_TileInfo_H(locX#,locY#)
                        if SEARCH_MaximumCost = 0 or Cost < SEARCH_MaximumCost
                           SEARCH_AddToOpenList(locX#,locY#)
                           SEARCH_TileInfo_Stat(locX#,locY#) = 1
                        endif
                     else
                        if SEARCH_TileInfo_Stat(locX#,locY#) = 1
                           NewCost = SEARCH_TileInfo_G(SEARCH_CurrentPositionx(1),SEARCH_CurrentPositiony(1)) + 10
                           if SEARCH_TileInfo_G(locX#,locY#) > NewCost
                              SEARCH_TileInfo_ParX(locX#,locY#) = SEARCH_CurrentPositionx(1)
                              SEARCH_TileInfo_Pary(locX#,locY#) = SEARCH_CurrentPositiony(1)
                              SEARCH_TileInfo_G(locX#,locY#) = NewCost
                              SEARCH_TileInfo_F(locX#,locY#) = NewCost + SEARCH_TileInfo_H(locX#,locY#)
                              SEARCH_AddToOpenList(locX#,locY#)
                           endif
                        endif
                     endif
                  endif
               endif
            next locYOffset#
         endif
      next locXOffset#
   endwhile

   exitfunction SEARCH_ClearPath(Path#,SX#,SY#)
endfunction 0

function SearchMapAStar8(Path#,SX#,SY#,TX#,TY#)
   locX# = 0
   locY# = 0
   locXOffset# = 0
   locYOffset# = 0
   locNewCost# = 0

   if SEARCH_MapInitialised = 0 then exitfunction -1
   if SEARCH_PathsInitialised = 0 then exitfunction -1
   if Path# < 0 or Path# > SEARCH_MaxPaths then exitfunction -1

   SEARCH_LastSearch = 1
   SEARCH_InitialiseTileInfo(SX#,SY#)

   while SEARCH_GetLowestCostOpen() > 0

      for locXOffset# = -1 to 1

         locX# = SEARCH_CurrentPositionx(1) + locXOffset#
         if locX# >= 0 and X < SEARCH_MapWidth

            for locYOffset# = -1 to 1

               if ( (locXOffset# < 0) or ( (locXOffset# > 0) ) or (locYOffset# < 0) )
                  Y = SEARCH_CurrentPositiony(1) + locYOffset#

                  if ( (locXOffset# = 0) or (locYOffset# = 0) )
                     Y=-1
                  else
                     ` Restrict diagonals
                     if SEARCH_RestrictedDiagonals
                        if locXOffset# <> 0 then if locYOffset# <> 0
                           if SEARCH_TileInfo_Stat(locX#, SEARCH_CurrentPositiony(1)) = 2
                              ` This bit depends on Y *not* being set to -1
                              if SEARCH_TileInfo_Stat(SEARCH_CurrentPositionx(1), locY#) = 2
                                 locY#=-1
                              endif
                           endif
                        endif
                     endif
                  endif

                  if locY# >= 0 and locY# < SEARCH_MapHeight

                     if SEARCH_TileInfo_Stat(locX#,locY#) = 0
                        SEARCH_TileInfo_ParX(locX#,locY#) = SEARCH_CurrentPositionx(1)
                        SEARCH_TileInfo_ParY(locX#,locY#) = SEARCH_CurrentPositiony(1)
                        if locX# = TX# then if locY# = TY# then exitfunction SEARCH_BuildPath(Path#,SX#,SY#,TX#,TY#)
                        SEARCH_TileInfo_G(locX#,locY#) = SEARCH_TileInfo_G(SEARCH_CurrentPositionx(1),SEARCH_CurrentPositiony(1)) + SEARCH_SingleStepCost(locXOffset#,locYOffset#)
                        SEARCH_TileInfo_H(locX#,locY#) = SEARCH_EstimateDistance(locX#,locY#,TX#,TY#)
                        SEARCH_TileInfo_F(locX#,locY#) = SEARCH_TileInfo_G(locX#,locY#) + SEARCH_TileInfo_H(locX#,locY#)
                        if SEARCH_MaximumCost = 0 or SEARCH_TileInfo_G(locX#,locY#) < SEARCH_MaximumCost
                           SEARCH_AddToOpenList(locX#,locY#)
                           SEARCH_TileInfo_Stat(locX#,locY#) = 1
                        endif
                     else
                        if SEARCH_TileInfo_Stat(locX#,locY#) = 1
                           NewCost = SEARCH_TileInfo_G(SEARCH_CurrentPositionx(1),SEARCH_CurrentPositiony(1) + SEARCH_SingleStepCost(locXOffset#,locYOffset#))
                           if SEARCH_TileInfo_G(locX#,locY#) > NewCost
                              SEARCH_TileInfo_ParX(locX#,locY#) = SEARCH_CurrentPositionx(1)
                              SEARCH_TileInfo_ParY(locX#,locY#) = SEARCH_CurrentPositiony(1)
                              SEARCH_TileInfo_G(locX#,locY#) = NewCost
                              SEARCH_TileInfo_F(locX#,locY#) = NewCost + SEARCH_TileInfo_H(locX#,locY#)
                              SEARCH_AddToOpenList(locX#,locY#)
                           endif
                        endif
                     endif

                  endif
               endif

            next locYOffset#

         endif

      next locXOffset#
   endwhile

   exitfunction SEARCH_ClearPath(Path#,SX#,SY#)
endfunction 0

function SearchMapFlood4(Path#,SX#,SY#,TX#,TY#)
   locXOffset# = 0
   locYOffset# = 0
   locX# = 0
   locY# = 0

   if SEARCH_MapInitialised = 0 then exitfunction -1
   if SEARCH_PathsInitialised = 0 then exitfunction -1
   if Path# < 0 or Path# > SEARCH_MaxPaths then exitfunction -1

   if SEARCH_ParametersChanged = 1 or SEARCH_LastSearch <> 2
      SEARCH_ParametersChanged = 0
      SEARCH_PreviousStartx(1) = -9999
      SEARCH_LastSearch = 2
   endif

   if SX <> SEARCH_PreviousStartx(1) or SY <> SEARCH_PreviousStarty(1)
      SEARCH_PreviousStartx(1) = SX
      SEARCH_PreviousStartx(1) = SY

      SEARCH_PopulateTileInfo()

      SEARCH_OpenListTop=-1
      SEARCH_OpenListBottom=-1

      SEARCH_TileInfo_Stat( SX#, SY# ) = 1
      SEARCH_TileInfo_ParX( SX#, SY# ) = SX#
      SEARCH_TileInfo_ParY( SX#, SY# ) = SY#
      SEARCH_TileInfo_F( SX#, SY# ) = 0
      SEARCH_QueueOntoOpen(SX#, SY#)

      while SEARCH_UnqueueFromOpen() > 0
         for locXOffset# = -1 to 1

            locX# = SEARCH_CurrentPositionx(1) + locXOffset#
            if locX# >= 0 and locX# < SEARCH_MapWidth

               for locYOffset# = -1 to 1

                  if ( (locXOffset# = 0) and (locYOffset# = 0) )
                     locY# = SEARCH_CurrentPositiony(1) + locYOffset#

                     if locY# >= 0 and locY# < SEARCH_MapHeight

                        if SEARCH_TileInfo_Stat( locX#, locY# ) = 0
                           SEARCH_TileInfo_Stat( locX#, locY# ) = 1
                           SEARCH_TileInfo_ParX( locX#, locY# ) = SEARCH_CurrentPositionx(1)
                           SEARCH_TileInfo_ParY( locX#, locY# ) = SEARCH_CurrentPositiony(1)
                           SEARCH_TileInfo_F( locX#, locY# ) = SEARCH_TileInfo_F( SEARCH_CurrentPositionx(1), SEARCH_CurrentPositiony(1) ) + 10
                           if SEARCH_MaximumCost = 0 or SEARCH_TileInfo_F( locX#, locY# ) < SEARCH_MaximumCost
                              SEARCH_QueueOntoOpen(locX#, locY#)
                           endif
                        endif

                     endif
                  endif

               next locYOffset#

            endif

         next locXOffset#

      endwhile
   endif

   if SEARCH_TileInfo_Stat(TX#,TY#) > 0 then exitfunction SEARCH_BuildPath(Path#,SX#,SY#,TX#,TY#)

   exitfunction SEARCH_ClearPath(Path#,SX#,SY#)
endfunction 0

function SearchMapFlood8(Path#, SX#, SY#, TX#, TY#)
   locXOffset# = 0
   locYOffset = 0
   locX = 0
   locY = 0
   locCost = 0

   if SEARCH_MapInitialised = 0 then exitfunction -1
   if SEARCH_PathsInitialised = 0 then exitfunction -1
   if Path# < 0 or Path# > SEARCH_MaxPaths then exitfunction -1

   if SEARCH_ParametersChanged = 1 or SEARCH_LastSearch <> 3
      SEARCH_ParametersChanged = 0
      SEARCH_PreviousStartx(1) = -9999
      SEARCH_LastSearch = 3
   endif

   if SX# <> SEARCH_PreviousStartx(1) or SY# <> SEARCH_PreviousStarty(1)
      SEARCH_PreviousStartx(1) = SX#
      SEARCH_PreviousStarty(1) = SY#

      SEARCH_PopulateTileInfo()

      SEARCH_TileInfo_Stat( SX#, SY# ) = 1
      SEARCH_TileInfo_ParX( SX#, SY# ) = SX#
      SEARCH_TileInfo_ParY( SX#, SY# ) = SY#
      SEARCH_TileInfo_F( SX#, SY# ) = 0
      SEARCH_AddToOpenList(SX#,SY#)

      SEARCH_SearchMode = 0

      while SEARCH_GetLowestCostOpen() > 0
         for locXOffset# = -1 to 1

            locX# = SEARCH_CurrentPositionx(1) + locXOffset#

            if locX# >= 0 and locX# < SEARCH_MapWidth

               for locYOffset# = -1 to 1

                  locY# = SEARCH_CurrentPositiony(1) + locYOffset#

                  ` Not the current cell (offsets both zero)
                  if ( (locXOffset# = 0) or (YOffset# = 0) )
                     locY#=-1
                  else
                     ` Restrict diagonals
                     if SEARCH_RestrictedDiagonals
                        if locXOffset# <> 0 then if locYOffset# <> 0
                           if SEARCH_TileInfo_Stat(locX#, SEARCH_CurrentPositiony(1)) = 2
                              ` This bit depends on Y *not* being set to -1
                              if SEARCH_TileInfo_Stat(SEARCH_CurrentPositionx(1), locY#) = 2
                                 locY#=-1
                              endif
                           endif
                        endif
                     endif
                  endif

                  if locY# >= 0 then if locY# < SEARCH_MapHeight then if SEARCH_TileInfo_Stat(locX#,locY#) = 0
                     SEARCH_TileInfo_Stat( locX#, locY# ) = 1
                     SEARCH_TileInfo_ParX( locX#, locY# ) = SEARCH_CurrentPositionx(1)
                     SEARCH_TileInfo_ParY( locX#, locY# ) = SEARCH_CurrentPositiony(1)
                     Cost = SEARCH_TileInfo_F( SEARCH_CurrentPositionx(1), SEARCH_CurrentPositiony(1)) + SEARCH_SingleStepCost(locXOffset#,locYOffset#)
                     SEARCH_TileInfo_F( locX#, locY# ) = Cost#
                     if SEARCH_MaximumCost = 0 or Cost# < SEARCH_MaximumCost
                        SEARCH_AddToOpenList(locX#,locY#)
                     endif
                  endif

               next locYOffset#

            endif

         next locXOffset#

      endwhile
   endif

   if SEARCH_TileInfo_Stat(TX#,TY#) > 0 then exitfunction SEARCH_BuildPath(Path#,SX#,SY#,TX#,TY#)

   exitfunction SEARCH_ClearPath(Path#,SX#,SY#)
endfunction 0

function GetFloodCost(TX#, TY#)
   if SEARCH_MapInitialised = 0 then exitfunction -1
   if SEARCH_PathsInitialised = 0 then exitfunction -1
   if SEARCH_PreviousStartx(1) <> -9999 then exitfunction SEARCH_TileInfo_F(TX#,TY#)
endfunction -1

` **********************
` Internal-use functions
` **********************

function SEARCH_SingleStepCost(X#, Y#)
   if X# = 0 or Y# = 0 then exitfunction 10
endfunction 14

function SEARCH_EstimateDistance(X#, Y#, TX#, TY#)
   locDistance# = 0
   locDistance# = (abs(X# - TX#) + abs(Y# - TY#))*10
endfunction locDistance#

function SEARCH_InitialiseTileInfo(SX#, SY#)
   SEARCH_OpenListSize=0

   SEARCH_PopulateTileInfo()

   SEARCH_TileInfo_G(SX#, SY#) = 0
   SEARCH_TileInfo_H(SX#, SY#) = SEARCH_EstimateDistance(SX#, SY#, TX#, TY#)
   SEARCH_TileInfo_F(SX#, SY#) = SEARCH_TileInfo_H(SX#, SY#)
   SEARCH_TileInfo_Stat(SX#, SY#) = 1
   SEARCH_TileInfo_ParX(SX#, SY#) = SX#
   SEARCH_TileInfo_ParY(SX#, SY#) = SY#

   SEARCH_AddToOpenList(SX#, SY#)
endfunction

function SEARCH_PopulateTileInfo()
   locX# = 0
   locY# = 0

   for locX# = 0 to SEARCH_MapWidth
      for locY# = 0 to SEARCH_MapHeight
         SEARCH_TileInfo_F(locX#,locY#) = 0
         if SEARCH_Map(locX#,locY#) > 0
            SEARCH_TileInfo_Stat(locX#,locY#) = 2
         else
            SEARCH_TileInfo_Stat(locX#,locY#) = 0
         endif
      next locY#
   next locX#
endfunction

function SEARCH_AddToOpenList(X#, Y#)
   locParent = 0
   locChild = 0
   locCost = 0

   locChild# = SEARCH_OpenListSize
   inc SEARCH_OpenListSize

   locCost# = SEARCH_TileInfo_F(X#,Y#)

   do
      if locChild# <= 0 then exit

      locParent#=(locChild# - 1)/2

      if SEARCH_OpenList_F(locParent#) < locCost# then exit

`      FASTSWAP_OFF
         SEARCH_OpenListItemf(locChild#) = SEARCH_OpenListItemf(locParent#)
         SEARCH_OpenListItemx(locChild#) = SEARCH_OpenListItemx(locParent#)
         SEARCH_OpenListItemy(locChild#) = SEARCH_OpenListItemy(locParent#)
`      FASTSWAP_ON
`         swap array items SEARCH_OpenList(), locChild#, locParent#
`      FASTSWAP_END

      locChild# = locParent#
   loop

   SEARCH_OpenListItemf(locChild#) = locCost#
   SEARCH_OpenListItemx(locChild#) = X#
   SEARCH_OpenListItemy(locChild#) = Y#
endfunction

function SEARCH_GetLowestCostOpen()
   locParent# = 0
   locChild# = 0
   locCost# = 0

   if SEARCH_OpenListSize <= 0 then exitfunction 0

   dec SEARCH_OpenListSize

   SEARCH_CurrentPositionx(1) = SEARCH_OpenListItemx(0)
   SEARCH_CurrentPositiony(1) = SEARCH_OpenListItemy(0)

   Cost = SEARCH_OpenList_F( SEARCH_OpenListSize )

`   FASTSWAP_OFF
      X = SEARCH_OpenListItemx( SEARCH_OpenListSize )
      Y = SEARCH_OpenListitemy( SEARCH_OpenListSize )
`   FASTSWAP_ON
`   FASTSWAP_END

   locParent#=0
   do
      locChild#=(2 * locParent#) + 1
      if locChild# >= SEARCH_OpenListSize then exit

      if locChild#+1 < SEARCH_OpenListSize
         if SEARCH_OpenList_F(locChild#) > SEARCH_OpenList_F(locChild# + 1) then inc locChild#
      endif

      if SEARCH_OpenList_F(locChild#) < locCost#

`         FASTSWAP_OFF
            SEARCH_OpenListItemf(locParent#) = SEARCH_OpenListItemf(locChild#)
            SEARCH_OpenListItemx(locParent#) = SEARCH_OpenListItemx(locChild#)
            SEARCH_OpenListItemy(locParent#) = SEARCH_OpenListItemy(locChild#)
`         FASTSWAP_ON
`            swap array items SEARCH_OpenList(), locChild#, locParent#
`         FASTSWAP_END

         locParent# = locChild#
      else
         exit
      endif
   loop

`   FASTSWAP_OFF
      SEARCH_OpenListItemf(locParent#) = locCost#
      SEARCH_OpenListItemx(locParent#) = X
      SEARCH_OpenListItemy(locParent#) = Y
`   FASTSWAP_ON
`      swap array items SEARCH_OpenList(), locParent#, SEARCH_OpenListSize
`   FASTSWAP_END

   if SEARCH_TileInfo_Stat(SEARCH_CurrentPositionx(1),SEARCH_CurrentPositiony(1)) = 2 then exitfunction SEARCH_GetLowestCostOpen()

   SEARCH_TileInfo_Stat(SEARCH_CurrentPositionx(1),SEARCH_CurrentPositiony(1)) = 2
endfunction 1

function SEARCH_QueueOntoOpen(X#, Y#)
   inc SEARCH_OpenListTop
   SEARCH_OpenListItemx( SEARCH_OpenListTop ) = X#
   SEARCH_OpenListItemy( SEARCH_OpenListTop ) = Y#
endfunction

function SEARCH_UnqueueFromOpen()
   if SEARCH_OpenListBottom => SEARCH_OpenListTop then exitfunction 0

   inc SEARCH_OpenListBottom
   SEARCH_CurrentPositionx(1) = SEARCH_OpenListItemx( SEARCH_OpenListBottom )
   SEARCH_CurrentPositiony(1) = SEARCH_OpenListItemy( SEARCH_OpenListBottom )
endfunction 1

function SEARCH_BuildPath(Path#, SX#, SY#, TX#, TY#)
   Moves# = 0
   X# = TX#
   Y# = TY#
   SEARCH_SearchPathx(Path#, Moves#) = X#
   SEARCH_SearchPathy(Path#, Moves#) = Y#

   repeat
      inc Moves#
      SEARCH_SearchPathx(Path#, Moves#) = SEARCH_TileInfo_ParX(X#,Y#)
      SEARCH_SearchPathy(Path#, Moves#) = SEARCH_TileInfo_ParY(X#,Y#)
      X# = SEARCH_SearchPathx(Path#, Moves#)
      Y# = SEARCH_SearchPathy(Path#, Moves#)
   until X# = SX# and Y# = SY#

   SEARCH_PathSize(Path#) = Moves#
endfunction Moves

function SEARCH_ClearPath(Path#, SX#, SY#)
   SEARCH_SearchPathx(Path#, 0)=SX#
   SEARCH_SearchPathy(Path#, 1)=SY#
   SEARCH_PathSize(Path#)=0
endfunction 0

Back to top

Profile PM Email Website

Rob K

Retired Moderator

21

Years of Service

User Offline

Joined: 10th Sep 2002

Location: Surrey, United Kingdom

Posted: 14th Jun 2004 19:03

Link

Quote: "use integers (1.0,2.0,etc.)"

1.0, 2.0 is a float

- But I know what you mean.

BlueGUI:Windows UI Plugin - All the power of the windows interface in your DBPro games. - Plus URL download, win dialogs.
Over 140 new commands

Back to top

Profile PM Email Website

Mattman

20

Years of Service

User Offline

Joined: 5th Jun 2003

Location: East Lansing

Posted: 14th Jun 2004 19:47 Edited at: 14th Jun 2004 23:56

Link

whoops, thanks Rob, i just used # instead of whatever as integer. thanks

Back to top

Profile PM Email Website

IanM

Retired Moderator

21

Years of Service

User Offline

Joined: 11th Sep 2002

Location: In my moon base

Posted: 14th Jun 2004 20:45

Link

Nice one matt

You should be able to remove all the # signs though - the original code was totally integer based.

*** Coming soon - Network Plug-in - Check my site for info ***
For free Plug-ins, source and the Interface library for Visual C++ 6, .NET and now for Dev-C++ http://www.matrix1.demon.co.uk

Back to top

Profile PM Email Website

David T

Retired Moderator

21

Years of Service

User Offline

Joined: 27th Aug 2002

Location: England

Posted: 14th Jun 2004 20:49 Edited at: 14th Jun 2004 20:50

Link

Mattman's back...

I was wondering, I downloaded Ian's A* library but I didn't quite get the hang on it - can you explain the controls (pathetic I know, but hey

)?

Two strings walk into a bar. I'll have a pint says the first$%ASLDJ09920D"$"$D. Excuse my friend says the second, he isn't null terminated.

Back to top

Profile PM Email Website

IanM

Retired Moderator

21

Years of Service

User Offline

Joined: 11th Sep 2002

Location: In my moon base

Posted: 14th Jun 2004 22:18

Link

It's fairly simple

- Use the CreateSearchPath function to set the maps size
- Use the CreateSearchPathLists function to set a number of paths to store
- Use a series of SetSearchPath calls to set up areas of the map as unpassable

Everything is set up and ready to use at this point.

Then you can just call the SearchMap* function of your choice, specifying the start and end points on the grid, and a path number to store the path under.

You can also use the SetSearchRestrictDiagonals and SetSearchMaximumCost functions to set specific limits on the paths found.

*** Coming soon - Network Plug-in - Check my site for info ***
For free Plug-ins, source and the Interface library for Visual C++ 6, .NET and now for Dev-C++ http://www.matrix1.demon.co.uk

Back to top

Profile PM Email Website

David T

Retired Moderator

21

Years of Service

User Offline

Joined: 27th Aug 2002

Location: England

Posted: 14th Jun 2004 23:22

Link

Thanks, I'll have a look at it in due course

Two strings walk into a bar. I'll have a pint says the first$%ASLDJ09920D"$"$D. Excuse my friend says the second, he isn't null terminated.

Back to top

Profile PM Email Website

Mattman

20

Years of Service

User Offline

Joined: 5th Jun 2003

Location: East Lansing

Posted: 14th Jun 2004 23:28 Edited at: 14th Jun 2004 23:58

Link

Ya, in DBC go to edit, replace, then put # in the first box then nothing in the second one and it should work!

I was having some trouble using it though, all path data (path length, and the x and y coordinates of all the spaces) end up being -1

Any possible ideas why? I set up the map, creates a path, then ran a search with path number 1.

Back to top

Profile PM Email Website

IanM

Retired Moderator

21

Years of Service

User Offline

Joined: 11th Sep 2002

Location: In my moon base

Posted: 16th Jun 2004 16:04

Link

Is this what you wanted to chat about last night? In that case, I'd better reinstall DBC ready for when the little blue alert box pops up tonight then

*** Coming soon - Network Plug-in - Check my site for info ***
For free Plug-ins, source and the Interface library for Visual C++ 6, .NET and now for Dev-C++ http://www.matrix1.demon.co.uk

Back to top

Profile PM Email Website

Mattman

20

Years of Service

User Offline

Joined: 5th Jun 2003

Location: East Lansing

Posted: 16th Jun 2004 16:09

Link

Thanks ya, i let you sleep though, we can talk later today

"Could you do something where you don't need a video card cause i don't have one" - Program Expert

Back to top

Profile PM Email Website

BearCDPOLD

20

Years of Service

User Offline

Joined: 16th Oct 2003

Location: AZ,USA

Posted: 17th Jun 2004 06:03

Link

Pardon me for posting like an idiot, but I never looked at IanM's A* library since it was for Pro and I use Classic. After looking at a few commands, and remembering old articles on A* AI routines, is this a set of commands for setting up AI?

Crazy Donut Productions, Current Project: KillZone
Web Site Button Does Not Work, Visit Here: http://www.geocities.com/crazydonutproductions/index.html

Back to top

Profile PM Email Website

Mattman

20

Years of Service

User Offline

Joined: 5th Jun 2003

Location: East Lansing

Posted: 17th Jun 2004 06:08

Link

yes indeed, A* is a popular method of AI pathfinding

"Could you do something where you don't need a video card cause i don't have one" - Program Expert

Back to top

Profile PM Email Website

Astar

19

Years of Service

User Offline

Joined: 8th Jul 2004

Location:

Posted: 1st Aug 2004 10:12

Link

I still didnot get it running in my game...

Who can give some demo code in DBc to demonstrate how the A* works?
The function things are not straightforward for new comes

Other words, who can use these functions to run the A* pathfinding?

just need a executable code!

Many thanks!

Back to top

Profile PM

Sorry your browser is not supported!

Program Announcements / IanM's A* library [DBC]