My First PathFinding Program

It took me 3 weeks and about 100 hours to get here, but I feel like I'm close. Please post some comments to help me optimize or correct this.

there are some collision issues that stop player movement, but I'm tired.

Edit 10-26-06: Heres the version 4 with collision between character, scenary, and structures turned off
http://www.hilbily-works.com/Downloads1/PathFinding_TestV4.zip

You can download the exe file here http://www.hilbily-works.com/Downloads1/PathFinding_TestV3.zip

Thanks!!
Pathfinding testV3.bb is the main program
Globals.bb is an include for the Testv3.bb and the PathfindingV9.bb
PathfindingV9.bb is the main code for the pathfinding


This is the global.bb

;Global Entities
Global Ground
Global Player
Global Cam
Global CamPiv
Global Lite
Dim Trees(50)
Global House1
Global House2


;Collision Type
Global Type_Ground = 1
Global Type_Char = 2
Global Type_Scenery = 3
Global Type_Structure = 4
	
Global SelEnt
Global SelName$
Global Move$
Global BegX#
Global BegZ#
Global DestX#
Global DestZ#
Global Cursor

Global EntX
Global EntY
Global EntZ

Global FPS
Global frame_count
Global fps_timeout
Global TarX
Global TarZ

here is the PathfindingV9.bb code

Include "Globals.bb"

Type Cell
	Field ID
	Field X
	Field Z
	Field FVal
	Field GVal
	Field HVal
	Field Walkable
	Field Parent
	Field ListNum ;0 = Not listed, 1 = Open, 2 = Closed
End Type

Global GridX = 200
Global GridZ = 200
Global TotCells = (GridX+1) * (GridZ+1)
Dim Grid.Cell(TotCells) ;The Custom Type and Array was exampled by Stevie G, Awesome!
Global StartCell ;Stores the number of the Current Cell
Dim OpenList(1000) ;used to store cells that need to be checked
Dim ClosedList(1000) ;Used to store the path
Dim AdjCell(9) ;Used to store adjacent cell info
Global MoveCell

Dim Marker(1000)


;----------------------------------------------------------------------------------
Function CreateGrid(X,Z)
	;X and Z are map dimensions passed in, It will create a 2d grid containing (X+1 * Z+1) number
	;of cells. The +1 is for adding the 0 column and 0 row. I love MS Excel and VB, hehehe.
	A = 1
	CellX = (GridX/2) * -1
	CellZ = (GridZ/2)

	While A < TotCells+1
		If CellX < (GridX/2)+1
			Grid(A) = New Cell
			Grid(A)\ID = A
			Grid(A)\X = CellX
			Grid(A)\Z = CellZ
			Grid(A)\FVal = 0
			Grid(A)\GVal = 0
			Grid(A)\HVal = 0
			
			SelEnt = LinePick(CellX, 200, CellZ, 0, -1000, 0)
			If SelEnt > 0
				SelName$ = EntityName(PickedEntity())
				If SelName$ = "Ground"
					Grid(A)\Walkable = 1
				Else
					Grid(A)\Walkable = 0	
				EndIf
			EndIf
			
			
			Grid(A)\Parent = 0
			CellX = CellX + 1
			A = A + 1
		Else
			CellX = (GridX/2) * -1
			CellZ = CellZ - 1
		End If
	Wend
						
End Function
;----------------------------------------------------------------------------------

;----------------------------------------------------------------------------------
Function FindPath(StartX,StartZ,EndX,EndZ)
	
	;Clears any previously drawn path
	ClearPath()

	;Dim these variables to clear them
	Dim OpenList(1000) ;used to store cells that need to be checked
	Dim ClosedList(1000) ;Used to store the path
	
;1 - Move Char to nearest cell coords, if not there already
	A = 1
	While A < TotCells+1
		If Grid(A)\X < StartX + 1 And Grid(A)\X > StartX -1
			If Grid(A)\Z < StartZ + 1 And Grid(A)\Z > StartZ -1
				;The Character is within Grid(A)'s coords, Make this Cell, the Start Cell
				StartCell = A
				Grid(A)\Parent = A
				Grid(A)\ListNum = 0
				Grid(A)\FVal = 0
				Grid(A)\GVal = 0
				Grid(A)\HVal = 0
				Exit
			End If
		End If
		A = A + 1
	Wend
	
	;Add Starting Square to OpenList
	A = 1
	If Grid(StartCell)\ListNum = 0
		While A < TotCells
			If OpenList(A) = 0
				OpenList(A) = Grid(StartCell)\ID
				Grid(StartCell)\ListNum = 1 ;0 = Not listed, 1 = Open, 2 = Closed
				Exit
			EndIf
			A = A + 1
		Wend
	EndIf
		
	OListMT = 0
	TarFound = 0
	F = 0
	
Repeat
;2 Put Starting Cell in closed list, this is where the player is at before the movement begins
	;If the Target cell is added to the closed list then the path is complete
	


	TempCell = 0
	;Find the Cell with the lowest FCost in the Open list And Make it the New Start Cell
	;if there are no longer any cells on open list, then there is no path
	If F > 0 Then
		A = 1
		TempCell = OpenList(A)
		While OpenList(A) <> 0 ;Cycle through each item in open list looking for Grid ID with lowest Fval
			B = 1
			While OpenList(B) <> 0
				If Grid(TempCell)\FVal <= Grid(OpenList(B))\FVal
					StartCell = TempCell
				Else
					TempCell = OpenList(B)
					StartCell = TempCell
				EndIf
				B = B + 1
			Wend
			A = A + 1
		Wend
	EndIf
	
	
	;take current cell off open list
	A = 1
	While OpenList(A) <> 0
		If OpenList(A) = StartCell
			Grid(OpenList(A))\ListNum = 0
			OpenList(A) = 0
			Exit
		EndIf
		A = A + 1
	Wend
	
	;add current cell to closed list
	A = 1
	While A < TotCells
		If ClosedList(A) = 0
			ClosedList(A) = StartCell
			Grid(ClosedList(A))\ListNum = 2
			Exit
		EndIf
		A = A + 1
	Wend
	
	If Grid(StartCell)\X = EndX And Grid(StartCell)\Z = EndZ 
		;The Target cell has been found
		;Leave the loop
		TarFound = 1
	EndIf
	
