pathfinding in 3D (using IanM's codebase entry)

Author

Message

genius

20

Years of Service

User Offline

Joined: 16th Oct 2003

Location: Utah, USA

Posted: 23rd Dec 2003 08:10

Link

I worked for hours and hours working on IanM's codebase entry to make it more RTS style in camera movement, and positioning objects. Now, you can select a unit(all of them select for some reason), and then rightClick the position you want it to go to and it will move avoiding obstecals!

CODE IN SOURCE CODE BUTTON

Be happy, tomorrow is another day

Back to top

Profile PM Website

Phaelax

DBPro Master

21

Years of Service

User Offline

Joined: 16th Apr 2003

Location: Metropia

Posted: 23rd Dec 2003 08:43

Link

You might want to double check your code. There's a remend without a remstart. some functions aren't in there.

Back to top

Profile PM Email Website

genius

20

Years of Service

User Offline

Joined: 16th Oct 2003

Location: Utah, USA

Posted: 23rd Dec 2003 09:11 Edited at: 23rd Dec 2003 09:13

Link

Sorry, here it is!

sync on
sync rate 15

#constant MAPWIDTH   5000
#constant MAPHEIGHT  5000
#constant CELLWIDTH  50
#constant CELLHEIGHT 50

`#constant MAPWIDTH   128
`#constant MAPHEIGHT  96
`#constant CELLWIDTH  4
`#constant CELLHEIGHT 4

global SourceX as integer
global SourceY as integer
global TargetX as integer
global TargetY as integer
global xxx as integer
global yyy as integer
global moving as integer
global counter as integer
global dist# as integer
global selected as integer
global selectedTileX as integer
global selectedTileZ as integer
selected=1
make object plain 20000,0,0
global object as integer
global r# as integer
  r# = 500

global ax# as integer
  ax#=45

global ay# as integer
  ay#=0

global ox# as integer
  ox#=matx/2*tilesize

global oy# as integer
  oy#=0

global oz# as integer
  oz#=matz/2*tilesize

global FOV# as integer
  FOV#=70
  set camera fov FOV#

global camSpeed as integer
  camSpeed = 50
object=1
counter=1
make matrix 1,MAPWIDTH,MAPHEIGHT,CELLWIDTH,CELLHEIGHT

CreateSearchMap(50,50)
CreateSearchPathLists(120)

DrawTheMap()
sync
sync

type characterObject
  sourceX as integer
  sourceY as integer
  targetX as integer
  targetY as integer
  counter as integer
  tempX as integer
  tempY as integer
  selected as integer
  moving as integer
endtype

global dim character(120) as characterObject

for f=101 to 111
  make object cube f,100
  color object f,RGB(255,0,0)
  character(f).tempX=rnd(CELLWIDTH)
  character(f).tempY=rnd(CELLHEIGHT)
next f
for f=1 to 100
  X=rnd(50)
  Y=rnd(50)
  SetSearchMap(X,Y,1)
  make object cube f,100
next f

do
   set cursor 0,0

gosub camera
   gosub selectTile
   UserUpdateMap()
   DrawTheMap()

sync
loop

selectTile:
    size=0
   rem Tile under mouse is?
   nearRng=screen width()
   selectedTileX=0
   selectedTileZ=0
   for tileX=1 to 50
      for tileZ=1 to 50
         x#=(tileX*100)-50
         z#=(tileZ*100)-50
         position object 20000,x#,get ground height(1,x#,z#),z#
         if object in screen(20000)
            dx#=abs(object screen x(20000)-mouseX())
            dz#=abs(object screen y(20000)-mouseY())
            rng=sqrt((dx#*dx#)+(dz#*dz#))
            if rng<nearRng
               nearRng=rng
               selectedTileX=tileX
               selectedTileZ=tileZ
            endIf
         endIf
      next tileZ
   next tileX

rem Highlight Tile
   if selectedTileX>0
      ulX=-1 : ulY=-1
      urX=-1 : urY=-1
      brX=-1 : brY=-1
      blX=-1 : blY=-1

`Top Left
      x#=(selectedTileX*100)-(size+1)*100 : z#=(selectedTileZ*100)-(size+1)*100
      position object 20000,x#,get ground height(1,x#,z#),z#
      if object in screen(20000)
         ulX=object screen x(20000)
         ulY=object screen y(20000)
      endIf

`Top Right
      x#=selectedTileX*100 : z#=(selectedTileZ*100)-(size+1)*100
      position object 20000,x#,get ground height(1,x#,z#),z#
      if object in screen(20000)
         urX=object screen x(20000)
         urY=object screen y(20000)
      endIf

`Bottom Right
      x#=selectedTileX*100 : z#=selectedTileZ*100
      position object 20000,x#,get ground height(1,x#,z#),z#
      if object in screen(20000)
         brX=object screen x(20000)
         brY=object screen y(20000)
      endIf

`Bottom Left
      x#=(selectedTileX*100)-(size+1)*100 : z#=selectedTileZ*100
      position object 20000,x#,get ground height(1,x#,z#),z#
      if object in screen(20000)
         blX=object screen x(20000)
         blY=object screen y(20000)
      endIf

ink RGB(255,128,0),0
      line ulX,ulY,urX,urY
      line blX,blY,brX,brY
      line ulX,ulY,blX,blY
      line urX,urY,brX,brY
      dec selectedTileX
      dec selectedTileZ
   endIf
return

Camera:

mx=mousex()
  my=mousey()

if (mouseclick()=0 and mousey()=0)
    ox#=ox#-camSpeed*sin(ay#)
    oz#=oz#-camSpeed*cos(ay#)
  endif
  if (mouseclick()=0 and mousey()=screen height()-1)
    ox#=ox#+camSpeed*sin(ay#)
    oz#=oz#+camSpeed*cos(ay#)
  endif
  if (mouseclick()=0 and mousex()=0)
    ox#=ox#+camSpeed*cos(ay#)
    oz#=oz#-camSpeed*sin(ay#)
  endif
  if (mouseclick()=0 and mousex()=screen width()-1)
    ox#=ox#-camSpeed*cos(ay#)
    oz#=oz#+camSpeed*sin(ay#)
  endif

if r# > 100 and r#<2000
    if inkey$()="-" or inkey$()= "_" then inc r#,10
    if inkey$()="=" or inkey$()= "+" then dec r#,10
  endif
  if r# >= 2000 then r# = 1950
  if r# <= 100 then r#=100

x#=ox#+r#*sin(ay#)*cos(ax#)
  y#=oy#+r#*sin(ax#)
  z#=oz#+r#*cos(ay#)*cos(ax#)

position camera x#,y#,z#
  point camera ox#,oy#,oz#

return

function ProcessAStar4(f,SX,SY,TX,TY)
   Start = timer()
   Found = SearchMapAStar4(f, SX, SY, TX, TY)
   Time = timer()-Start
endfunction

function UserUpdateMap()

X=selectedTileX
    Y=selectedTileZ
    for f=101 to 111
    Position object f ,character(f).sourceX*(MAPWIDTH/CELLWIDTH)+(MAPWIDTH/CELLWIDTH)/2, 0 ,character(f).sourceY*(MAPHEIGHT/CELLHEIGHT)+(MAPHEIGHT/CELLHEIGHT)/2
      if character(f).moving = 1
          if character(f).tempX=GetSearchPathX(f,character(f).counter) or character(f).tempY=GetSearchPathY(f,character(f).counter) then character(f).counter=character(f).counter+1
          ReadPath(character(f).counter,f,f)
          character(f).sourceX=character(f).tempX
          character(f).sourceY=character(f).tempY
      endif

if character(f).counter = SearchPathSize(f) then character(f).moving=0
      if spacekey() then SetSearchMap(selectedTileX,selectedTileZ,1)
      if returnkey() then SetSearchMap(selectedTileX,selectedTileZ,0)
      if mouseclick() = 1 and X=character(f).sourceX and Y=character(f).sourceY and character(f).selected = 0
        character(f).selected = 1
      else
        if mouseclick() = 1 and X<>character(f).sourceX and Y<>character(f).sourceY
            character(f).selected = 0
        endif
      endif
      if mouseclick()=2 and character(f).selected=1
         character(f).targetX=selectedTileX
         character(f).targetY=selectedTileZ
         SX =character(f).sourceX
         SY =character(f).sourceY
         TX =character(f).targetX
         TY =character(f).targetY
         ProcessAStar4(f, SX ,SY ,TX ,TY)
         character(f).counter=0
        character(f).moving=1
      endif
      if character(f).selected=1
        color object f,RGB(0,0,255)
      endif
      if character(f).selected=0
        color object f,RGB(255,0,0)
      endif
      print character(f).targetX;":";
      print character(f).targetY;";;";SearchPathSize(f);";;";character(f).moving
      print character(f).counter;";;";character(f).sourceX;":";character(f).sourceY;";;";character(f).selected

next f
endfunction

function DrawTheMap()
   object=1
   for X = 0 to CELLWIDTH
      for Y = 0 to CELLHEIGHT
         if GetSearchMap(X,Y) > 0 then Position object object,X*(MAPWIDTH/CELLWIDTH)+(MAPWIDTH/CELLWIDTH)/2,0,Y*(MAPHEIGHT/CELLHEIGHT)+(MAPHEIGHT/CELLHEIGHT)/2:inc object
      next Y
   next X

endfunction

function readPath(move,f,path)

speed=1
    if GetSearchPathX(path,move)>character(f).tempX then character(f).tempX=character(f).tempX+speed
    if GetSearchPathY(path,move)>character(f).tempY then character(f).tempY=character(f).tempY+speed
    if GetSearchPathX(path,move)<character(f).tempX then character(f).tempX=character(f).tempX-speed
    if GetSearchPathY(path,move)<character(f).tempY then character(f).tempY=character(f).tempY-speed

endfunction

` 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

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

SearchMapAStar8R(Path,StartX,StartY,FinishX,FinishY)
   Run an 8 directional A* search, but disallow diagonal movement between blocked cells

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

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

GetFlood4Cost(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
` ********************

type SEARCH_Position_t
   X as integer
   Y as integer
endtype

type SEARCH_TileInformation_t
   Status   as integer
   G        as integer
   H        as integer
   F        as integer
   ParentX  as integer
   ParentY  as integer
endtype

type SEARCH_OpenListItem_t
   F as integer
   X as integer
   Y as integer
endtype

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

global SEARCH_MapWidth  as integer
global SEARCH_MapHeight as integer
global SEARCH_MaxPaths as integer
global SEARCH_CurrentPosition as SEARCH_Position_t

` This is used for the new HEAP format using in A*
global SEARCH_OpenListSize as integer

` These are used for the flood4 search
global SEARCH_OpenListTop as integer
global SEARCH_OpenListBottom as integer

` Optimisation for flood4 search system
global SEARCH_PreviousStart as SEARCH_Position_t

` 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.

global dim SEARCH_Map(SEARCH_MapWidth, SEARCH_MapHeight) as integer
global dim SEARCH_TileInfo(SEARCH_MapWidth, SEARCH_MapHeight) as SEARCH_TileInformation_t
global dim SEARCH_OpenList(SEARCH_MapWidth * SEARCH_MapHeight) as SEARCH_OpenListItem_t
global dim SEARCH_SearchPath(SEARCH_MaxPaths, SEARCH_MapWidth * SEARCH_MapHeight) as SEARCH_Position_t
global dim SEARCH_PathSize(SEARCH_MaxPaths) as integer

` Initialised flags - by default DBPro sets them to zero. If they are not zero, then
` we are initialised.
global SEARCH_PathsInitialised as integer
global SEARCH_MapInitialised as integer

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

function CreateSearchMap(X as integer, Y as integer)
   SEARCH_MapWidth = X
   SEARCH_MapHeight = Y

SEARCH_PreviousStart.X = -9999
   SEARCH_PreviousStart.Y = -9999

undim SEARCH_Map()
   undim SEARCH_TileInfo()
   undim SEARCH_OpenList()

global dim SEARCH_Map(X, Y) as integer
   global dim SEARCH_TileInfo(X, Y) as SEARCH_TileInformation_t
   global dim SEARCH_OpenList(X * Y) as SEARCH_OpenListItem_t

SEARCH_MapInitialised=1
endfunction

function CreateSearchPathLists(Paths as integer)
   SEARCH_MaxPaths = Paths

undim SEARCH_SearchPath()
   undim SEARCH_PathSize()

global dim SEARCH_SearchPath(SEARCH_MaxPaths, SEARCH_MapWidth * SEARCH_MapHeight) as SEARCH_Position_t
   global dim SEARCH_PathSize(SEARCH_MaxPaths) as integer

SEARCH_PathsInitialised = 1
endfunction

function SetSearchMap(X as integer, Y as integer, Value as integer)
   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_PreviousStart.X = -9999
   SEARCH_Map(X,Y) = Value
endfunction

function GetSearchMap(X as integer, Y as integer)
   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 as integer, Move as integer)
   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_SearchPath(Path, SEARCH_PathSize(Path)-Move).X
endfunction -1

function GetSearchPathY(Path as integer, Move as integer)
   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_SearchPath(Path, SEARCH_PathSize(Path)-Move).Y
endfunction -1

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

function SearchMapAStar4(Path as integer, SX as integer, SY as integer, TX as integer, TY as integer)
   local X as integer
   local Y as integer
   local XOffset as integer
   local YOffset as integer
   local NewCost as integer

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_PreviousStart.X = -9999
   SEARCH_InitialiseTileInfo(SX,SY)

while SEARCH_GetLowestCostOpen() > 0

for XOffset = -1 to 1

X = SEARCH_CurrentPosition.X + XOffset
         if X >= 0 and X < SEARCH_MapWidth

for YOffset = -1 to 1

if (XOffset && YOffset) = 0
                  Y = SEARCH_CurrentPosition.Y + YOffset

if Y >= 0 and Y < SEARCH_MapHeight

if SEARCH_TileInfo(X,Y).Status = 0
                        SEARCH_TileInfo(X,Y).ParentX = SEARCH_CurrentPosition.X
                        SEARCH_TileInfo(X,Y).ParentY = SEARCH_CurrentPosition.Y
                        if X = TX then if Y = TY then exitfunction SEARCH_BuildPath(Path,SX,SY,TX,TY)
                        SEARCH_TileInfo(X,Y).Status = 1
                        SEARCH_TileInfo(X,Y).G = SEARCH_TileInfo(SEARCH_CurrentPosition.X,SEARCH_CurrentPosition.Y).G  + 10
                        SEARCH_TileInfo(X,Y).H = SEARCH_EstimateDistance(X,Y,TX,TY)
                        SEARCH_TileInfo(X,Y).F = SEARCH_TileInfo(X,Y).G + SEARCH_TileInfo(X,Y).H
                        SEARCH_AddToOpenList(X,Y)
                     else
                        if SEARCH_TileInfo(X,Y).Status = 1
                           NewCost = SEARCH_TileInfo(SEARCH_CurrentPosition.X,SEARCH_CurrentPosition.Y).G + 10
                           if SEARCH_TileInfo(X,Y).G > NewCost
                              SEARCH_TileInfo(X,Y).ParentX = SEARCH_CurrentPosition.X
                              SEARCH_TileInfo(X,Y).ParentY = SEARCH_CurrentPosition.Y
                              SEARCH_TileInfo(X,Y).G = NewCost
                              SEARCH_TileInfo(X,Y).F = NewCost + SEARCH_TileInfo(X,Y).H
                              SEARCH_AddToOpenList(X,Y)
                           endif
                        endif
                     endif
                  endif
               endif
            next YOffset
         endif
      next XOffset
   endwhile

exitfunction SEARCH_ClearPath(Path,SX,SY)
endfunction 0

function GetFlood4Cost(TX as integer, TY as integer)
   if SEARCH_MapInitialised = 0 then exitfunction -1
   if SEARCH_PathsInitialised = 0 then exitfunction -1
   if SEARCH_PreviousStart.X <> -9999 then exitfunction SEARCH_TileInfo(TX,TY).F
endfunction -1

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

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

function SEARCH_EstimateDistance(X as integer, Y as integer, TX as integer, TY as integer)
   local Distance as integer
   Distance = (abs(X - TX) + abs(Y - TY))*10
endfunction Distance

function SEARCH_InitialiseTileInfo(SX as integer, SY as integer)
   SEARCH_OpenListSize=0

SEARCH_PopulateTileInfo()

SEARCH_TileInfo(SX, SY).G = 0
   SEARCH_TileInfo(SX, SY).H = SEARCH_EstimateDistance(SX, SY, TX, TY)
   SEARCH_TileInfo(SX, SY).F = SEARCH_TileInfo(SX, SY).H
   SEARCH_TileInfo(SX, SY).Status = 1
   SEARCH_TileInfo(SX, SY).ParentX = SX
   SEARCH_TileInfo(SX, SY).ParentY = SY

SEARCH_AddToOpenList(SX, SY)
endfunction

function SEARCH_PopulateTileInfo()
   local X as integer
   local Y as integer

for X = 0 to SEARCH_MapWidth
      for Y = 0 to SEARCH_MapHeight
         if SEARCH_Map(X,Y) > 0
            SEARCH_TileInfo(X,Y).Status=2
         else
            SEARCH_TileInfo(X,Y).Status=0
         endif
      next Y
   next X
endfunction

function SEARCH_AddToOpenList(X as integer, Y as integer)
   local Parent as integer
   local Child as integer
   local Cost as integer

Child = SEARCH_OpenListSize
   inc SEARCH_OpenListSize

Cost = SEARCH_TileInfo(X,Y).F

do
      if Child <= 0 then exit

Parent=(Child - 1)/2

if SEARCH_OpenList(Parent).F < Cost then exit

FASTSWAP_OFF
         SEARCH_OpenList(Child).F = SEARCH_OpenList(Parent).F
         SEARCH_OpenList(Child).X = SEARCH_OpenList(Parent).X
         SEARCH_OpenList(Child).Y = SEARCH_OpenList(Parent).Y
      FASTSWAP_ON
         swap array items SEARCH_OpenList(), Child, Parent
      FASTSWAP_END

Child = Parent
   loop

SEARCH_OpenList(Child).F = Cost
   SEARCH_OpenList(Child).X = X
   SEARCH_OpenList(Child).Y = Y
endfunction

function SEARCH_GetLowestCostOpen()
   local Parent as integer
   local Child as integer
   local Cost as integer

if SEARCH_OpenListSize <= 0 then exitfunction 0

dec SEARCH_OpenListSize

SEARCH_CurrentPosition.X = SEARCH_OpenList(0).X
   SEARCH_CurrentPosition.Y = SEARCH_OpenList(0).Y

Cost = SEARCH_OpenList( SEARCH_OpenListSize ).F

FASTSWAP_OFF
      X = SEARCH_OpenList( SEARCH_OpenListSize ).X
      Y = SEARCH_OpenList( SEARCH_OpenListSize ).Y
   FASTSWAP_ON
   FASTSWAP_END

Parent=0
   do
      Child=(2 * Parent) + 1
      if Child >= SEARCH_OpenListSize then exit

if Child+1 < SEARCH_OpenListSize
         if SEARCH_OpenList(Child).F > SEARCH_OpenList(Child + 1).F then inc Child
      endif

if SEARCH_OpenList(Child).F < Cost

FASTSWAP_OFF
            SEARCH_OpenList(Parent).F = SEARCH_OpenList(Child).F
            SEARCH_OpenList(Parent).X = SEARCH_OpenList(Child).X
            SEARCH_OpenList(Parent).Y = SEARCH_OpenList(Child).Y
         FASTSWAP_ON
            swap array items SEARCH_OpenList(), Child, Parent
         FASTSWAP_END

Parent = Child
      else
         exit
      endif
   loop

FASTSWAP_OFF
      SEARCH_OpenList(Parent).F = Cost
      SEARCH_OpenList(Parent).X = X
      SEARCH_OpenList(Parent).Y = Y
   FASTSWAP_ON
      swap array items SEARCH_OpenList(), Parent, SEARCH_OpenListSize
   FASTSWAP_END

if SEARCH_TileInfo(SEARCH_CurrentPosition.X,SEARCH_CurrentPosition.Y).Status = 2 then exitfunction SEARCH_GetLowestCostOpen()

SEARCH_TileInfo(SEARCH_CurrentPosition.X,SEARCH_CurrentPosition.Y).Status = 2
endfunction 1

function SEARCH_QueueOntoOpen(X as integer, Y as integer)
   inc SEARCH_OpenListTop
   SEARCH_OpenList( SEARCH_OpenListTop ).X = X
   SEARCH_OpenList( SEARCH_OpenListTop ).Y = Y
endfunction

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

inc SEARCH_OpenListBottom
   SEARCH_CurrentPosition.X = SEARCH_OpenList( SEARCH_OpenListBottom ).X
   SEARCH_CurrentPosition.Y = SEARCH_OpenList( SEARCH_OpenListBottom ).Y
endfunction 1

function SEARCH_BuildPath(Path as integer, SX as integer, SY as integer, TX as integer, TY as integer)
   Moves = 0
   X = TX
   Y = TY
   SEARCH_SearchPath(Path, Moves).X = X
   SEARCH_SearchPath(Path, Moves).Y = Y

repeat
      inc Moves
      SEARCH_SearchPath(Path, Moves).X = SEARCH_TileInfo(X,Y).ParentX
      SEARCH_SearchPath(Path, Moves).Y = SEARCH_TileInfo(X,Y).ParentY
      X = SEARCH_SearchPath(Path, Moves).X
      Y = SEARCH_SearchPath(Path, Moves).Y
   until X = SX and Y = SY

SEARCH_PathSize(Path) = Moves
endfunction Moves

function SEARCH_ClearPath(Path as integer, SX as integer, SY as integer)
   SEARCH_SearchPath(Path, 0).X=SX
   SEARCH_SearchPath(Path, 1).Y=SY
   SEARCH_PathSize(Path)=0
endfunction 0

+ Code Snippet

sync on
sync rate 15

#constant MAPWIDTH   5000
#constant MAPHEIGHT  5000
#constant CELLWIDTH  50
#constant CELLHEIGHT 50

`#constant MAPWIDTH   128
`#constant MAPHEIGHT  96
`#constant CELLWIDTH  4
`#constant CELLHEIGHT 4

global SourceX as integer
global SourceY as integer
global TargetX as integer
global TargetY as integer
global xxx as integer
global yyy as integer
global moving as integer
global counter as integer
global dist# as integer
global selected as integer
global selectedTileX as integer
global selectedTileZ as integer
selected=1
make object plain 20000,0,0
global object as integer
global r# as integer
  r# = 500

global ax# as integer
  ax#=45

global ay# as integer
  ay#=0

global ox# as integer
  ox#=matx/2*tilesize

global oy# as integer
  oy#=0

global oz# as integer
  oz#=matz/2*tilesize

global FOV# as integer
  FOV#=70
  set camera fov FOV#

global camSpeed as integer
  camSpeed = 50
object=1
counter=1
make matrix 1,MAPWIDTH,MAPHEIGHT,CELLWIDTH,CELLHEIGHT

CreateSearchMap(50,50)
CreateSearchPathLists(120)

DrawTheMap()
sync
sync

type characterObject
  sourceX as integer
  sourceY as integer
  targetX as integer
  targetY as integer
  counter as integer
  tempX as integer
  tempY as integer
  selected as integer
  moving as integer
endtype

global dim character(120) as characterObject

for f=101 to 111
  make object cube f,100
  color object f,RGB(255,0,0)
  character(f).tempX=rnd(CELLWIDTH)
  character(f).tempY=rnd(CELLHEIGHT)
next f
for f=1 to 100
  X=rnd(50)
  Y=rnd(50)
  SetSearchMap(X,Y,1)
  make object cube f,100
next f

do
   set cursor 0,0

   gosub camera
   gosub selectTile
   UserUpdateMap()
   DrawTheMap()

   sync
loop

selectTile:
    size=0
   rem Tile under mouse is?
   nearRng=screen width()
   selectedTileX=0
   selectedTileZ=0
   for tileX=1 to 50
      for tileZ=1 to 50
         x#=(tileX*100)-50
         z#=(tileZ*100)-50
         position object 20000,x#,get ground height(1,x#,z#),z#
         if object in screen(20000)
            dx#=abs(object screen x(20000)-mouseX())
            dz#=abs(object screen y(20000)-mouseY())
            rng=sqrt((dx#*dx#)+(dz#*dz#))
            if rng<nearRng
               nearRng=rng
               selectedTileX=tileX
               selectedTileZ=tileZ
            endIf
         endIf
      next tileZ
   next tileX

   rem Highlight Tile
   if selectedTileX>0
      ulX=-1 : ulY=-1
      urX=-1 : urY=-1
      brX=-1 : brY=-1
      blX=-1 : blY=-1

      `Top Left
      x#=(selectedTileX*100)-(size+1)*100 : z#=(selectedTileZ*100)-(size+1)*100
      position object 20000,x#,get ground height(1,x#,z#),z#
      if object in screen(20000)
         ulX=object screen x(20000)
         ulY=object screen y(20000)
      endIf

      `Top Right
      x#=selectedTileX*100 : z#=(selectedTileZ*100)-(size+1)*100
      position object 20000,x#,get ground height(1,x#,z#),z#
      if object in screen(20000)
         urX=object screen x(20000)
         urY=object screen y(20000)
      endIf

      `Bottom Right
      x#=selectedTileX*100 : z#=selectedTileZ*100
      position object 20000,x#,get ground height(1,x#,z#),z#
      if object in screen(20000)
         brX=object screen x(20000)
         brY=object screen y(20000)
      endIf

      `Bottom Left
      x#=(selectedTileX*100)-(size+1)*100 : z#=selectedTileZ*100
      position object 20000,x#,get ground height(1,x#,z#),z#
      if object in screen(20000)
         blX=object screen x(20000)
         blY=object screen y(20000)
      endIf

      ink RGB(255,128,0),0
      line ulX,ulY,urX,urY
      line blX,blY,brX,brY
      line ulX,ulY,blX,blY
      line urX,urY,brX,brY
      dec selectedTileX
      dec selectedTileZ
   endIf
return

Camera:

  mx=mousex()
  my=mousey()

  if (mouseclick()=0 and mousey()=0)
    ox#=ox#-camSpeed*sin(ay#)
    oz#=oz#-camSpeed*cos(ay#)
  endif
  if (mouseclick()=0 and mousey()=screen height()-1)
    ox#=ox#+camSpeed*sin(ay#)
    oz#=oz#+camSpeed*cos(ay#)
  endif
  if (mouseclick()=0 and mousex()=0)
    ox#=ox#+camSpeed*cos(ay#)
    oz#=oz#-camSpeed*sin(ay#)
  endif
  if (mouseclick()=0 and mousex()=screen width()-1)
    ox#=ox#-camSpeed*cos(ay#)
    oz#=oz#+camSpeed*sin(ay#)
  endif


  if r# > 100 and r#<2000
    if inkey$()="-" or inkey$()= "_" then inc r#,10
    if inkey$()="=" or inkey$()= "+" then dec r#,10
  endif
  if r# >= 2000 then r# = 1950
  if r# <= 100 then r#=100

  x#=ox#+r#*sin(ay#)*cos(ax#)
  y#=oy#+r#*sin(ax#)
  z#=oz#+r#*cos(ay#)*cos(ax#)

  position camera x#,y#,z#
  point camera ox#,oy#,oz#

return

function ProcessAStar4(f,SX,SY,TX,TY)
   Start = timer()
   Found = SearchMapAStar4(f, SX, SY, TX, TY)
   Time = timer()-Start
endfunction

function UserUpdateMap()

    X=selectedTileX
    Y=selectedTileZ
    for f=101 to 111
    Position object f ,character(f).sourceX*(MAPWIDTH/CELLWIDTH)+(MAPWIDTH/CELLWIDTH)/2, 0 ,character(f).sourceY*(MAPHEIGHT/CELLHEIGHT)+(MAPHEIGHT/CELLHEIGHT)/2
      if character(f).moving = 1
          if character(f).tempX=GetSearchPathX(f,character(f).counter) or character(f).tempY=GetSearchPathY(f,character(f).counter) then character(f).counter=character(f).counter+1
          ReadPath(character(f).counter,f,f)
          character(f).sourceX=character(f).tempX
          character(f).sourceY=character(f).tempY
      endif

      if character(f).counter = SearchPathSize(f) then character(f).moving=0
      if spacekey() then SetSearchMap(selectedTileX,selectedTileZ,1)
      if returnkey() then SetSearchMap(selectedTileX,selectedTileZ,0)
      if mouseclick() = 1 and X=character(f).sourceX and Y=character(f).sourceY and character(f).selected = 0
        character(f).selected = 1
      else
        if mouseclick() = 1 and X<>character(f).sourceX and Y<>character(f).sourceY
            character(f).selected = 0
        endif
      endif
      if mouseclick()=2 and character(f).selected=1
         character(f).targetX=selectedTileX
         character(f).targetY=selectedTileZ
         SX =character(f).sourceX
         SY =character(f).sourceY
         TX =character(f).targetX
         TY =character(f).targetY
         ProcessAStar4(f, SX ,SY ,TX ,TY)
         character(f).counter=0
        character(f).moving=1
      endif
      if character(f).selected=1
        color object f,RGB(0,0,255)
      endif
      if character(f).selected=0
        color object f,RGB(255,0,0)
      endif
      print character(f).targetX;":";
      print character(f).targetY;";;";SearchPathSize(f);";;";character(f).moving
      print character(f).counter;";;";character(f).sourceX;":";character(f).sourceY;";;";character(f).selected

    next f
endfunction

function DrawTheMap()
   object=1
   for X = 0 to CELLWIDTH
      for Y = 0 to CELLHEIGHT
         if GetSearchMap(X,Y) > 0 then Position object object,X*(MAPWIDTH/CELLWIDTH)+(MAPWIDTH/CELLWIDTH)/2,0,Y*(MAPHEIGHT/CELLHEIGHT)+(MAPHEIGHT/CELLHEIGHT)/2:inc object
      next Y
   next X

endfunction

function readPath(move,f,path)

    speed=1
    if GetSearchPathX(path,move)>character(f).tempX then character(f).tempX=character(f).tempX+speed
    if GetSearchPathY(path,move)>character(f).tempY then character(f).tempY=character(f).tempY+speed
    if GetSearchPathX(path,move)<character(f).tempX then character(f).tempX=character(f).tempX-speed
    if GetSearchPathY(path,move)<character(f).tempY then character(f).tempY=character(f).tempY-speed

endfunction



` 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

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

SearchMapAStar8R(Path,StartX,StartY,FinishX,FinishY)
   Run an 8 directional A* search, but disallow diagonal movement between blocked cells

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

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

GetFlood4Cost(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
` ********************

type SEARCH_Position_t
   X as integer
   Y as integer
endtype

type SEARCH_TileInformation_t
   Status   as integer
   G        as integer
   H        as integer
   F        as integer
   ParentX  as integer
   ParentY  as integer
endtype

type SEARCH_OpenListItem_t
   F as integer
   X as integer
   Y as integer
endtype

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

global SEARCH_MapWidth  as integer
global SEARCH_MapHeight as integer
global SEARCH_MaxPaths as integer
global SEARCH_CurrentPosition as SEARCH_Position_t

` This is used for the new HEAP format using in A*
global SEARCH_OpenListSize as integer

` These are used for the flood4 search
global SEARCH_OpenListTop as integer
global SEARCH_OpenListBottom as integer

` Optimisation for flood4 search system
global SEARCH_PreviousStart as SEARCH_Position_t

` 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.

global dim SEARCH_Map(SEARCH_MapWidth, SEARCH_MapHeight) as integer
global dim SEARCH_TileInfo(SEARCH_MapWidth, SEARCH_MapHeight) as SEARCH_TileInformation_t
global dim SEARCH_OpenList(SEARCH_MapWidth * SEARCH_MapHeight) as SEARCH_OpenListItem_t
global dim SEARCH_SearchPath(SEARCH_MaxPaths, SEARCH_MapWidth * SEARCH_MapHeight) as SEARCH_Position_t
global dim SEARCH_PathSize(SEARCH_MaxPaths) as integer

` Initialised flags - by default DBPro sets them to zero. If they are not zero, then
` we are initialised.
global SEARCH_PathsInitialised as integer
global SEARCH_MapInitialised as integer

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

function CreateSearchMap(X as integer, Y as integer)
   SEARCH_MapWidth = X
   SEARCH_MapHeight = Y

   SEARCH_PreviousStart.X = -9999
   SEARCH_PreviousStart.Y = -9999

   undim SEARCH_Map()
   undim SEARCH_TileInfo()
   undim SEARCH_OpenList()

   global dim SEARCH_Map(X, Y) as integer
   global dim SEARCH_TileInfo(X, Y) as SEARCH_TileInformation_t
   global dim SEARCH_OpenList(X * Y) as SEARCH_OpenListItem_t

   SEARCH_MapInitialised=1
endfunction

function CreateSearchPathLists(Paths as integer)
   SEARCH_MaxPaths = Paths

   undim SEARCH_SearchPath()
   undim SEARCH_PathSize()

   global dim SEARCH_SearchPath(SEARCH_MaxPaths, SEARCH_MapWidth * SEARCH_MapHeight) as SEARCH_Position_t
   global dim SEARCH_PathSize(SEARCH_MaxPaths) as integer

   SEARCH_PathsInitialised = 1
endfunction

function SetSearchMap(X as integer, Y as integer, Value as integer)
   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_PreviousStart.X = -9999
   SEARCH_Map(X,Y) = Value
endfunction

function GetSearchMap(X as integer, Y as integer)
   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 as integer, Move as integer)
   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_SearchPath(Path, SEARCH_PathSize(Path)-Move).X
endfunction -1

function GetSearchPathY(Path as integer, Move as integer)
   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_SearchPath(Path, SEARCH_PathSize(Path)-Move).Y
endfunction -1

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

function SearchMapAStar4(Path as integer, SX as integer, SY as integer, TX as integer, TY as integer)
   local X as integer
   local Y as integer
   local XOffset as integer
   local YOffset as integer
   local NewCost as integer

   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_PreviousStart.X = -9999
   SEARCH_InitialiseTileInfo(SX,SY)

   while SEARCH_GetLowestCostOpen() > 0

      for XOffset = -1 to 1

         X = SEARCH_CurrentPosition.X + XOffset
         if X >= 0 and X < SEARCH_MapWidth

            for YOffset = -1 to 1

               if (XOffset && YOffset) = 0
                  Y = SEARCH_CurrentPosition.Y + YOffset

                  if Y >= 0 and Y < SEARCH_MapHeight

                     if SEARCH_TileInfo(X,Y).Status = 0
                        SEARCH_TileInfo(X,Y).ParentX = SEARCH_CurrentPosition.X
                        SEARCH_TileInfo(X,Y).ParentY = SEARCH_CurrentPosition.Y
                        if X = TX then if Y = TY then exitfunction SEARCH_BuildPath(Path,SX,SY,TX,TY)
                        SEARCH_TileInfo(X,Y).Status = 1
                        SEARCH_TileInfo(X,Y).G = SEARCH_TileInfo(SEARCH_CurrentPosition.X,SEARCH_CurrentPosition.Y).G  + 10
                        SEARCH_TileInfo(X,Y).H = SEARCH_EstimateDistance(X,Y,TX,TY)
                        SEARCH_TileInfo(X,Y).F = SEARCH_TileInfo(X,Y).G + SEARCH_TileInfo(X,Y).H
                        SEARCH_AddToOpenList(X,Y)
                     else
                        if SEARCH_TileInfo(X,Y).Status = 1
                           NewCost = SEARCH_TileInfo(SEARCH_CurrentPosition.X,SEARCH_CurrentPosition.Y).G + 10
                           if SEARCH_TileInfo(X,Y).G > NewCost
                              SEARCH_TileInfo(X,Y).ParentX = SEARCH_CurrentPosition.X
                              SEARCH_TileInfo(X,Y).ParentY = SEARCH_CurrentPosition.Y
                              SEARCH_TileInfo(X,Y).G = NewCost
                              SEARCH_TileInfo(X,Y).F = NewCost + SEARCH_TileInfo(X,Y).H
                              SEARCH_AddToOpenList(X,Y)
                           endif
                        endif
                     endif
                  endif
               endif
            next YOffset
         endif
      next XOffset
   endwhile

   exitfunction SEARCH_ClearPath(Path,SX,SY)
endfunction 0

function GetFlood4Cost(TX as integer, TY as integer)
   if SEARCH_MapInitialised = 0 then exitfunction -1
   if SEARCH_PathsInitialised = 0 then exitfunction -1
   if SEARCH_PreviousStart.X <> -9999 then exitfunction SEARCH_TileInfo(TX,TY).F
endfunction -1

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

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

function SEARCH_EstimateDistance(X as integer, Y as integer, TX as integer, TY as integer)
   local Distance as integer
   Distance = (abs(X - TX) + abs(Y - TY))*10
endfunction Distance

function SEARCH_InitialiseTileInfo(SX as integer, SY as integer)
   SEARCH_OpenListSize=0

   SEARCH_PopulateTileInfo()

   SEARCH_TileInfo(SX, SY).G = 0
   SEARCH_TileInfo(SX, SY).H = SEARCH_EstimateDistance(SX, SY, TX, TY)
   SEARCH_TileInfo(SX, SY).F = SEARCH_TileInfo(SX, SY).H
   SEARCH_TileInfo(SX, SY).Status = 1
   SEARCH_TileInfo(SX, SY).ParentX = SX
   SEARCH_TileInfo(SX, SY).ParentY = SY

   SEARCH_AddToOpenList(SX, SY)
endfunction

function SEARCH_PopulateTileInfo()
   local X as integer
   local Y as integer

   for X = 0 to SEARCH_MapWidth
      for Y = 0 to SEARCH_MapHeight
         if SEARCH_Map(X,Y) > 0
            SEARCH_TileInfo(X,Y).Status=2
         else
            SEARCH_TileInfo(X,Y).Status=0
         endif
      next Y
   next X
endfunction

function SEARCH_AddToOpenList(X as integer, Y as integer)
   local Parent as integer
   local Child as integer
   local Cost as integer

   Child = SEARCH_OpenListSize
   inc SEARCH_OpenListSize

   Cost = SEARCH_TileInfo(X,Y).F

   do
      if Child <= 0 then exit

      Parent=(Child - 1)/2

      if SEARCH_OpenList(Parent).F < Cost then exit

      FASTSWAP_OFF
         SEARCH_OpenList(Child).F = SEARCH_OpenList(Parent).F
         SEARCH_OpenList(Child).X = SEARCH_OpenList(Parent).X
         SEARCH_OpenList(Child).Y = SEARCH_OpenList(Parent).Y
      FASTSWAP_ON
         swap array items SEARCH_OpenList(), Child, Parent
      FASTSWAP_END

      Child = Parent
   loop

   SEARCH_OpenList(Child).F = Cost
   SEARCH_OpenList(Child).X = X
   SEARCH_OpenList(Child).Y = Y
endfunction


function SEARCH_GetLowestCostOpen()
   local Parent as integer
   local Child as integer
   local Cost as integer

   if SEARCH_OpenListSize <= 0 then exitfunction 0

   dec SEARCH_OpenListSize

   SEARCH_CurrentPosition.X = SEARCH_OpenList(0).X
   SEARCH_CurrentPosition.Y = SEARCH_OpenList(0).Y

   Cost = SEARCH_OpenList( SEARCH_OpenListSize ).F

   FASTSWAP_OFF
      X = SEARCH_OpenList( SEARCH_OpenListSize ).X
      Y = SEARCH_OpenList( SEARCH_OpenListSize ).Y
   FASTSWAP_ON
   FASTSWAP_END

   Parent=0
   do
      Child=(2 * Parent) + 1
      if Child >= SEARCH_OpenListSize then exit

      if Child+1 < SEARCH_OpenListSize
         if SEARCH_OpenList(Child).F > SEARCH_OpenList(Child + 1).F then inc Child
      endif

      if SEARCH_OpenList(Child).F < Cost

         FASTSWAP_OFF
            SEARCH_OpenList(Parent).F = SEARCH_OpenList(Child).F
            SEARCH_OpenList(Parent).X = SEARCH_OpenList(Child).X
            SEARCH_OpenList(Parent).Y = SEARCH_OpenList(Child).Y
         FASTSWAP_ON
            swap array items SEARCH_OpenList(), Child, Parent
         FASTSWAP_END

         Parent = Child
      else
         exit
      endif
   loop

   FASTSWAP_OFF
      SEARCH_OpenList(Parent).F = Cost
      SEARCH_OpenList(Parent).X = X
      SEARCH_OpenList(Parent).Y = Y
   FASTSWAP_ON
      swap array items SEARCH_OpenList(), Parent, SEARCH_OpenListSize
   FASTSWAP_END

   if SEARCH_TileInfo(SEARCH_CurrentPosition.X,SEARCH_CurrentPosition.Y).Status = 2 then exitfunction SEARCH_GetLowestCostOpen()

   SEARCH_TileInfo(SEARCH_CurrentPosition.X,SEARCH_CurrentPosition.Y).Status = 2
endfunction 1

function SEARCH_QueueOntoOpen(X as integer, Y as integer)
   inc SEARCH_OpenListTop
   SEARCH_OpenList( SEARCH_OpenListTop ).X = X
   SEARCH_OpenList( SEARCH_OpenListTop ).Y = Y
endfunction

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

   inc SEARCH_OpenListBottom
   SEARCH_CurrentPosition.X = SEARCH_OpenList( SEARCH_OpenListBottom ).X
   SEARCH_CurrentPosition.Y = SEARCH_OpenList( SEARCH_OpenListBottom ).Y
endfunction 1

function SEARCH_BuildPath(Path as integer, SX as integer, SY as integer, TX as integer, TY as integer)
   Moves = 0
   X = TX
   Y = TY
   SEARCH_SearchPath(Path, Moves).X = X
   SEARCH_SearchPath(Path, Moves).Y = Y

   repeat
      inc Moves
      SEARCH_SearchPath(Path, Moves).X = SEARCH_TileInfo(X,Y).ParentX
      SEARCH_SearchPath(Path, Moves).Y = SEARCH_TileInfo(X,Y).ParentY
      X = SEARCH_SearchPath(Path, Moves).X
      Y = SEARCH_SearchPath(Path, Moves).Y
   until X = SX and Y = SY

   SEARCH_PathSize(Path) = Moves
endfunction Moves

function SEARCH_ClearPath(Path as integer, SX as integer, SY as integer)
   SEARCH_SearchPath(Path, 0).X=SX
   SEARCH_SearchPath(Path, 1).Y=SY
   SEARCH_PathSize(Path)=0
endfunction 0

Be happy, tomorrow is another day

Back to top

Profile PM Website

Atreides

20

Years of Service

User Offline

Joined: 11th Oct 2003

Location: Switzerland (but NOT on a mountain !)

Posted: 23rd Dec 2003 13:19

Link

I don't understand how it works, but it works ^^
it's a nice one Genius

The sleeper must awaken !

Back to top

Profile PM Website

Rennekon

20

Years of Service

User Offline

Joined: 7th Oct 2003

Location:

Posted: 23rd Dec 2003 13:34

Link

Wow!! thats awesome! I can't figure it out but I could sure use it!

John "Dark Lord of Angel Destroying Destiny" Pringlebee, maybe?

Back to top

Profile PM

genius

20

Years of Service

User Offline

Joined: 16th Oct 2003

Location: Utah, USA

Posted: 23rd Dec 2003 17:43 Edited at: 23rd Dec 2003 17:48

Link

Go ahead and use it if you want!
All you have to do is call a single function to move the object:

function UserUpdateMap()

X=selectedTileX
    Y=selectedTileZ
    for f=101 to 111
    Position object f ,character(f).sourceX*(MAPWIDTH/CELLWIDTH)+(MAPWIDTH/CELLWIDTH)/2, 0 ,character(f).sourceY*(MAPHEIGHT/CELLHEIGHT)+(MAPHEIGHT/CELLHEIGHT)/2
      if character(f).moving = 1
          if character(f).tempX=GetSearchPathX(f,character(f).counter) or character(f).tempY=GetSearchPathY(f,character(f).counter) then character(f).counter=character(f).counter+1
          ReadPath(character(f).counter,f,f)
          character(f).sourceX=character(f).tempX
          character(f).sourceY=character(f).tempY
      endif

if character(f).counter = SearchPathSize(f) then character(f).moving=0
      if spacekey() then SetSearchMap(selectedTileX,selectedTileZ,1)
      if returnkey() then SetSearchMap(selectedTileX,selectedTileZ,0)
      if mouseclick() = 1 and X=character(f).sourceX and Y=character(f).sourceY and character(f).selected = 0
        character(f).selected = 1
      else
        if mouseclick() = 1 and X<>character(f).sourceX and Y<>character(f).sourceY
            character(f).selected = 0
        endif
      endif
      if mouseclick()=2 and character(f).selected=1
         character(f).targetX=selectedTileX
         character(f).targetY=selectedTileZ
         SX =character(f).sourceX
         SY =character(f).sourceY
         TX =character(f).targetX
         TY =character(f).targetY
         ProcessAStar4(f, SX ,SY ,TX ,TY)
         character(f).counter=0
        character(f).moving=1
      endif
      if character(f).selected=1
        color object f,RGB(0,0,255)
      endif
      if character(f).selected=0
        color object f,RGB(255,0,0)
      endif
      print character(f).targetX;":";
      print character(f).targetY;";;";SearchPathSize(f);";;";character(f).moving
      print character(f).counter;";;";character(f).sourceX;":";character(f).sourceY;";;";character(f).selected

next f
endfunction

+ Code Snippet

function UserUpdateMap()

    X=selectedTileX
    Y=selectedTileZ
    for f=101 to 111
    Position object f ,character(f).sourceX*(MAPWIDTH/CELLWIDTH)+(MAPWIDTH/CELLWIDTH)/2, 0 ,character(f).sourceY*(MAPHEIGHT/CELLHEIGHT)+(MAPHEIGHT/CELLHEIGHT)/2
      if character(f).moving = 1
          if character(f).tempX=GetSearchPathX(f,character(f).counter) or character(f).tempY=GetSearchPathY(f,character(f).counter) then character(f).counter=character(f).counter+1
          ReadPath(character(f).counter,f,f)
          character(f).sourceX=character(f).tempX
          character(f).sourceY=character(f).tempY
      endif

      if character(f).counter = SearchPathSize(f) then character(f).moving=0
      if spacekey() then SetSearchMap(selectedTileX,selectedTileZ,1)
      if returnkey() then SetSearchMap(selectedTileX,selectedTileZ,0)
      if mouseclick() = 1 and X=character(f).sourceX and Y=character(f).sourceY and character(f).selected = 0
        character(f).selected = 1
      else
        if mouseclick() = 1 and X<>character(f).sourceX and Y<>character(f).sourceY
            character(f).selected = 0
        endif
      endif
      if mouseclick()=2 and character(f).selected=1
         character(f).targetX=selectedTileX
         character(f).targetY=selectedTileZ
         SX =character(f).sourceX
         SY =character(f).sourceY
         TX =character(f).targetX
         TY =character(f).targetY
         ProcessAStar4(f, SX ,SY ,TX ,TY)
         character(f).counter=0
        character(f).moving=1
      endif
      if character(f).selected=1
        color object f,RGB(0,0,255)
      endif
      if character(f).selected=0
        color object f,RGB(255,0,0)
      endif
      print character(f).targetX;":";
      print character(f).targetY;";;";SearchPathSize(f);";;";character(f).moving
      print character(f).counter;";;";character(f).sourceX;":";character(f).sourceY;";;";character(f).selected

    next f
endfunction

this is the only part of the whole thing you need to understand. It took me days on end to convert 2D to 3D. All you have to do is change the:
for f=101 to 111
to whatever objects you want to have find a path. And, another important thing, whenever you make something(building,unit, ect.) you need to setSearchMap(xTile,zTile,flag) to show that that part of the grid is taken so it needs to avoid it. The flage values are 0 is empty, <0 is used.
hope i have helped.

Be happy, tomorrow is another day

Back to top

Profile PM Website

Phaelax

DBPro Master

21

Years of Service

User Offline

Joined: 16th Apr 2003

Location: Metropia

Posted: 23rd Dec 2003 23:45

Link

It doesn't like it when you tell it to move to a bad spot.

Back to top

Profile PM Email Website

genius

20

Years of Service

User Offline

Joined: 16th Oct 2003

Location: Utah, USA

Posted: 24th Dec 2003 00:07

Link

What does it do?

Be happy, tomorrow is another day

Back to top

Profile PM Website

Sorry your browser is not supported!

Code Snippets / pathfinding in 3D (using IanM's codebase entry)