grid...

Blitz3D Forums/Blitz3D Beginners Area/grid...

There ought to be a better way to snap to a grid than to do it this way:


Function snapToGrid(number,size=1)
	num = size
	Repeat
		If num*size > number Then Exit
		num = num*size
	Forever
	down = number Mod num
	
	num = 0
	Repeat 
		num = num+size
		If num > number Then Exit
	Forever
	up = num Mod number

	
	If up > down Then 
		num = number - down
	Else
		num = number + up
	EndIf
	Return num
End Function


edit: I think this is better...uses some globals and a type...the idea is that the grid starts at -width/2 and -depth/2...
Global Grid_width = 200
Global Grid_depth = 200
Global Grid_step = 1
Global med_size = 4
Global large_size = 8
.beginning
x = Input("x: ")
z = Input("z: ")
size = Input("size: ")
test.array = snapToGrid(x,z,size)
Print "result x: "+test\a[1]
Print "result z: "+test\a[2]
Goto beginning

Type array
	Field a[1000]
	Field s
End Type

Function snapToGrid.array(x,z,size=1)
	Select size
		Case 1
			size = Grid_step
		Case 2
			size = Grid_step*med_size
		Case 3
			size = Grid_step*large_size
	End Select
	
	numx = ((Floor(Float(x + grid_width/2)/size + .5)) * size) - grid_width/2
	numz = ((Floor(Float(z + grid_depth/2)/size + .5)) * size) - grid_depth/2
	
	a.array = New array
	a\s = 2
	a\a[1] = numx
	a\a[2] = numz
		
	Return a
End Function


Any ideas?

I think what you are doing is basically right, the main idea would be this:
snapx = (x + (size/2) / size) * size
snapz = (z + (size/2) / size) * size

Try this - written in Blitzmax but should work in Blitz3D (might need to replace 'DrawOval' with 'Oval' though):
Graphics 800,600

Const xStep% = 32
Const yStep% = 32

While Not KeyDown(key_escape)
	Cls
	drawgrid()
	drawcursor()
	Flip
Wend

Function DrawGrid()
	Local x%
	Local y%
	For X = 0 To GraphicsWidth() Step xStep
		For Y = 0 To GraphicsHeight() Step yStep
			DrawOval x-1,y-1,2,2
		Next
	Next
End Function

Function drawCursor()
	Local mX = MouseX()
	Local mY = MouseY()
	Local x% = mX - (mX Mod xStep)
	Local y% = mY - (mY Mod yStep)
	If mX Mod xStep > xStep/2
		x = x + xStep
	EndIf
	If mY Mod yStep > yStep/2
		y = y + yStep
	EndIf
	DrawOval x-4,y-4,8,8
End Function


Thanks, they both work...Which one is faster?

(it probably is a very small difference, but any speed bonus is welcome :)

Dunno, I don't have Blitz3D installed so I could test it, but it'd be in Blitzmax.

Write a loop that runs out after, say, 10 seconds, and count how many times the code runs in that time.

You might get false results from mine though as its drawing a lot of ovals. So take that out if you want a speed test based purely on the maths.

Turns out they are about the same on my computer...Had to go for a minute each before there was a difference of more than 1 loop....
Thanks everyone.

@ Gfk: you code worked nicely, a few things needed changing, and it seemed to flicker a little, not sure if is my graphics card, or the code. i fleshed it out alittle, and used a type. it seems to work well (and dosent flicker):

Graphics 640,480
;x and y steps
Const x_step=32
Const y_step=32
;type tile
Type tile
	Field x,y
End Type
;create grid
Dim grid.tile(GraphicsWidth(),GraphicsHeight())
;set buffer
SetBuffer BackBuffer()


;;MAIN LOOP;;
While Not KeyDown(1)
	Cls
	makegrid()
	drawcursor()
	Flip
	Wend
End
;;END;;

;;draw the grid function;;
Function makegrid()
For x=0 To GraphicsWidth() Step x_step
	For y=0 To GraphicsHeight() Step y_step
		grid(x,y)=New tile
		grid(x,y)\x=x
		grid(x,y)\y=y
		Oval x,y,2,2
	Next
Next
End Function