;3 - Check each adjacent cell, Fill in each adjacent cells Fcost, Gcost, Hcost values
	;and parent values
	;Later, I may change the walkable to just check the adjacent cells instead of checking
	;the whole map at startup, I will try it and see what kind of slow down happens at runtime
	
	;Iterate through cells using current cell as a starting point to find which cells
	;are adjacent, we can find the left and right cells by subtracting 1 from StartCell for the cell
	;to the left and adding 1 to StartCell for the cell to the right
	AdjCell(4) = StartCell - 1
	Grid(AdjCell(4))\Parent = StartCell
	AdjCell(5) = StartCell + 1
	Grid(AdjCell(5))\Parent = StartCell
	
	A = StartCell-1
	While A > 0
		If Grid(A)\X = Grid(StartCell)\X - 1
			If Grid(A)\Z = Grid(StartCell)\Z + 1
				;This is the Adjacent Cell Diagonal, up, Left of Start Cell
				AdjCell(1) = A
				Grid(A)\Parent = StartCell
			EndIf
		EndIf
		If Grid(A)\X = Grid(StartCell)\X
			If Grid(A)\Z = Grid(StartCell)\Z + 1
				;This is the Adjacent cell above the Start Cell
				AdjCell(2) = A
				Grid(A)\Parent = StartCell
			EndIf
		EndIf
		If Grid(A)\X = Grid(StartCell)\X + 1
			If Grid(A)\Z = Grid(StartCell)\Z + 1
				;This is the adjacent cell to diagonal up right of Start Cell
				AdjCell(3) = A
				Grid(A)\Parent = StartCell
			End If
		End If
	
		A = A - 1
	Wend
	
	A = StartCell + 1
	While A < TotCells+1
		If Grid(A)\X = Grid(StartCell)\X -1
			If Grid(A)\Z = Grid(StartCell)\Z -1
				;This is the adjacent cell to diagonal Down Left of Start Cell
				AdjCell(6) = A
				Grid(A)\Parent = StartCell
			End If
		End If
		If Grid(A)\X = Grid(StartCell)\X
			If Grid(A)\Z = Grid(StartCell)\Z -1
				;This is the Adjacent cell Below the Start Cell
				AdjCell(7) = A
				Grid(A)\Parent = StartCell
			EndIf
		EndIf
		If Grid(A)\X = Grid(StartCell)\X +1
			If Grid(A)\Z = Grid(StartCell)\Z -1
				;This is the Adjacent Cell Diagonal, down, right of Start Cell
				AdjCell(8) = A
				Grid(A)\Parent = StartCell
			EndIf
		EndIf	
		A = A + 1
	Wend
	
	;Fill in GVal, HVal and FVal values and Create AdjCell() array
	;ABS Enlightenment goes to Kevin8084
	A = 1
	While A < 9
		If Grid(AdjCell(A))\X <> Grid(StartCell)\X And Grid(AdjCell(A))\Z <> Grid(StartCell)\Z ;Its Diagonal
			Grid(AdjCell(A))\GVal = 14*(Abs(Grid(AdjCell(A))\Z - Grid(StartCell)\Z))
		Else ;Its not Diagonal
			If Grid(AdjCell(A))\Z = Grid(StartCell)\Z And Grid(AdjCell(A))\X <> Grid(StartCell)\X
				Grid(AdjCell(A))\GVal = 10*(Abs(Grid(AdjCell(A))\X - Grid(StartCell)\X))
			Else
				Grid(AdjCell(A))\GVal = 10*(Abs(Grid(AdjCell(A))\Z - Grid(StartCell)\Z))
			EndIf	
		EndIf	
		Grid(AdjCell(A))\HVal = 10*(Abs(Grid(AdjCell(A))\X - EndX)) + 10*(Abs(Grid(AdjCell(A))\Z - EndZ))
		Grid(AdjCell(A))\FVal = Grid(AdjCell(A))\Gval + Grid(AdjCell(A))\HVal
		A = A + 1
	Wend
	
	;Add all walkable Adjacent Cells to the open list, if not on the closed list
	A = 1
	B = 1
	While A < 9
		If Grid(AdjCell(A))\Walkable = 1 And Grid(AdjCell(A))\ListNum = 0
			B = 1
			While B < TotCells
				If OpenList(B) = 0
					OpenList(B) = Grid(AdjCell(A))\ID
					Grid(AdjCell(A))\ListNum = 1 ;0 = Not listed, 1 = Open, 2 = Closed
					Exit
				EndIf
				B = B + 1
			Wend
		EndIf
		A = A + 1
	Wend

	F = F + 1
	
Until TarFound = 1 Or F > 1000
	
	;Clear Openlist values, else it will interfere with a future pathfind
	A = 1
	While OpenList(A) <> 0
		Grid(OpenList(A))\FVal = 0
		Grid(OpenList(A))\GVal = 0
		Grid(OpenList(A))\HVal = 0
		Grid(OpenList(A))\ListNum = 0
		A = A + 1
	Wend
	
	;Clear Closedlist values, else it will interfere with a future pathfind
	A = 1
	While ClosedList(A) <> 0
		Grid(ClosedList(A))\FVal = 0
		Grid(ClosedList(A))\GVal = 0
		Grid(ClosedList(A))\HVal = 0
		Grid(ClosedList(A))\ListNum = 0
		A = A + 1

	Wend
	
	ShowPath()
End Function
;----------------------------------------------------------------------------------

;----------------------------------------------------------------------------------
Function ShowPath() ;draws the path onscreen
	A = 1
	While ClosedList(A) <> 0
		Marker(A) = CreateSphere()
		PositionEntity Marker(A),Grid(ClosedList(A))\X,1,Grid(ClosedList(A))\Z
		ScaleEntity Marker(A),.5,.5,.5
		EntityColor Marker(A),255,0,0
		A = A + 1
	Wend
End Function
;----------------------------------------------------------------------------------

;----------------------------------------------------------------------------------
Function ClearPath() ;Clears a previously drawn path
	A = 1
	While ClosedList(A) <> 0
		FreeEntity Marker(A)
		A = A + 1
	Wend
End Function
;----------------------------------------------------------------------------------

;----------------------------------------------------------------------------------
Function WriteFiles()
	A = 1	
	;;Save info To check it
	FileOut = WriteFile("1-Nodeinfo.dat")
	WriteLine(FileOut,"Total Cells= " +TotCells)
	While A < TotCells+1
		WriteLine(FileOut, Grid(A)\ID+", "+Grid(A)\X+", "+Grid(A)\Z+", "+Grid(A)\Walkable+", "+Grid(A)\Parent)	
		A = A + 1
	Wend
	CloseFile FileOut
	
	;Save info To check it
	FileOut = WriteFile("1-OpenListInfo.dat")
	A = 1
	While OpenList(A) <> 0
		WriteLine(FileOut,OpenList(A)+": "+Grid(OpenList(A))\X+", "+Grid(OpenList(A))\Z+", "+Grid(OpenList(A))\ListNum+", "+Grid(OpenList(A))\Walkable+", "+Grid(OpenList(A))\GVal+", "+Grid(OpenList(A))\HVal+", "+Grid(OpenList(A))\FVal+", ")
		A = A + 1
	Wend
	CloseFile FileOut
	
	;Save info To check it
	FileOut = WriteFile("1-ClosedListInfo.dat")
	A = 1
	While ClosedList(A) <> 0
		WriteLine(FileOut,ClosedList(A)+": "+Grid(ClosedList(A))\X+", "+Grid(ClosedList(A))\Z+", "+Grid(ClosedList(A))\ListNum+", "+Grid(ClosedList(A))\Walkable+", "+Grid(ClosedList(A))\GVal+", "+Grid(ClosedList(A))\HVal+", "+Grid(ClosedList(A))\FVal+", ")
		A = A + 1
	Wend
	CloseFile FileOut

	;Save info To check it
	FileOut = WriteFile("1-PathLoops.dat")
	WriteLine(FileOut,F)
	CloseFile FileOut
End Function
;----------------------------------------------------------------------------------

and here is the main program Pathfinding TestV3.bb

Graphics3D 1024,768,32,1
SetBuffer BackBuffer()

Include "Globals.bb"
Include "PathfindingV9.bb"

;-------------FPS Stuff--------------------
SeedRnd MilliSecs()
fps_timer = CreateTimer(60) ; Lock to 60FPS.
;--------------end FPS Stuff----------------

CreateCursor()
CreateObjects()


Collisions Type_Char,Type_Ground,2,3
Collisions Type_Char,Type_Scenery,2,3
Collisions Type_Char,Type_Structure,2,3

CreateGrid(GridX,GridZ)		

