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