;;draw the cursor function;;
Function drawCursor()
	mX = MouseX()
	mY = MouseY()
	x% = mX - (mX Mod x_Step)
	y% = mY - (mY Mod y_Step)
	If mX Mod x_Step > x_Step/2
		x = x + x_Step
	EndIf
	If mY Mod y_Step > y_Step/2
		y = y + y_Step
	EndIf
	Oval x-4,y-4,8,8
End Function


P.S. plz tell me if it works 4 u :)

there is a huge memory leak, because each time you are creating new tiles and not deleting the old ones. In fact, there is no need for the type at all because you are simply taking the x and y values.

The fastest way is using SHR instead of / and SHL instead of * The disadvantage is that you can only divide/multiply with a power of 2.

@mindsotrms: im using types, because although this is a stand alone program, i presume it would be for use in an actual game, and usually a i figure you going to store bits of data on each tile (i know i do), not just using it as a grid (otherwise you could just texture a plain).

and oops...yeah, i should of cought that leak.....

JS

Exactly why my code has the globals and the array type :)

If I could ask another question:

I now have the 3 levels of pathfinding working individually, but need an idea as to when to use the 3 levels (small, med, large).

I am thinking that it should start in large until it is about 70-75% done, then switch to medium until it is about 95% and then go to small. If then the object runs into a collision their should be a second function that takes the next node and finds a path to it with a lower grid setting, inserting it into the first path...I can't figure out an efficient way to do this, and was also wondering if there were other cases I needed to account for.

The way the existing pathfinding works is you specify a startx/z and an endx/z and a size, and it finds a path to that size. Do I need to modify this, or do I just need to create a function that decides which grid size to use?

heres the pathfinding3 file:

Type Cell		;a cell in the pathfinding grid
	;Global fields
		Field size		;1=small,2=med,3=large
		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
	
		;neighboring 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
			Field neighbors.cell[8]
	;med/large fields
		;child cells
			Field c_right.cell
			Field c_left.cell
			Field c_up.cell
			Field c_down.cell
			Field c_rightUp.cell
			Field c_rightDown.cell
			Field c_leftUp.cell
			Field c_leftDown.cell
			Field childs.cell[8]
End Type

Type array	;can be passed to and from functions :)
	Field a.cell[3000]	;the array
	Field s	;size
	
	;return stuff 
	Field x,z
End Type

Dim Grid_s.cell(1,1)	;small cells
Dim Grid_m.cell(1,1)	;medium cells
Dim Grid_l.cell(1,1)	;large cells
Global Grid_step = 1		;the space between the smallest nodes
Global med_size = 4			;the number of nodes in med
Global large_size = 8		;the number of nodes in large
Global grid_width = 0		;width in x,z of map
Global grid_depth = 0