While Not KeyHit(1)

	If KeyDown(13) ;+
		MoveEntity Cam,0,0,1
	EndIf
	If KeyDown(12) ;-
		MoveEntity Cam,0,0,-1
	EndIf
	If KeyDown(203) 
		TurnEntity CamPiv,0,3,0
	EndIf
	If KeyDown(205) 
		TurnEntity CamPiv,0,-3,0
	EndIf
	
	PositionEntity CamPiv,EntityX(Player,True),EntityY(Player,True),EntityZ(Player,True)
	
	If MouseHit(1)=True
		
			SelEnt = CameraPick(Cam,MouseX(),MouseY())
			If SelEnt > 0
				SelName$ = EntityName(PickedEntity())
				EntX = PickedX()
				EntY = PickedY()
				EntZ = PickedZ()
				If SelName$ = "Ground"
					BegX = EntityX(Player,True)
					BegZ = EntityZ(Player,True)
					DestX = PickedX#()
					DestZ = PickedZ#()
					FindPath(BegX,BegZ,DestX,DestZ)
					Move$ = "True"
					MoveCell = 0
				ElseIf Instr(SelName$,"Tree") > 0
					Move$ = "False"
				ElseIf Instr(SelName$, "House") > 0
					Move$ = "False"
				EndIf
			EndIf
	End If
	
	
	If Move$ = "True"
		BegX = EntityX(Player,True)
		BegZ = EntityZ(Player,True)
		If BegX < DestX + 1 And BegX > DestX - 1 And BegZ < DestZ + 1 And BegZ > DestZ -1
			Move$ = "False"
		EndIf
		
		
		
	
		If MoveCell <> 0
			If BegX < TarX + 1 And BegX > TarX - 1 And BegZ < TarZ + 1 And BegZ > TarZ -1
				A = 1
				While ClosedList(A) <> 0
					If ClosedList(A) = MoveCell
						A = A + 1
						If ClosedList(A) <> 0 Then MoveCell = ClosedList(A)
						Exit
					EndIf
					A = A + 1
				Wend
			EndIf
		Else
			A = 1
			While ClosedList(A) <> 0
				If ClosedList(A) 
					MoveCell = ClosedList(A)
					Exit
				EndIf
				A = A + 1
			Wend
		EndIf
		
		TarX = Grid(MoveCell)\X
		TarZ = Grid(MoveCell)\Z
		
		Point_Entity(Player,TarX,EntityY(Player,True),TarZ)
		
		MoveEntity Player,0,0,.05
		

	EndIf
	
	MoveEntity Player,0,-0.035,0 ; gravity 
	
	UpdateWorld
	RenderWorld
	
	
	
	Color 255,0,0
	frame_time = MilliSecs() - frame_start
	Show_FPS()
	Color 255,255,0
	Text 10,15,"Press esc to exit, Arrow keys turn cam, - and = zoom camera"
	Text 10,30,"Click an object to select it, click the ground to move"
	Color 255,255,255
	Text 10,90,"TotNodes = "+TotCells
	Text 10,105,"Sel Entity: "+SelName$+"("+EntX+","+EntY+","+EntZ+")"
	Text 10,120,"Ground Dims: "+MeshWidth(Ground) +", "+MeshHeight(Ground)+", "+MeshDepth(Ground)
	Text 10,135,"Ground Pos: "+EntityX(Ground,True)+", "+EntityZ(Ground,True)
	Text 10,150,"Tris: "+TrisRendered()
	Text 10,165,"Cam Coords: " +EntityX(Cam,True)+", "+EntityY(Cam,True)+", "+EntityZ(Cam,True)
	Text 10,180,"Player Coords: "+EntityX(Player,True)+", "+EntityY(Player,True)+", "+EntityZ(Player,True)
	Text 10,225,"MoveCell: "+MoveCell
	

	DrawImage Cursor,MouseX(),MouseY()
	Flip False
Wend

End

;------------------------------------------------------------------------CreateGround Function
Function CreateGround()
	Ground = CreateMesh()
	GSurf = CreateSurface(Ground)
	v0 = AddVertex(GSurf,-100,0,100)
	v1 = AddVertex(GSurf,100,0,-100)
	v2 = AddVertex(GSurf,-100,0,-100)
	v3 = AddVertex(GSurf,100,0,100)

	t0 = AddTriangle(GSurf,v0,v1,v2)
	t1 = AddTriangle(GSurf,v0,v3,v1)
End Function

;--------------------------------------------------------------------End CreateGround Function

;------------------------------------------------------------------------CreateObjects Function
Function CreateObjects()
	;CreateGround()
	Ground = CreateMesh()
	GSurf = CreateSurface(Ground)
	v0 = AddVertex(GSurf,-100,0,100)
	v1 = AddVertex(GSurf,100,0,-100)
	v2 = AddVertex(GSurf,-100,0,-100)
	v3 = AddVertex(GSurf,100,0,100)

	t0 = AddTriangle(GSurf,v0,v1,v2)
	t1 = AddTriangle(GSurf,v0,v3,v1)
	EntityColor Ground,130,95,0
	EntityPickMode Ground,2
	EntityType Ground,Type_Ground
	NameEntity Ground,"Ground"
		
	Player = CreateSphere()
	PositionEntity Player,0,2,0
	ScaleEntity Player,.5,1,.5
	EntityColor Player,255,255,0
	EntityRadius Player,2
	EntityPickMode Player,2
	EntityType Player,Type_Char
	NameEntity Player,"Player"
	
	House1 = CreateCube()
	PositionEntity House1,30,4,30
	ScaleEntity House1,5,3,10
	EntityColor House1,99,65,7
	EntityPickMode House1,2
	EntityType House1, Type_Structure
	NameEntity House1, "House1"
	
	House2 = CreateCube()
	PositionEntity House2,-30,4,-30
	ScaleEntity House2,5,3,10
	EntityColor House2,99,65,7
	EntityPickMode House2,2
	EntityType House2, Type_Structure
	NameEntity House2, "House2"
	
	A = 0
	B = 0
	While A <> 50
		Trees(A) = CreateCone()
		B = 0
		While B <> 1
			Tx = Rand(-100,100)
			Tz = Rand(-100,100)
			SelEnt = LinePick(Tx,50,Tz,0,-50,0)
			SelName$ = EntityName(PickedEntity())
			If SelName$ = "Ground"
				PositionEntity Trees(A),Tx,3,Tz
				B = 1
			EndIf
		Wend
		
		ScaleEntity Trees(A),2,2,2
		EntityColor Trees(A),0,128,0
		EntityPickMode Trees(A),2
		EntityType Trees(A), Type_Scenery
		NameEntity Trees(A), "Tree"+A
		A = A + 1
	Wend
		
	Cam = CreateCamera()
	PositionEntity Cam,-20,60,-20
	PointEntity Cam,Player
		
	CamPiv = CreatePivot()
	PositionEntity CamPiv,0,0,0
		
	EntityParent Cam,CamPiv
		
	Lite = CreateLight()
	PositionEntity Lite,0,50,0
	PointEntity Lite, Ground
End Function
;---------------------------------------------------------------------End CreateObjects Function

;------------------------------------------------------------------------Show_FPS Function

Function Show_FPS()
	If fps_timeout
		frame_count = frame_count + 1
		If MilliSecs() > fps_timeout Then
			fps_timeout = MilliSecs() + 1000 
			FPS = frame_count 
			frame_count = 0 
			If FPS < slowest_fps Or slowest_fps = 0 Then slowest_fps = FPS	
		EndIf 	
		If frame_time > slowest_frame Then slowest_frame = frame_time	
	Else
		; First call initialization.
		fps_timeout = MilliSecs() + 1000 
	EndIf
	Text 10,0,"FPS: " + FPS
End Function

;------------------------------------------------------------------------End Show_FPS Func


;-------------------------------------------------------------CreateCursor Func
Function CreateCursor()

	;Make a quick mouse cursor
	Color 255,255,0
	Cursor = CreateImage(15,15)
	Rect(0,0,10,10)
	Color 0,0,0
	Rect(3,3,10,10)
	Color 255,255,0
	Line(0,3,15,15)
	Line(0,2,15,15)
	Line(0,1,15,15)
	Line(0,0,15,15)
	Line(1,0,15,15)
	Line(2,0,15,15)
	Line(3,0,15,15)
	GrabImage Cursor,0,0

End Function
;-------------------------------------------------------------End CreateCursor Func

