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