;X and Z are map dimensions passed in, It will create a 2d grid containing (X+1 * Z+1) number
;of cells. Space is the blitz units between the smallest nodes
Function CreateGrid(X,Z,space=1)
	Grid_step = space
	
	sstep = Grid_step
	mstep = Grid_step*med_size
	lstep = Grid_step*large_size
	
	grid_width = X
	grid_depth = Z
	
	Dim Grid_s(X,Z)
	Dim Grid_m(X,Z)
	Dim Grid_l(X,Z)
	
	tempz = Z Shr 1
	tempx = X Shr 1
	
	For CellZ = -tempz To tempz Step 1
	For CellX = -tempx To tempx Step 1
		
		;small stuff
			If cellx Mod sstep = 0 And cellz Mod sstep = 0 Then 
				temp.cell = New Cell
				temp\X = CellX
				temp\Z = CellZ
				temp\FVal = 0
				temp\GVal = 0
				temp\HVal = 0
				temp\Parent = Null
				temp\walkable = 1
				temp\size = 1
				Grid_s(CellX+tempx,CellZ+tempz) = temp
			EndIf
			
		;med stuff
			If cellx Mod mstep = 0 And cellz Mod mstep = 0 Then 
				temp.cell = New Cell
				temp\X = CellX
				temp\Z = CellZ
				temp\FVal = 0
				temp\GVal = 0
				temp\HVal = 0
				temp\Parent = Null
				temp\walkable = 1
				temp\size = 2
				Grid_m(CellX+tempx,CellZ+tempz)  = temp
			EndIf
		
		;large stuff
			If cellx Mod lstep = 0 And cellz Mod lstep = 0 Then 
				temp.cell = New Cell
				temp\X = CellX
				temp\Z = CellZ
				temp\FVal = 0
				temp\GVal = 0
				temp\HVal = 0
				temp\Parent = Null
				temp\walkable = 1
				temp\size = 3
				Grid_l(CellX+tempx,CellZ+tempz)  = temp
			EndIf

	Next
	Next

	
	;find neighbors/children
	Local size = 0
	For CellZ = -tempz To tempz Step 1
	For CellX = -tempx To tempx Step 1
		;small
			size = sstep
			If CellX Mod size = 0 And CellZ Mod size = 0 Then 
				;find cell
					Center.cell = Grid_s(CellX+tempx,CellZ+tempz)
				;find neighbors
					i = 1
					offX = -size
					offZ = -size
					While offX <= size
					While offZ <= size
						;boundary check
						If CellX+offx+tempX <= X And CellX+offX+tempX >= 0 And CellZ+offZ+TempZ <= Z And CellZ+offZ+tempZ >= 0 Then 
							Center\neighbors[i] = Grid_s(CellX+tempX+offX,CellZ+tempZ+OffZ)
						EndIf
						If offZ <> 0 Or OffX <> 0 Then i = i + 1	;skip center
						offZ = offZ + size	
					Wend
						offX = OffX + size
						OffZ = -size
					Wend				
			EndIf
			
		;med
			size = mstep
			If CellX Mod size = 0 And CellZ Mod size = 0 Then 
				;find cell
					Center.cell = Grid_m(CellX+tempx,CellZ+tempz)
				;find neighbors/children
					i = 1
					offX = -size
					offZ = -size
					While offX <= size
					While offZ <= size
						;boundary check
						If CellX+offx+tempX <= X And CellX+offX+tempX >= 0 And CellZ+offZ+TempZ <= Z And CellZ+offZ+tempZ >= 0 Then 
							Center\neighbors[i] = Grid_m(CellX+tempX+offX,CellZ+tempZ+OffZ)
							Center\childs[i] = Grid_s(CellX+tempX+(offX/2),CellZ+tempZ+(offZ/2))
						EndIf
						If offZ <> 0 Or OffX <> 0 Then i = i + 1	;skip center
						offZ = offZ + size	
					Wend
						offX = OffX + size
						OffZ = -size
					Wend
			EndIf
			
		;large
			size = lstep
			If CellX Mod size = 0 And CellZ Mod size = 0 Then 
				;find cell
					Center.cell = Grid_l(CellX+tempx,Cellz+tempz)
				;find neighbors/children
					i = 1
					offX = -size
					offZ = -size
					While offX <= size
					While offZ <= size
						;boundary check
						If CellX+offx+tempX <= X And CellX+offX+tempX >= 0 And CellZ+offZ+TempZ <= Z And CellZ+offZ+tempZ >= 0 Then 
							Center\neighbors[i] = Grid_l(CellX+tempX+offX,CellZ+tempZ+OffZ)
							Center\childs[i] = Grid_s(CellX+tempX+(offX/2),CellZ+tempZ+(offZ/2))
						EndIf
						If offZ <> 0 Or OffX <> 0 Then i = i + 1	;skip center
						offZ = offZ + size	
					Wend
						offX = OffX + size
						OffZ = -size
					Wend
			EndIf
	Next
	Next
End Function

;adds a rectangular obstacle (with x,z being bottom left point?)
Function addObstacle_manual(x,z,width,depth)
	For xcell = x To width Step 1
	For zcell = z To depth Step 1
	If xCell Mod Grid_step = 0 And zCell Mod Grid_step = 0 Then 
		temp.cell = Grid_s(xcell+(grid_width Shr 1),zcell+(grid_depth Shr 1)) 
		temp\walkable = 0
	EndIf
	Next
	Next
End Function