;-------------------------------------------------------------Point_Entity Func
Function Point_Entity(entity,x#,y#,z#)
	xdiff# = EntityX(entity)-x#
	ydiff# = EntityY(entity)-y#
	zdiff# = EntityZ(entity)-z#
	PEdist#=Sqr#((xdiff#*xdiff#)+(zdiff#*zdiff#))
	pitch# = ATan2(ydiff#,PEdist#)
	yaw# = ATan2(xdiff#,-zdiff#)
	RotateEntity entity,pitch#,yaw#,0
End Function
;-------------------------------------------------------------End Point_Entity

Great - apart from the 'entity' doesn't actually navigate its way around objects.

to make it move around objects, simply reduce the entity radius of the sphere...You are making it have an actual radius of .5, then telling the collisions with a radius of 2...To make the player seen over the path I also made the path spheres only .2 instead of .5 because the player sinks down with a smaller entity radius.

There is a small problem in rare occurance when an object goes crazy...It makes the path look like an area of a triangle, and the player just moves seemingly randomly through it...

edit: happens when the player is on one side of the orange box and you click almost directly on the other side of the box...


Great engine otherwise! Keep up the good work.

Thanks for the replies, even yours puki, lol.

I was thinking today though, if your pathfinding system is meant to make an object move around another object, then why would you need collision detection for those 2 objects?

lol, I'll keep playing with it.

Edit: Just as I suspected, turning the collisions of the player, scenary, and structures off, makes the player move alot better. And thanks for the idea of turning the radius down too, but like I said, why gobble up processing time if you dont need the collisions in the first place?

Yeah, but sometimes the player will move through corners of other meshes, making them look bad...I guess a better system to handle that problem would be to check the surrounding nodes to see if they are blocked and if so then perform a simple enititydistance on the entity that they represent...it would be faster and accurate to do it this way, but maybe not needed.

If you can manage to get rid of NPC collision then you'll save a lot of CPU power. You may want to turn collision between the player/camera dynamicly on when the NPC reaches a certain min distance.

BTW thanks for sharing your code. I didn't test it so far, (need to copy it to an offline machine first) but it sounds good.

What is it like, an "A*" thing or what?

Thanks again for the input, I can see what your talking about, if a characters mass exceeds the distance between 2 coords then, for instance, his shoulders may pass through objects. I will keep an eye on it and if it looks bad down the road, your fix may be the way to go.

JFK, it is A* up to the end, I dont trace a path back to the starting point using the parent flag although the parent flag IS filled in for each possible path cell, but when I looked at the closedlist file output, it always showed the correct cells for the path. This may be why the path gets bunched up around buildings though. Again, Ill look at this down the road again.

Good work man. This is the main area of programming i just don't get. I've yet to read a tutorial that fully explains this. I get it up to a certain point, then it goes down the tubes. So, good work!

Thanks Ross,
This was a major deal for me. I had to re-read everything that everyone posted about pathfinding everyday. I've tried everything I could think of to make a half way usable include file for pathfinding. Im sure there are alot of optimizations that could be done here like using heaps(?) or banks(?) but those are a wee bit out of my scope. Just getting the custom Type Array as Stevie G suggested made it feel like I just climbed Mt. Everest, hehehe.

This will be a major component of the project I'm working on, Im pretty jazzed that I got it this far.

Thanks.

Hey Xyle, I made some major changes to your code (it was a better start than what I had prieviously), thought you might want them...

there is a problem with the colored spheres, sometimes they pop an error, just get rid of them will solve this and it will also speed up the pathfind by about 10 times as well :)

main.bb

Graphics3D 800,600,32,2
SetBuffer BackBuffer()

Include "Pathfinding2.bb"

;Global Entities
Global Ground
Global Player
Global Cam
Global CamPiv
Global Lite
Dim Trees(50)
Global House1
Global House2


;Collision Type
Global Type_Ground = 1
Global Type_Char = 2
Global Type_Scenery = 3
Global Type_Structure = 4
	
Global SelEnt
Global SelName$
Global Move$
Global BegX#
Global BegZ#
Global DestX#
Global DestZ#
Global Cursor

Global EntX
Global EntY
Global EntZ

Global FPS
Global frame_count
Global fps_timeout
Global TarX
Global TarZ

;temp
Global ttime

Global path.array

;-------------FPS Stuff--------------------
SeedRnd MilliSecs()
fps_timer = CreateTimer(80) ; Lock to 60FPS.
;--------------end FPS Stuff----------------

CreateCursor()
CreateObjects()


Collisions Type_Char,Type_Ground,2,2
Collisions Type_Char,Type_Scenery,2,2
Collisions Type_Char,Type_Structure,2,2

ttime = MilliSecs()
CreateGrid(200,200)	
ttime = MilliSecs()-ttime	

While Not KeyHit(1)

	If KeyDown(13) ;+
		MoveEntity Cam,0,0,1
	EndIf
	If KeyDown(12) ;-
		MoveEntity Cam,0,0,-1
	EndIf
	If KeyDown(203) 
		TurnEntity CamPiv,0,-3,0
	EndIf
	If KeyDown(205) 
		TurnEntity CamPiv,0,3,0
	EndIf
	
	PositionEntity CamPiv,EntityX(Player,True),EntityY(Player,True),EntityZ(Player,True)
	
	If MouseHit(1)=True
		
			SelEnt = CameraPick(Cam,MouseX(),MouseY())
			If SelEnt > 0
				SelName$ = EntityName(PickedEntity())
				EntX = PickedX()
				EntY = PickedY()
				EntZ = PickedZ()
				If SelName$ = "Ground"
					BegX = EntityX(Player,True)
					BegZ = EntityZ(Player,True)
					DestX = PickedX#()
					DestZ = PickedZ#()
					ttime = MilliSecs()
					path = FindPath(BegX,BegZ,DestX,DestZ)
					ttime = MilliSecs()-ttime
					Move$ = "True"
					MoveCell = 1
				ElseIf Instr(SelName$,"Tree") > 0
					Move$ = "False"
				ElseIf Instr(SelName$, "House") > 0
					Move$ = "False"
				EndIf
			EndIf
	End If
	
	
	If Move$ = "True"
		BegX = EntityX(Player,True)
		BegZ = EntityZ(Player,True)
		
		If BegX < TarX + 1 And BegX > TarX - 1 And BegZ < TarZ + 1 And BegZ > TarZ -1
			MoveCell = MoveCell+1
			If moveCell <= path\s Then 
				TarX = path\a[MoveCell]\X
				TarZ = path\a[moveCell]\Z
			Else
				Move = "False"
			EndIf
		EndIf
		
		Point_Entity(Player,TarX,EntityY(Player,True),TarZ)
		MoveEntity Player,0,0,.05		
	EndIf
	
	MoveEntity Player,0,-0.035,0 ; gravity 
	
	UpdateWorld
	RenderWorld
	
	
	
	Color 255,0,0
	frame_time = MilliSecs() - frame_start
	Show_FPS()
	Color 255,255,0
	Text 10,15,"Press esc to exit, Arrow keys turn cam, - and = zoom camera"
	Text 10,30,"Click an object to select it, click the ground to move"
	Text 10,45,"red = path, blue = closed(fully checked), green = open(half checked)
	Color 255,255,255
	Text 10,90,"TotNodes = "+TotCells
	Text 10,105,"Sel Entity: "+SelName$+"("+EntX+","+EntY+","+EntZ+")"
	Text 10,120,"Ground Dims: "+MeshWidth(Ground) +", "+MeshHeight(Ground)+", "+MeshDepth(Ground)
	Text 10,135,"Ground Pos: "+EntityX(Ground,True)+", "+EntityZ(Ground,True)
	Text 10,150,"Tris: "+TrisRendered()
	Text 10,165,"Cam Coords: " +EntityX(Cam,True)+", "+EntityY(Cam,True)+", "+EntityZ(Cam,True)
	Text 10,180,"Player Coords: "+EntityX(Player,True)+", "+EntityY(Player,True)+", "+EntityZ(Player,True)
	Text 10,195,"find path speed: "+ttime
	Text 10,215,"MoveCell: "+MoveCell
	
	

	DrawImage Cursor,MouseX(),MouseY()
	WaitTimer(fps_timer)
	Flip False
Wend

End

;------------------------------------------------------------------------CreateGround Function

Function CreateGround()
	Ground = CreateMesh()
	GSurf = CreateSurface(Ground)
	v0 = AddVertex(GSurf,-100,0,100)
	v1 = AddVertex(GSurf,100,0,-100)
	v2 = AddVertex(GSurf,-100,0,-100)
	v3 = AddVertex(GSurf,100,0,100)

	t0 = AddTriangle(GSurf,v0,v1,v2)
	t1 = AddTriangle(GSurf,v0,v3,v1)
End Function

;--------------------------------------------------------------------End CreateGround Function

