Code archives/3D Graphics - Misc/3D tile system
This code has been declared by its author to be Public Domain code.
Download source code
| |||||
| This little system creates a tiled play area, combining surfaces where tiles share the same texture, for speed/memory efficiency. I may have made it a touch more confusing than necessary, as a tiled area can have tiles at different heights too -- the two 'levels' you see in the demo are actually part of the same 'TilePlane'... You'll need four texture-size BMP files (eg. 256 x 256) to try it out... Not tested an awful lot -- runs like crap on my laptop, so I didn't post it earlier, but I think that's just the fault of the slow gfx chip in that thing... | |||||
Type TilePlane
Field mesh ; This plane's mesh
Field surface.Surface ; List of surfaces in meshes
End Type
Type Surface
Field surf ; Surface handle
Field brush ; Brush used on this surface
Field tiles.TilePlane ; Plane this surface belongs to
End Type
Graphics3D 640, 480
cam = CreatePivot ()
camera = CreateCamera (cam)
CameraRange camera, 0.1, 1000
; Load some BRUSHES (not textures)...
grass = LoadBrush ("grass.bmp")
stone = LoadBrush ("stone.bmp")
moss = LoadBrush ("mossy.bmp")
water = LoadBrush ("water.bmp")
; Create a TilePlane (really just a mesh -- can have lots of 'y levels')...
level.TilePlane = CreateTilePlane ()
; Add each surface type to the TilePlane, using the appropriate brushes. NOTE
; that these surfaces are ONLY valid for this TilePlane. If you need the same
; image for a separate TilePlane, you need to create a new surface with the same
; brush...
grassy.Surface = AddTilePlaneSurface (level, grass)
stony.Surface = AddTilePlaneSurface (level, stone)
mossy.Surface = AddTilePlaneSurface (level, moss)
watery.Surface = AddTilePlaneSurface (level, water)
xsize = 32
zsize = 32
; -----------------------------------------------------------------------------
; Upper level...
; -----------------------------------------------------------------------------
For x = 0 To xsize - 1
For z = 0 To zsize - 1
Select Rand (5)
Case 1
AddSurfaceTile (grassy, x, z)
Case 2
AddSurfaceTile (stony, x, z)
Case 3
AddSurfaceTile (mossy, x, z)
Case 4
AddSurfaceTile (watery, x, z)
End Select
Next
Next
; -----------------------------------------------------------------------------
; Lower level...
; -----------------------------------------------------------------------------
y = -5
For x = 0 To xsize - 1
For z = 0 To zsize - 1
Select Rand (5)
Case 1
AddSurfaceTile (grassy, x, z, y)
Case 2
AddSurfaceTile (stony, x, z, y)
Case 3
AddSurfaceTile (mossy, x, z, y)
Case 4
AddSurfaceTile (watery, x, z, y)
End Select
Next
Next
; -----------------------------------------------------------------------------
UpdateTilePlaneNormals (level)
PositionEntity level\mesh, 0, -2, 0
EntityFX level\mesh, 16
ScaleMesh level\mesh, 4, 1, 4
Repeat
If KeyDown (203)
TurnEntity cam, 0, 2, 0, 1
Else
If KeyDown (205)
TurnEntity cam, 0, -2, 0, 1
EndIf
EndIf
If KeyDown (200)
TurnEntity cam, 1, 0, 0
Else
If KeyDown (208)
TurnEntity cam, -1, 0, 0
EndIf
EndIf
If KeyDown (30)
speed# = speed + 0.001
Else
If KeyDown (44)
speed# = speed - 0.001
EndIf
EndIf
MoveEntity cam, 0, 0, speed
If KeyHit (17) Then w = 1 - w: WireFrame w
If KeyHit (57)
If level <> Null Then FreeTilePlane (level)
EndIf
RenderWorld
Text 20, 20, TrisRendered ()
Flip
Until KeyHit (1)
End
Function CreateTilePlane.TilePlane ()
tp.TilePlane = New TilePlane
tp\mesh = CreateMesh ()
Return tp
End Function
Function AddTilePlaneSurface.Surface (tp.TilePlane, brush)
tp\surface = New Surface
tp\surface\surf = CreateSurface (tp\mesh)
tp\surface\tiles = tp
tp\surface\brush = brush
PaintSurface tp\surface\surf, tp\surface\brush
Return tp\surface
End Function
Function AddSurfaceTile (surface.Surface, x#, z#, y# = 0, width# = 1, height# = 1)
surf = surface\surf
topLeft = AddVertex (surf, x + (-width / 2), y, z + (height / 2), 0, 0)
topRight = AddVertex (surf, x + (width / 2), y, z + (height / 2), 1, 0)
bottomRight = AddVertex (surf, x + (width / 2), y, z + (-height / 2), 1, 1)
bottomLeft = AddVertex (surf, x + (-width / 2), y, z + (-height / 2), 0, 1)
AddTriangle (surf, topLeft, bottomRight, bottomLeft)
AddTriangle (surf, topLeft, topRight, bottomRight)
End Function
Function UpdateTilePlaneNormals (tp.TilePlane)
UpdateNormals tp\mesh
End Function
Function FreeTilePlane (tp.TilePlane)
For s.Surface = Each Surface
If s\tiles = tp
If s\brush Then FreeBrush s\brush
Delete s
EndIf
Next
FreeEntity tp\mesh
Delete tp
End Function |
Comments
None.
Code Archives Forum