;adds an obstacle according to a mesh
Function addObstacle_automatic(mesh)
	;make sure it is a mesh :)
	If EntityClass$(mesh) <> "Mesh" Then RuntimeError("invalid mesh handle")
	pcenter = center_mesh(mesh)
	height = MeshHeight(mesh)*EntityScaleY(mesh)+10
	width = (MeshWidth(mesh) Shr 1)*EntityScaleX(mesh)+1
	depth = (MeshDepth(mesh) Shr 1)*EntityScaleZ(mesh)+1
	For x = EntityX(pcenter)-width To EntityX(pcenter)+width Step 1
	For z = EntityZ(pcenter)-depth To EntityZ(pcenter)+depth Step 1
	If x Mod Grid_step = 0 And z Mod Grid_step = 0 Then 
		this.cell = Grid_s(X+(grid_width Shr 1),Z+(grid_depth Shr 1)) 
		SelEnt = LinePick(x,height,z, 0, -height, 0,.5)
		If SelEnt > 0
			SelName$ = EntityName(SelEnt)
			If SelName$ = "Ground"
				this\Walkable = 1
			Else
				this\Walkable = 0	
			EndIf
		EndIf
	EndIf	
	Next
	Next
	FreeEntity pcenter	
End Function

;do this first before deleteing mesh...frees the unwalkable area made by a mesh
Function removeObstacle_automatic(mesh)
	;make sure it is a mesh :)
	If EntityClass$(mesh) <> "Mesh" Then RuntimeError("invalid mesh handle")
	pcenter = center_mesh(mesh)
	
	height = MeshHeight(mesh)*EntityScaleY(mesh)+10
	width = (MeshWidth(mesh) Shr 1)*EntityScaleX(mesh)+1
	depth = (MeshDepth(mesh) Shr 1)*EntityScaleZ(mesh)+1
	
	For x = EntityX(pcenter)-width To EntityX(pcenter)+width Step 1
	For z = EntityZ(pcenter)-depth To EntityZ(pcenter)+depth Step 1
	If x Mod Grid_step = 0 And z Mod Grid_step = 0 Then 
		this.cell = Grid_s(X+(grid_width Shr 1),Z+(grid_depth Shr 1)) 
		SelEnt = LinePick(x,height,z, 0, -height, 0,.5)
		If SelEnt > 0
			SelName$ = EntityName(SelEnt)
			If SelName$ = "Ground" Or SelName$ = EntityName(mesh) Then 
				this\Walkable = 1
			EndIf
		EndIf
	EndIf	
	Next
	Next
	FreeEntity pcenter			
End Function

;removes a rectangular obstacle with x,z being top left point
Function removeObstacle_manual(x,z,width,depth)
	For xcell = x To width Step 1
	For zcell = z To depth Step 1
	If xcell Mod Grid_step = 0 And zcell Mod Grid_step = 0 Then 
		temp.cell = Grid_s(xCell+(grid_width Shr 1),zCell+(grid_depth Shr 1)) 
		temp\walkable = 1
	EndIf
	Next
	Next
End Function

;manages how to use the tiered pathfinding
Function find_path.array(StartX,StartZ,EndX,EndZ)
	;make start/end coords the smallest grid size
		startcoords.array = snapToGrid(StartX,StartZ,1)
		StartX = startcoords\x
		StartZ = startcoords\z
		Delete startcoords
	
		EndCoords.array = snapToGrid(EndX,EndZ,1)
		EndX = endcoords\x
		EndZ = endcoords\z
		Delete EndCoords

	;the returning array
		final.array = New array
	
	;the intermediate arrays
		large.array = New array
		medium.array = New array
		small.array = New array
	
	large = FindPath(StartX,StartZ,EndX,EndZ,3)
	If large <> Null Then 
		If large\a[large\s]\x = EndX And large\a[large\s]\z = endY Then 
			final = large
			Delete large
			Delete medium
			Delete small
			Return final
		EndIf
		StartX = large\a[large\s]\x
		StartZ = large\a[large\s]\z
	EndIf
	
	medium = FindPath(StartX,StartZ,EndX,EndZ,2)
	If medium <> Null Then 
		If medium\a[medium\s]\x = EndX And medium\a[medium\s]\z = endY Then 
			final = addArrays(large,medium)
			Delete large
			Delete medium
			Delete small
			Return final
		EndIf
		StartX = medium\a[medium\s]\x
		StartZ = medium\a[medium\s]\z
	EndIf
	
	small = FindPath(StartX,StartZ,EndX,EndZ,1)
	If small <> Null Then 
		final = addArrays(large,addArrays(medium,small))
		Delete large
		Delete medium
		Delete small
		Return final
	EndIf
	Return empty.array