;------------------------------------------------------------------------CreateObjects Function
Function CreateObjects()
	;CreateGround()
	Ground = CreateMesh()
	GSurf = CreateSurface(Ground)
	v0 = AddVertex(GSurf,-100,0,100)
	v1 = AddVertex(GSurf,100,0,-100)
	v2 = AddVertex(GSurf,-100,0,-100)
	v3 = AddVertex(GSurf,100,0,100)

	t0 = AddTriangle(GSurf,v0,v1,v2)
	t1 = AddTriangle(GSurf,v0,v3,v1)
	EntityColor Ground,130,95,0
	EntityPickMode Ground,2
	EntityType Ground,Type_Ground
	NameEntity Ground,"Ground"
		
	Player = CreateSphere()
	PositionEntity Player,0,5,0
	ScaleEntity Player,.5,1,.5
	EntityColor Player,255,255,0
	EntityRadius Player,.5
	EntityPickMode Player,2
	EntityType Player,Type_Char
	NameEntity Player,"Player"
	
	House1 = CreateCube()
	PositionEntity House1,30,4,30
	ScaleEntity House1,5,3,10
	EntityColor House1,99,65,7
	EntityPickMode House1,2
	EntityType House1, Type_Structure
	NameEntity House1, "House1"
	
	House2 = CreateCube()
	PositionEntity House2,-30,4,-30
	ScaleEntity House2,5,3,10
	EntityColor House2,99,65,7
	EntityPickMode House2,2
	EntityType House2, Type_Structure
	NameEntity House2, "House2"
	
	A = 0
	While A <> 50
		Trees(A) = CreateCone()
		While True
			Tx = Rand(-100,100)
			Tz = Rand(-100,100)
			SelEnt = LinePick(Tx,50,Tz,0,-50,0)
			SelName$ = EntityName(PickedEntity())
			If SelName$ = "Ground"
				PositionEntity Trees(A),Tx,3,Tz
				Exit
			EndIf
		Wend
		
		ScaleEntity Trees(A),2,2,2
		EntityColor Trees(A),0,128,0
		EntityPickMode Trees(A),2
		EntityType Trees(A), Type_Scenery
		NameEntity Trees(A), "Tree"+A
		A = A + 1
	Wend
		
	Cam = CreateCamera()
	PositionEntity Cam,-20,60,-20
	PointEntity Cam,Player
		
	CamPiv = CreatePivot()
	PositionEntity CamPiv,0,0,0
		
	EntityParent Cam,CamPiv
		
	Lite = CreateLight()
	PositionEntity Lite,0,50,0
	PointEntity Lite, Ground
End Function
;---------------------------------------------------------------------End CreateObjects Function

;------------------------------------------------------------------------Show_FPS Function

Function Show_FPS()
	If fps_timeout
		frame_count = frame_count + 1
		If MilliSecs() > fps_timeout Then
			fps_timeout = MilliSecs() + 1000 
			FPS = frame_count 
			frame_count = 0 
			If FPS < slowest_fps Or slowest_fps = 0 Then slowest_fps = FPS	
		EndIf 	
		If frame_time > slowest_frame Then slowest_frame = frame_time	
	Else
		; First call initialization.
		fps_timeout = MilliSecs() + 1000 
	EndIf
	Text 10,0,"FPS: " + FPS
End Function

;------------------------------------------------------------------------End Show_FPS Func


;-------------------------------------------------------------CreateCursor Func
Function CreateCursor()

	;Make a quick mouse cursor
	Color 255,255,0
	Cursor = CreateImage(15,15)
	Rect(0,0,10,10)
	Color 0,0,0
	Rect(3,3,10,10)
	Color 255,255,0
	Line(0,3,15,15)
	Line(0,2,15,15)
	Line(0,1,15,15)
	Line(0,0,15,15)
	Line(1,0,15,15)
	Line(2,0,15,15)
	Line(3,0,15,15)
	GrabImage Cursor,0,0

End Function
;-------------------------------------------------------------End CreateCursor Func

;-------------------------------------------------------------Point_Entity Func
Function Point_Entity(entity,x#,y#,z#)
	xdiff# = EntityX(entity)-x#
	ydiff# = EntityY(entity)-y#
	zdiff# = EntityZ(entity)-z#
	PEdist#=Sqr#((xdiff#*xdiff#)+(zdiff#*zdiff#))
	pitch# = ATan2(ydiff#,PEdist#)
	yaw# = ATan2(xdiff#,-zdiff#)
	RotateEntity entity,pitch#,yaw#,0
End Function
;-------------------------------------------------------------End Point_Entity

pathfinding2.bb

;Include "containers\hash table container.bb"
Type Cell
	Field ID
	Field X
	Field Z
	Field FVal
	Field GVal
	Field HVal
	Field Walkable
	Field ListNum 	;0 = Not listed, 1 = Open, 2 = Closed
	Field Parent.cell	;parent for pathfinding
	
	;neighbering cells
	Field n_right.cell
	Field n_left.cell
	Field n_up.cell
	Field n_down.cell
	Field n_rightUp.cell
	Field n_rightDown.cell
	Field n_leftUp.cell
	Field n_leftDown.cell
	
End Type

Type array	;can be passed to and from functions :)
	Field a.cell[1000]	;the array
	Field s	;size
End Type

Global Grid.HashC =  hash_new()
Const nullnum = 999999

Dim Marker(1000)



;----------------------------------------------------------------------------------
Function CreateGrid(X,Z)
	;X and Z are map dimensions passed in, It will create a 2d grid containing (X+1 * Z+1) number
	;of cells. The +1 is for adding the 0 column and 0 row. I love MS Excel and VB, hehehe.

	For CellZ = (Z/2)*-1 To (Z/2) Step 1
	For CellX = (X/2)*-1 To (X/2) Step 1
		temp.cell = New Cell
		temp\ID = A
		temp\X = CellX
		temp\Z = CellZ
		temp\FVal = 0
		temp\GVal = 0
		temp\HVal = 0
		temp\Parent = Null	
		
		SelEnt = LinePick(CellX, 200, CellZ, 0, -1000, 0)
		If SelEnt > 0
			SelName$ = EntityName(PickedEntity())
			If SelName$ = "Ground"
				temp\Walkable = 1
			Else
				temp\Walkable = 0	
			EndIf
		EndIf	
		
		hash_set(Grid, Str(CellX)+","+Str(CellZ), Handle(temp))

		A = A + 1
	Next
	Next

	;find neighbors
	For CellZ = (Z/2)*-1 To (Z/2) Step 1
	For CellX = (X/2)*-1 To (X/2) Step 1
		;find cell
		Center.cell = Object.cell(hash_get(Grid,Str(CellX)+","+Str(CellZ)))
		;find neighbors
		Center\n_left = Object.cell(hash_get(Grid,Str(CellX-1)+","+Str(CellZ)))
		center\n_right = Object.cell(hash_get(Grid,Str(CellX+1)+","+Str(CellZ)))
		center\n_up = Object.cell(hash_get(Grid,Str(CellX)+","+Str(CellZ+1)))
		center\n_down = Object.cell(hash_get(Grid,Str(CellX)+","+Str(CellZ-1)))
		center\n_rightup = Object.cell(hash_get(Grid,Str(CellX+1)+","+Str(CellZ+1)))
		center\n_rightdown = Object.cell(hash_get(Grid,Str(CellX+1)+","+Str(CellZ-1)))
		center\n_leftUp = Object.cell(hash_get(Grid,Str(CellX-1)+","+Str(CellZ+1)))
		center\n_leftDown = Object.cell(hash_get(Grid,Str(CellX-1)+","+Str(CellZ-1)))
	Next
	Next
End Function
;----------------------------------------------------------------------------------

;----------------------------------------------------------------------------------
Function FindPath.array(StartX,StartZ,EndX,EndZ)
	;Clears any previously drawn path
	ClearPath()

	;Dim these variables to clear them
	temp_OpenList.array = New array ;used to store cells that need to be checked
	temp_OpenList\s = 0
	temp_ClosedList.array = New array
	temp_ClosedList\s = 0
	Final_Path.array = New array
	Final_Path\s = 0
	
	Local StartCell.cell

;1 - Move Char to nearest cell coords, if not there already
	StartCell = Object.cell(hash_get(Grid,Str(StartX)+","+Str(StartZ)))
	StartCell\Parent = StartCell
	
	;Add Starting Square to OpenList
	add_binaryHeap(temp_OpenList,StartCell)
	StartCell\ListNum = 1 ;0 = Not listed, 1 = Open, 2 = Closed

	F = 0
	
Repeat
;2 Put Starting Cell in closed list, this is where the player is at before the movement begins
	;If the Target cell is added to the closed list then the path is complete


	;Find the Cell with the lowest FCost in the Open list And Make it the New Start Cell
	;if there are no longer any cells on open list, then there is no path
	StartCell = subtract_binaryHeap(temp_Openlist)
	;add current cell to closed list
	temp_closedList\s = temp_closedList\s+1
	Temp_closedList\a[temp_closedList\s] = StartCell
	StartCell\ListNum = 2

	
	If StartCell\X = EndX And StartCell\Z = EndZ 
		;The Target cell has been found
		;Leave the loop
		Exit
	EndIf
	
