Code archives/3D Graphics - Misc/3D tile system

This code has been declared by its author to be Public Domain code.

Download source code

3D tile system by BlitzSupport
(Posted 24 years ago)
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