End Function


;finds the actual path with the starting coords and the ending coords
;you can use this to use regular pathfinding...startsize = 1(small),2(med),3(large)
Function FindPath.array(StartX,StartZ,EndX,EndZ,StartSize=1)

	;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
	startcoords.array = snapToGrid(StartX,StartZ,StartSize)
	StartX = startcoords\x
	StartZ = startcoords\z
	Delete startcoords

	;move ending coords too
	EndCoords.array = snapToGrid(EndX,EndZ,StartSize)
	EndX = endcoords\x
	EndZ = endcoords\z
	Delete EndCoords
	
	Select StartSize
		Case 1
			StartCell = Grid_s(StartX+(grid_width Shr 1),StartZ+(grid_depth Shr 1)) 
		Case 2
			StartCell = Grid_m(StartX+(grid_width Shr 1),StartZ+(grid_depth Shr 1)) 
		Case 3
			StartCell = Grid_l(StartX+(grid_width Shr 1),StartZ+(grid_depth Shr 1)) 
	End Select
	
	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
	If StartCell = Null Then Return Null
	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
	For i = 1 To 8
		If StartCell\neighbors[i] <> Null Then 	;if exists
			If StartCell\neighbors[i]\ListNum = 0 Then 	;if not already checked
				StartCell\neighbors[i]\Parent = StartCell		;parent cell to startcell
				updateAdjacent(StartCell\neighbors[i],EndX,EndZ,i,temp_openlist)	;update cells value, add to list
			EndIf
		EndIf
	Next

	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
		
	;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
;----------------------------------------------------------------------------------


;*************************private functions************************************************

Function updateAdjacent(c.cell,endX,endZ,direction,tOpenList.array)
	Select c\size
		Case 1
			;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 Then 
					add_binaryHeap(tOpenList,c)
					c\ListNum = 1
				EndIf
		Case 2,3
			If c\Parent\childs[direction]\Walkable = 0 Then Return 
			
			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_binaryHeap(tOpenList,c)
			c\ListNum = 1
			
	End Select
		
End Function

;size 1,2,or 3 (small,med,large)
Function snapToGrid.array(x,z,size=1)
	Select size
		Case 1
			size = Grid_step
		Case 2
			size = Grid_step*med_size
		Case 3
			size = Grid_step*large_size
	End Select

	numx = ((Floor(Float(x)/size + .5)) * size)
	numz = ((Floor(Float(z)/size + .5)) * size)
	
	a.array = New array
	a\s = 2
	a\x = numx
	a\z = numz
		
	Return a
End Function

Function addArrays.array(a.array,b.array)
	result.array = New array
	result\s = a\s+b\s
	For i = 1 To a\s
		result\a[i] = a\a[i]
	Next
	For i = a\s+1 To a\s+1+b\s
		result\a[i] = b\a[i-(a\s)]
	Next
	Return result
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 Shr 1]\FVal Then
        temp.cell = heap\a[m Shr 1]
        heap\a[m Shr 1] = c
        heap\a[m] = temp
        m = m Shr 1 
     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 (u Shl 1)+1 <= heap\s ;if both children exist
	    ;Select the lowest of the two children.
	    If heap\a[u]\FVal >= heap\a[u Shl 1]\FVal Then v = u Shl 1 ;SEE NOTE BELOW
	    If heap\a[v]\FVal >= heap\a[(u Shl 1)+1]\FVal Then v = (u Shl 1)+1 ;SEE NOTE BELOW
	
	  Else If u Shl 1 <= heap\s ;if only child #1 exists
	    ;Check if the F cost is greater than the child
	    If heap\a[u]\FVal >= heap\a[u Shl 1]\FVal Then v = u Shl 1
	  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 