;3 - Check each adjacent cell, Fill in each adjacent cells Fcost, Gcost, Hcost values
	;and parent values
	;Later, I may change the walkable to just check the adjacent cells instead of checking
	;the whole map at startup, I will try it and see what kind of slow down happens at runtime
	

	;Fill in GVal, HVal and FVal values and Create AdjCell() array and assign parents
	;left
		If StartCell\n_left <> Null And StartCell\n_left\ListNum = 0 Then
			StartCell\n_left\Parent = StartCell
			updateAdjacent(StartCell\n_left,EndX,EndZ,temp_OpenList)
		EndIf
	;right	
		If StartCell\n_right <> Null And StartCell\n_right\ListNum = 0 Then
			StartCell\n_right\Parent = StartCell
			updateAdjacent(StartCell\n_right,EndX,EndZ,temp_OpenList)
		EndIf
	;This is the Adjacent Cell Diagonal, up, Left of Start Cell
		If StartCell\n_leftup <> Null And StartCell\n_leftup\ListNum = 0 Then
			StartCell\n_leftup\Parent = StartCell
			updateAdjacent(StartCell\n_leftup,EndX,EndZ,temp_OpenList)
		EndIf
	;This is the Adjacent cell above the Start Cell
		If StartCell\n_up <> Null And StartCell\n_up\ListNum = 0 Then
			StartCell\n_up\Parent = StartCell
			updateAdjacent(StartCell\n_up,EndX,EndZ,temp_OpenList)
		EndIf
	;This is the adjacent cell to diagonal up right of Start Cell
		If StartCell\n_rightup <> Null And StartCell\n_rightup\ListNum = 0 Then
			StartCell\n_rightup\Parent = StartCell
			updateAdjacent(StartCell\n_rightup,EndX,EndZ,temp_OpenList)
		EndIf
	;This is the adjacent cell to diagonal Down Left of Start Cell
		If StartCell\n_leftdown <> Null And StartCell\n_leftdown\ListNum = 0 Then
			StartCell\n_leftdown\Parent = StartCell
			updateAdjacent(StartCell\n_leftdown,EndX,EndZ,temp_OpenList)
		EndIf
	;This is the Adjacent cell Below the Start Cell
		If StartCell\n_down <> Null And StartCell\n_down\ListNum = 0 Then
			StartCell\n_down\Parent = StartCell
			updateAdjacent(StartCell\n_down,EndX,EndZ,temp_OpenList)
		EndIf
	;This is the Adjacent Cell Diagonal, down, right of Start Cell
		If StartCell\n_rightdown <> Null And StartCell\n_rightdown\ListNum = 0 Then
			StartCell\n_rightdown\Parent = StartCell
			updateAdjacent(StartCell\n_rightdown,EndX,EndZ,temp_OpenList)
		EndIf	

	F = F + 1
	
Until F > 1000

	;find the length of the path
	start.cell = temp_ClosedList\a[temp_ClosedList\s]
	Repeat
		If start\parent = start Then Exit
		final_path\s = final_path\s + 1
		start = start\parent
	Forever
	
	;work from the ending square back to the front square, finding the actual path
	start.cell = temp_ClosedList\a[temp_ClosedList\s]
	a = final_path\s
	Repeat
		final_path\a[a] = start
		a = a -1
		start = start\parent
		If a < 1 Then Exit
	Forever
	
	;show the red dots!
	;ShowPath(final_path,temp_OpenList,temp_ClosedList)
	
	;Clear Openlist values, else it will interfere with a future pathfind
	For A = 1 To temp_OpenList\s
		temp_OpenList\a[A]\fVal = 0
		temp_OpenList\a[A]\GVal = 0
		temp_OpenList\a[A]\HVal = 0
		temp_OpenList\a[A]\ListNum = 0
		temp_OpenList\a[A]\Parent = Null
	Next
	Delete temp_OpenList

	;Clear Closedlist values, else it will interfere with a future pathfind
	For A = 1 To temp_ClosedList\s
		temp_ClosedList\a[A]\fVal = 0
		temp_ClosedList\a[A]\GVal = 0
		temp_ClosedList\a[A]\HVal = 0
		temp_ClosedList\a[A]\ListNum = 0
		temp_ClosedList\a[A]\Parent = Null
	Next
	Delete temp_ClosedList
		
	Return final_path
End Function
;----------------------------------------------------------------------------------

;----------------------------------------------------------------------------------
Function updateAdjacent(c.cell,endX,endZ,tOpenList.array)
	;calculate costs
		If c\X <> c\Parent\X And c\Z <> c\Parent\X ;Its Diagonal
			c\GVal = 14
		Else ;Its not Diagonal
			c\GVal = 10
		EndIf	
		c\HVal = 10*(Abs(c\X - EndX)) + 10*(Abs(c\Z - EndZ))
		c\FVal = c\Gval + c\HVal
		
	;add to open list if walkable
		If c\Walkable = 1
			add_binaryHeap(tOpenList,c)
			c\ListNum = 1
		EndIf

End Function
;----------------------------------------------------------------------------------

;----------------------------------------------------------------------------------
Function ShowPath(ThePath.array,open.array,closed.array) ;draws the path onscreen
	For i = 1 To ThePath\s
		Marker(i) = CreateSphere()
		PositionEntity Marker(i),ThePath\a[i]\X,1,ThePath\a[i]\Z
		ScaleEntity Marker(i),.2,.2,.2
		EntityColor Marker(i),255,0,0
	Next
	
	For i = 1 To closed\s
		Marker(i+ThePath\s) = CreateSphere()
		PositionEntity Marker(i+ThePath\s),closed\a[i]\X,1,closed\a[i]\Z
		ScaleEntity Marker(i+ThePath\s),.1,.1,.1
		EntityColor Marker(i+ThePath\s),0,0,255
	Next
	
	For i = 1 To open\s
		Marker(i+closed\s+ThePath\s) = CreateSphere()
		PositionEntity Marker(i+closed\s+ThePath\s),open\a[i]\X,1,open\a[i]\Z
		ScaleEntity Marker(i+closed\s+ThePath\s),.08,.08,.08
		EntityColor Marker(i+closed\s+ThePath\s),0,255,0
	Next
End Function
;----------------------------------------------------------------------------------

;----------------------------------------------------------------------------------
Function ClearPath() ;Clears a previously drawn path
	For p.array = Each array
		Delete p
	Next
;	For i = 1 To 1000
	;	If Marker(i) <> 0 Then
		;	FreeEntity Marker(i)
		;Else 
		;	Exit
	;	EndIf
	;Next
End Function
;----------------------------------------------------------------------------------

;sorting arrays-sorts to fval
Function QuickSort( L,R, TheArray.array, RandomPivot = True)
	Local A, B, SwapA.cell, Middle
	A = L
	B = R

	If RandomPivot Then
		Middle = TheArray\a[Rand(L,R)]\FVal
	Else
		Middle = TheArray\a[(L+R)/2]\FVal
	EndIf
	
	While True

		While TheArray\a[A]\FVal < Middle
			A = A + 1
			If A > R Then Exit
		Wend
		
		While  Middle < TheArray\a[B]\FVal
			B = B - 1
			If B < 1 Then Exit
		Wend
		
		If A > B Then Exit
		
		SwapA = TheArray\a[A]
		TheArray\a[A] = TheArray\a[B]
		TheArray\a[B] = SwapA
		
		A = A + 1
		B = B - 1
		
		If B < 1 Then Exit
		If A > R Then Exit
		
	Wend
	
	If L < B Then QuickSort( L, B, TheArray )
	If A < R Then QuickSort( A, R, TheArray )
	
	;get rid of null numbers
	B = R
	Repeat
		If TheArray\a[B]\FVal = nullnum Then 
			TheArray\a[B]\FVal = 0
			TheArray\s = TheArray\s - 1
		Else
			Exit
		EndIf
		B = B - 1
		If B <= 0 Then Exit
	Forever
End Function

;binary heap functions-sorts to fval 
;general algorithms by Patrick Lester
Function add_binaryHeap(heap.array,c.cell)
	heap\s = heap\s+1
	heap\a[heap\s] = c
	m = heap\s
  While m <> 1 ;While item hasn't bubbled to the top (m=1)
     ;Check if child is <= parent. If so, swap them.
     If c\FVal <= heap\a[m/2]\FVal Then
        temp.cell = heap\a[m/2]
        heap\a[m/2] = c
        heap\a[m] = temp
        m = m/2 
     Else
        Exit ;exit the while/wend loop
     End If
  Wend
