I've implemented a basic voxel system using a linear octree data structure. The performance is surprisingly good. I'm not interested in remaking minecraft, but it just goes to show what you can do with AppGameKit and a bit of programming knowledge.
Here's the code:
SetWindowTitle( "Octree Demo" )
SetWindowSize( 1280, 720, 0 )
SetVirtualResolution( 1280, 720 )
SetOrientationAllowed( 1, 1, 1, 1 )
SetClearColor(0, 193, 255)
global updated
dim nodes[] as OctTreeNode
dim lookup[] as LookupItem
// Create root node (one huge block!)
CreateNode(-64, -64, -64, 64, 64, 64, 128, -1)
SetCameraPosition(1, 0, 0, -256)
SetCameraLookat(1, 0, 0, 0, 0)
pruneCounter = 0
updated = 0
do
if GetRawJoystickButtonState(1, 1) = 1 or GetPointerState() = 1
if GetPointerState() = 1
px = GetPointerX()
py = GetPointerY()
else
px = WorldToScreenX(640)
py = WorldToScreenY(360)
endif
worldX# = Get3DVectorXFromScreen(px, py) * 800
worldY# = Get3DVectorYFromScreen(px, py) * 800
worldZ# = Get3DVectorZFromScreen(px, py) * 800
worldX# = worldX# + GetCameraX(1)
worldY# = worldY# + GetCameraY(1)
worldZ# = worldZ# + GetCameraZ(1)
ob = ObjectRayCast(0, GetCameraX(1), GetCameraY(1), GetCameraZ(1), worldX#, worldY#, worldZ#)
if ob > 0
cx = GetObjectRayCastX(0)
cy = GetObjectRayCastY(0)
cz = GetObjectRayCastZ(0)
target = FindObjectNode(ob, cx, cy, cz, 0)
if target <> - 1
HitNode(target, cx, cy, cz)
updated = 1
endif
endif
endif
RotateCameraLocalX(1, -GetRawJoystickY(1))
RotateCameraLocalZ(1, -GetRawJoystickX(1))
RotateCameraLocalY(1, GetRawJoystickRZ(1))
MoveCameraLocalZ(1, -GetRawJoystickZ(1))
if pruneCounter >= 59
if updated = 1
PruneTree()
updated = 0
endif
pruneCounter = 0
endif
Print(ScreenFPS())
Print("Nodes: " + Str(nodes.Length))
Sync()
loop
function PruneTree()
// This function removes empty node entries after all blocks in them have been removed to keep the memory usage
// sensible after lots of deforming of the "terrain". It is not currently optimised.
for i = nodes.Length to 0 step -1
if nodes[i].ObjectID = -1 and nodes[i].ParentNode > -1
c = 1
for j = 0 to 7
if nodes[i].Children[j] <> -1
c = 0
exit
endif
next j
if c = 1
nodes[i].State = 0
p = nodes[i].ParentNode
for k = 0 to 7
if nodes[p].Children[k] = i
nodes[p].Children[k] = -1
exit
endif
next k
endif
endif
next i
dim newNodes[] as OctTreeNode
ClearLookup()
for i = 0 to nodes.Length
if nodes[i].State > 0
newNodes.Insert(nodes[i])
r = newNodes.Length
AddToLookup(i, r)
endif
next i
for i = 0 to newNodes.Length
if newNodes[i].ParentNode <> -1
newNodes[i].ParentNode = LookupValue(newNodes[i].ParentNode)
endif
for j = 0 to 7
if newNodes[i].Children[j] <> -1
newNodes[i].Children[j] = LookupValue(newNodes[i].Children[j])
endif
next j
next i
nodes.Length = -1
nodes = newNodes
endfunction
function HitNode(nodeID, cx, cy, cz)
local n as OctTreeNode
n = nodes[nodeID]
if n.Size = 1
for i = 0 to 7
if nodes[n.ParentNode].Children[i] = nodeID
// Orphan the node
nodes[n.ParentNode].Children[i] = -1
endif
next i
// Delete node
DeleteObject(n.ObjectID)
n.ObjectID = -1
n.State = 0
else
hs = n.Size / 2
x = GetObjectX(n.ObjectID)
y = GetObjectY(n.ObjectID)
z = GetObjectZ(n.ObjectID)
// Split the node in to 8
n.Children[0] = CreateNode(n.MinX, n.MinY, n.MinZ, x, y, z, hs, nodeID)
n.Children[1] = CreateNode(x, n.MinY, n.MinZ, n.MaxX, y, z, hs, nodeID)
n.Children[2] = CreateNode(x, n.MinY, z, n.MaxX, y, n.MaxZ, hs, nodeID)
n.Children[3] = CreateNode(n.MinX, n.MinY, z, x, y, n.MaxZ, hs, nodeID)
n.Children[4] = CreateNode(n.MinX, y, n.MinZ, x, n.MaxY, z, hs, nodeID)
n.Children[5] = CreateNode(x, y, n.MinZ, n.MaxX, n.MaxY, z, hs, nodeID)
n.Children[6] = CreateNode(x, y, z, n.MaxX, n.MaxY, n.MaxZ, hs, nodeID)
n.Children[7] = CreateNode(n.MinX, y, z, x, n.MaxY, n.MaxZ, hs, nodeID)
DeleteObject(n.ObjectID)
n.ObjectID = -1
n.State = 2
nodes[nodeID] = n
for i = 0 to 7
if IntersectsNode(n.Children[i], cx, cy, cz) = 1
HitNode(n.Children[i], cx, cy, cz)
exit
endif
next i
endif
endfunction
function CreateNode(x1#, y1#, z1#, x2#, y2#, z2#, size, parent)
local n as OctTreeNode
n.MinX = x1#
n.MinY = y1#
n.MinZ = z1#
n.MaxX = x2#
n.MaxY = y2#
n.MaxZ = z2#
n.Size = size
n.ParentNode = parent
n.State = 1
n.ObjectID = CreateObjectBox(size, size, size)
x# = (x1# + x2#) / 2.0
y# = (y1# + y2#) / 2.0
z# = (z1# + z2#) / 2.0
SetObjectPosition(n.ObjectID, x#, y#, z#)
c = ((DistanceBetween(x#, y#, z#, 0.0, 0.0, 0.0) + (size / 2)) / 64.0) * 255.0
SetObjectColor(n.ObjectID, 0, c, 0, 255)
for i = 0 to 7
n.Children[i] = -1
next i
nodes.Insert(n)
r = nodes.Length
endfunction r
function FindObjectNode(objectID, x, y, z, nodeID)
local n as OctTreeNode
n = nodes[nodeID]
if n.ObjectID > -1 and n.ObjectID = objectID
exitfunction nodeID
else
for i = 0 to 7
if n.Children[i] <> -1
if IntersectsNode(n.Children[i], x, y, z) = 1
r = FindObjectNode(objectID, x, y, z, n.Children[i])
if r <> -1
exitfunction r
endif
endif
endif
next i
endif
endfunction -1
function IntersectsNode(nodeID, x, y, z)
fx# = 0.1
local cn as OctTreeNode
cn = nodes[nodeID]
if x >= (cn.MinX - fx#) and x < (cn.MaxX + fx#) and y >= (cn.MinY - fx#) and y < (cn.MaxY + fx#) and z >= (cn.MinZ - fx#) and z < (cn.MaxZ + fx#)
exitfunction 1
endif
endfunction 0
function ClearLookup()
lookup.Length = -1
endfunction
function AddToLookup(key, value)
local item as LookupItem
item.Key = key
item.Value = value
lookup.Insert(item)
endfunction
function LookupValue(key)
for i = 0 to lookup.Length
if lookup[i].Key = key
exitfunction lookup[i].Value
endif
next i
endfunction -1
function DistanceBetween(x1#, y1#, z1#, x2#, y2#, z2#)
xx# = x2# - x1#
yy# = y2# - y1#
zz# = z2# - z1#
exitfunction Sqrt((xx# * xx#) + (yy# * yy#) + (zz# * zz#))
endfunction 0.0
type OctTreeNode
Size as integer
State as integer
MinX as float
MinY as float
MinZ as float
MaxX as float
MaxY as float
MaxZ as float
ObjectID as integer
ParentNode as integer
Children as integer[7]
endtype
type LookupItem
Key as integer
Value as integer
endtype
I use a HOTAS joystick for moving around. You may want to tweak the controls for whatever input device you use. You can use the mouse to remove blocks.
Hi. I am a real person (not a bot). I appreciate all replies and advice.