;------------------------------------------------------------------------
;centers a pivot to a mesh for automatic addobstacle
Function center_mesh(mesh)
	piv = CreatePivot()
	mesh2 = CopyMesh(mesh)
	PositionEntity(mesh2,EntityX(mesh),EntityY(mesh),EntityZ(mesh))
	MESHcenter(mesh2)
	PositionEntity(piv,EntityX(mesh2),EntityY(mesh2),EntityZ(mesh2))
	FreeEntity(mesh2)
	Return piv
End Function

Function MESHcenter( Mesh )

  W# = MeshWidth( Mesh )
  H# = MeshHeight( Mesh )
  D# = MeshDepth( Mesh )
  FitMesh Mesh, W*.5, -H*.5, -D*.5, W, H, D

End Function

Function EntityScaleX#(Entity)

	Vx# = GetMatElement(Entity, 0, 0)
	Vy# = GetMatElement(Entity, 0, 1)
	Vz# = GetMatElement(Entity, 0, 2)	
	
	Scale# = Sqr(Vx#*Vx# + Vy#*Vy# + Vz#*Vz#)
	
	Return Scale#

End Function

Function EntityScaleY#(Entity)

	Vx# = GetMatElement(Entity, 1, 0)
	Vy# = GetMatElement(Entity, 1, 1)
	Vz# = GetMatElement(Entity, 1, 2)	
	
	Scale# = Sqr(Vx#*Vx# + Vy#*Vy# + Vz#*Vz#)
	
	Return Scale#

End Function

Function EntityScaleZ#(Entity)

	Vx# = GetMatElement(Entity, 2, 0)
	Vy# = GetMatElement(Entity, 2, 1)
	Vz# = GetMatElement(Entity, 2, 2)	
	
	Scale# = Sqr(Vx#*Vx# + Vy#*Vy# + Vz#*Vz#)
	
	Return Scale#

End Function

note that the find_path is just a test to see if the levels work with each other.

here is the main...slightly disorganized
Graphics3D 800,600,32,2
SetBuffer BackBuffer()
HidePointer()
Include "Pathfinding3.bb"
SeedRnd MilliSecs()

;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(60) ; Lock to 60FPS.
;--------------end FPS Stuff----------------

CreateCursor()



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)	
CreateObjects()
ttime = MilliSecs()-ttime	
;test()
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()
					Delete path		;required
					path = Find_Path(BegX,BegZ,DestX,DestZ)
					ttime = MilliSecs()-ttime
					If path <> Null Then 
						Move$ = "True"
						MoveCell = 1
					EndIf
				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,.5		
	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,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 
Wend

End
Function test()
	For x = -100 To 100
	For z = -100 To 100	
		
		;If x Mod 4 = 0 And z Mod 4 = 0 Then 
			temp.cell = Null;Object.cell(hash_get(grid_s,x+","+z))
			If temp\walkable = 0 Then
			
				try = CreateSphere()
				EntityColor(try,0,255,0)
				 EntityColor(try,255,0,0)
				ScaleEntity try,.5,.5,.5
				PositionEntity try,temp\x,1,temp\z
			EndIf
			
	Next
	Next
End 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)
	UpdateNormals(Ground)
	EntityColor Ground,0,0,255
	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"
	addObstacle_automatic(House1)
	;EntityAlpha(House1,.6)
	;FreeEntity(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"
	addObstacle_automatic(House2)
	;EntityAlpha(House2,.6)
	;FreeEntity(House2)
	
	A = 0
	While A <> 50
		Trees(A) = CreateCone()
		While True
			Tx = Rand(-90,90)
			Tz = Rand(-90,90)
			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
		addObstacle_automatic(Trees(A))
	;	EntityAlpha(Trees(A),.6)
		;FreeEntity(Trees(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


Gfk: you code worked nicely, a few things needed changing, and it seemed to flicker a little
Yep, my bad. I set a 2D graphics mode and assumed that because its Blitz3D it uses the BackBuffer by default. I haven't used Blitz3D for over a year now, and forgotten that the BackBuffer is only used by default in 3D graphics modes, hence the flicker (which didn't actually show up on my PC anyway).

I'm still looking for solutions to this...It is still not working any faster than just using the small or medium modes...

Nicely done! :)