End Function

Function subtract_binaryHeap.cell(heap.array)
	c.cell = heap\a[1]
	heap\a[1] = heap\a[heap\s]
	heap\a[heap\s] = Null
	heap\s = heap\s - 1
	v = 1

	;Repeat the following until the item sinks to its proper spot in the binary heap.
	Repeat
	  u = v
	  If 2*u+1 <= heap\s ;if both children exist
	    ;Select the lowest of the two children.
	    If heap\a[u]\FVal >= heap\a[2*u]\FVal Then v = 2*u ;SEE NOTE BELOW
	    If heap\a[v]\FVal >= heap\a[2*u+1]\FVal Then v = 2*u+1 ;SEE NOTE BELOW
	
	  Else If 2*u <= heap\s ;if only child #1 exists
	    ;Check if the F cost is greater than the child
	    If heap\a[u]\FVal >= heap\a[2*u]\FVal Then v = 2*u
	  End If
	
	  If u <> v Then ; If parent's F > one or both of its children, swap them
	    temp.cell = heap\a[u]
	    heap\a[u] = heap\a[v]
	    heap\a[v] = temp
	  Else
	    Exit ;if item <= both children, exit repeat/forever loop
	  End If
	Forever ;Repeat forever
	
	Return c
End Function 





;*****************************************hash table container lib by octothorpe***********************************

Const HASH_MAX_BUCKETS = 100000	;made this, really doesn't need to be higher than the totcells...
	; more buckets will make lookups faster in crowded hashes, but will use more memory
	; theoretically, overhead memory usage is (buckets * 16 bytes)

; ------------------------------------------------------------------------------
;= TYPES
; ------------------------------------------------------------------------------
Type hashC
	Field bucket.listC[HASH_MAX_BUCKETS-1]          ; a list of hashC_elems
	Field elements%
End Type

Type hashC_elem
	Field key$
	Field value
End Type

Type hashC_iter
	Field hash.hashC
	Field current_bucket%
	Field current_node.listC_node
	Field next_node.listC_node                      ; keep track of this so we can safely delete the current_node
End Type

; ------------------------------------------------------------------------------
;= FUNDAMENTAL
; ------------------------------------------------------------------------------

; ------------------------------------------------------------------------------
Function hash_new.hashC()
; create a new hash

	Return New hashC
End Function

; ------------------------------------------------------------------------------
Function hash_destroy(our_hash.hashC)
; delete a hash and all of its elements

	If our_hash = Null Then RuntimeError("not a valid hashC: null")

	; loop through each bucket
	For bucket_index% = 0 To HASH_MAX_BUCKETS-1
		Local this_element_list.listC = our_hash\bucket[bucket_index]

		If this_element_list <> Null Then
			; loop through each node in each bucket's list
			Local this_node.listC_node = this_element_list\first_node
			While this_node <> Null
				; destroy the element
				Delete Object.hashC_elem(this_node\value)
				; advance to next node in list
				this_node = this_node\next_node
			Wend
			; destroy the bucket
			list_destroy(this_element_list)
		EndIf
	Next
	; destroy the hash
	Delete our_hash
End Function

; ------------------------------------------------------------------------------
Function hash_set(our_hash.hashC, key$, value)
; set a key-value pair in a hash

	If our_hash = Null Then RuntimeError("not a valid hashC: null")

	; find the appropriate bucket
	Local our_element_list.listC = hash_choose_bucket(our_hash, key$)

	; look for an element with a matching key
	Local this_node.listC_node = our_element_list\first_node
	While this_node <> Null
		Local this_element.hashC_elem = Object.hashC_elem(this_node\value)
	
		; if the keys match, update the value and return from the function
		If (this_element\key$ = key$) Then
			this_element\value = value
			Return
		EndIf

		; look at the next node
		this_node = this_node\next_node
	Wend

	; if we didn't find an element to update, add a new element
	Local new_element.hashC_elem = New hashC_elem
	new_element\key$  = key$
	new_element\value = value
	list_push(our_element_list, Handle(new_element))
	
	; update element count
	our_hash\elements = our_hash\elements + 1

End Function


Function hash_delete(our_hash.hashC, key$)
; delete a key-value pair in a hash, returning the value

	If our_hash = Null Then RuntimeError("not a valid hashC: null")

	; find the appropriate bucket
	Local our_element_list.listC = hash_choose_bucket(our_hash, key$)

	; look for an element with a matching key
	Local this_node.listC_node = our_element_list\first_node
	While this_node <> Null
		Local this_element.hashC_elem = Object.hashC_elem(this_node\value)
	
		; if the keys match, remove this element and return the value
		If (this_element\key$ = key$) Then
			Local value = this_element\value
			Delete this_element
			list_remove_node(this_node)

			; update element count
			our_hash\elements = our_hash\elements - 1

			Return value
		EndIf

		; look at the next node
		this_node = this_node\next_node
	Wend

	; if we didn't find an element to update, return 0
	Return 0


End Function

; ------------------------------------------------------------------------------
Function hash_get(our_hash.hashC, key$)
; get a value from a hash by its key$

	If our_hash = Null Then RuntimeError("not a valid hashC: null")

	; find the appropriate bucket
	Local our_element_list.listC = hash_choose_bucket(our_hash, key$)

	; look for an element with a matching key
	Local this_node.listC_node = our_element_list\first_node
	While this_node <> Null
		Local this_element.hashC_elem = Object.hashC_elem(this_node\value)
	
		; if the keys match, update the value and return from the function
		If (this_element\key$ = key$) Then
			Return this_element\value
		EndIf

		; look at the next node
		this_node = this_node\next_node
	Wend

	; we didn't find the key, so return 0
	Return 0
End Function

; ------------------------------------------------------------------------------
;= INTERNAL
; ------------------------------------------------------------------------------

; ------------------------------------------------------------------------------
Function hash_choose_bucket.listC(our_hash.hashC, key$)
; return the linked list which corresponds with the key$

	; find the appropriate bucket index
	Local bucket_index% = hash_key_to_bucket_index(key$, HASH_MAX_BUCKETS)

	; make sure bucket has been initialized
	If (our_hash\bucket[bucket_index%] = Null) Then
		our_hash\bucket[bucket_index%] = list_new()
	EndIf

	Return our_hash\bucket[bucket_index%]

End Function

; ------------------------------------------------------------------------------
Function hash_key_to_bucket_index%(key$, modulus%)	
; come up with an index for any string, dependably coming up with the same index 
; for the same string, and attempting to distribute strings evenly over the 
; available indexes

	Local bucket_index%

	Local character_index
	For character_index = 1 To Len(key$)
		Local character$ = Mid$(key$, character_index, 1)
		bucket_index% = (bucket_index% * 123) + Asc(character)            ; arbitrary math, whee!
	Next

	; force the index to be valid (overflows might make the number negative)
	bucket_index% = Abs(bucket_index% Mod modulus)

	Return bucket_index%

End Function



;********************************************************double linked list (also by octothorpe)******************

Type listC
	Field elements%                       ; number of elements in list
	Field first_node.listC_node
	Field last_node.listC_node
End Type

Type listC_node
	Field list.listC                      ; parent list
	Field prev_node.listC_node            ; or null if this is the first node
	Field next_node.listC_node            ; or null if this is the last node
	Field value
End Type

Type listC_iter
	Field list.listC
	Field forwards                        ; bool to keep track of which direction we're going
	Field current_node.listC_node
	Field next_node.listC_node            ; keep track of this so we can safely delete the current_node
End Type

; ------------------------------------------------------------------------------
;= FUNDAMENTAL
; ------------------------------------------------------------------------------

; ------------------------------------------------------------------------------
Function list_new.listC()
; create a new list

	Return New listC
End Function

; ------------------------------------------------------------------------------
Function list_destroy(our_list.listC)
; delete a list and all of its nodes

	If our_list = Null Then RuntimeError("not a valid listC: null")
	
	; walk through the nodes, deleting them
	this_node.listC_node = our_list\first_node
	While (this_node <> Null)
		old_node.listC_node = this_node
		this_node = this_node\next_node
		Delete old_node
	Wend
	
	; finally, delete the list itself
	Delete our_list
End Function

; ------------------------------------------------------------------------------
Function list_push.listC_node(our_list.listC, value)
; add a new node to the end of a linked list

	If our_list = Null Then RuntimeError("not a valid listC: null")

	; create a new node
	Local our_node.listC_node = New listC_node
	our_node\list = our_list
	our_node\value = value

	; if the list is empty, set our node as the first and last
	If (our_list\first_node = Null) Then

		our_list\first_node = our_node
		our_list\last_node  = our_node
		our_list\elements   = 1

	; otherwise, add our node after the last
	Else

		our_list\last_node\next_node = our_node
		our_node\prev_node           = our_list\last_node
		our_list\last_node           = our_node

		our_list\elements = our_list\elements + 1

	EndIf

	Return our_node

End Function

; ------------------------------------------------------------------------------
Function list_unshift.listC_node(our_list.listC, value)
; add a new node to the beginning of a linked list

	If our_list = Null Then RuntimeError("not a valid listC: null")

	; create a new node
	Local our_node.listC_node = New listC_node
	our_node\list = our_list
	our_node\value = value

	; if the list is empty, set our node as the first and last
	If (our_list\first_node = Null) Then

		our_list\first_node = our_node
		our_list\last_node  = our_node
		our_list\elements   = 1

	; otherwise, add our node before the first
	Else

		our_list\first_node\prev_node = our_node
		our_node\next_node            = our_list\first_node
		our_list\first_node           = our_node

		our_list\elements = our_list\elements + 1

	EndIf

	Return our_node

End Function

; ------------------------------------------------------------------------------
Function list_pop(our_list.listC)
; remove an element from the end of a linked list, returning its value

	Return list_remove_node(our_list\last_node)
End Function

; ------------------------------------------------------------------------------
Function list_shift(our_list.listC)
; remove an element from the beginning of a linked list, returning its value

	Return list_remove_node(our_list\first_node)
End Function

; ------------------------------------------------------------------------------
Function list_insert_after.listC_node(reference_node.listC_node, value)
; add a new node after an existing one

	If reference_node = Null Then RuntimeError("not a valid listC_node: null")

	; create a new node
	Local our_node.listC_node = New listC_node
	our_node\list = reference_node\list
	our_node\value = value

	our_node\prev_node = reference_node
	our_node\next_node = reference_node\next_node
	reference_node\next_node = our_node
	
	If our_node\next_node <> Null Then
		our_node\next_node\prev_node = our_node

	Else
		our_node\list\last_node = our_node
	EndIf

	our_node\list\elements = our_node\list\elements + 1

	Return our_node

End Function

; ------------------------------------------------------------------------------
Function list_insert_before.listC_node(reference_node.listC_node, value)
; add a new node before an existing one

	If reference_node = Null Then RuntimeError("not a valid listC_node: null")

	; create a new node
	Local our_node.listC_node = New listC_node
	our_node\list = reference_node\list
	our_node\value = value

	our_node\next_node = reference_node
	our_node\prev_node = reference_node\prev_node
	reference_node\prev_node = our_node
	
	If our_node\prev_node <> Null Then
		our_node\prev_node\next_node = our_node
	Else
		our_node\list\first_node = our_node
	EndIf

	our_node\list\elements = our_node\list\elements + 1

	Return our_node

End Function

; ------------------------------------------------------------------------------
Function list_remove_node(our_node.listC_node)
; remove an arbitrary element from a linked list, returning its value

	; return 0 if we're trying to return an element that doesn't exist (e.g. empty_list\last_node)
	If (our_node = Null) Then Return 0

	; if there's a node before this one, it gets our next_node as its new next_node (or null if this is the last node)
	If (our_node\prev_node <> Null) Then
		our_node\prev_node\next_node = our_node\next_node
	EndIf

	; if there's a node after this one, it gets our prev_node as its new prev_node (or null if this is the first node)
	If (our_node\next_node <> Null) Then
		our_node\next_node\prev_node = our_node\prev_node
	EndIf

	; if this was the first node, the next node is now the first node (or null if the list is now empty)
	If (our_node = our_node\list\first_node) Then
		our_node\list\first_node = our_node\next_node
	EndIf

	; if this was the last node, the prev node is now the last node (or null if the list is now empty)
	If (our_node = our_node\list\last_node) Then
		our_node\list\last_node = our_node\prev_node
	EndIf

	; update the number of elements in the list
	our_node\list\elements = our_node\list\elements - 1

	; destroy the node, returning its value
	Local value = our_node\value
	Delete our_node
	Return value

End Function

; ------------------------------------------------------------------------------
Function list_count(our_list.listC)
	Return our_list\elements
End Function

; ------------------------------------------------------------------------------
;= ITERATORS
; ------------------------------------------------------------------------------

; sample usage

;	; for item.type = each list
;	it.listC_iter = list_iterator_begin(list)
;	while list_iterator_next(it)
;		item.type = object.type(list_iterator_get(it))
;	wend

; ------------------------------------------------------------------------------
Function list_iterator_begin.listC_iter(our_list.listC)
; create a new iterator for traversing the list forwards

	it.listC_iter = New listC_iter
	If our_list <> Null Then
		it\list = our_list
		it\forwards = True
		it\current_node = Null
		it\next_node = our_list\first_node
	EndIf
	Return it
End Function

; ------------------------------------------------------------------------------
Function list_iterator_begin_reverse.listC_iter(our_list.listC)
; create a new iterator for traversing the list backwards

	it.listC_iter = New listC_iter
	If our_list <> Null Then
		it\list = our_list
		it\forwards = False
		it\current_node = Null
		it\next_node = our_list\last_node
	EndIf
	Return it
End Function

; ------------------------------------------------------------------------------
Function list_iterator_next(it.listC_iter)
; advance the iterator to the next item in the list

	; drop out immediately if this iterator is void
	If it\list = Null Then Return False
	; if there's a next node, advance to it and return true
	If it\next_node <> Null Then
		it\current_node = it\next_node
		If it\forwards Then
			it\next_node = it\current_node\next_node
		Else
			it\next_node = it\current_node\prev_node
		EndIf
		Return True
	; otherwise, destroy the iterator and return false
	Else
		Delete it
		Return False
	EndIf
End Function

; ------------------------------------------------------------------------------
Function list_iterator_get(it.listC_iter)
; return the value of the element the iterator is currently on

	Return it\current_node\value
End Function

; ------------------------------------------------------------------------------
;= CONVENIENCE
; ------------------------------------------------------------------------------
Function list_find_node_by_value.listC_node(our_list.listC, value)
; find the first node in a list matching the value given

	If our_list = Null Then RuntimeError("not a valid listC: null")

	this_node.listC_node = our_list\first_node
	While (this_node <> Null)
		If this_node\value = value Then Return this_node
		; advance
		this_node = this_node\next_node
	Wend
	Return Null
End Function

; ------------------------------------------------------------------------------
Function list_find_node_by_position.listC_node(our_list.listC, index)
; find the Nth node in a list

	If our_list = Null Then RuntimeError("not a valid listC: null")

	If index < 0 Then index = our_list\elements - index

	; make sure there are enough nodes
	If index < 0 Or index > our_list\elements-1 Then Return Null

	this_node.listC_node = our_list\first_node
	For i = 0+1 To index
		this_node = this_node\next_node
	Next
	Return this_node
End Function

this uses Ocothorpe's container hash tables, they are very useful.


I'm still not sure whether using the quicksort algorithm is faster than a binary heap, but I use the quicksort anyways.
Edit: binary heap made much faster, updated above. note: took away the spheres, just uncomment them to put them back in.

WOW!

I dont understand Heaps and hash tables or some of your coding lingo you used there, but I love it!! The complicated code of the A* tutorials is what made me try and plug this thing out. I will keep my eyeballs on this little dandy. I never used types before I began this adventure and now I know theyll be growing out of my code, so I know Ill get the hash/ heap thing sooner or later. You did 1 helluva job there mindstorms and I greatly, trully appreciate it. Please forgive the smudges here, a few tear drops fell.

Thank you, thank you!!

Thanks Xyle!

There are always improvements to make, right now I am working on a two-tiered system...

Just thought I would let people know that using arrays for the grid data is much faster than using hash tables...