I've debugged and perfected my code. You're free to use it however you like!
rem setup screen
sync on
sync rate 60
backdrop on
color backdrop 0
hide mouse
autocam off
rem position camera
position camera 0 , 200 , -1000
point camera 0 , 0 , 0
rem create a nice image
create bitmap 1 , 64 , 64
a2box 0 , 0 , 63 , 63 , 0xFF202020
a2box 1 , 1 , 62 , 62 , 0xFF404040
for x = 1 to 1000
r = rnd(100)+40
a2circle rnd(50)+7,rnd(50)+7,rnd(3),rgb(r,r,r)
next x
blur bitmap 1 , 2
get image 1 , 0 , 0 , 64 , 64
delete bitmap 1
rem initialise the terrain
InitTerrain()
rem create a terrain with the size 1000x1000 and 20x20 divisions
MyTerrain = GenerateTerrainObject( 1000 , 1000 , 20 , 20 )
rem I want some random hills on my terrain. Scatter each vertex randomly
RandomizeTerrain( MyTerrain , 100 )
rem texture my terrain with the image I made above
TextureTerrain( MyTerrain , 1 )
rem I want the image to repeat on every tile
CalculateTerrainUV( MyTerrain , TERRAIN_TILED )
rem Hmm... How about having a spikey thingy in the centre?
rem this function can be optimised by using an array to index the vertices
rem rather than searching for them every time.
SetTerrainHeight( MyTerrain , 10 , 10 , 1000 )
rem Lets add a blue stripe to it!
for x = 0 to 20
SetTerrainDiffuse( MyTerrain , x , 5 , rgb( 0 , 0 , 255 ) )
next x
do
rem user info
set cursor 0,0
print "Terrain mesh created using matrix1 utils and vertexdata commands"
print "press <r> to randimize terrain"
print "press <f> to use full terrain for texture"
print "press <t> to tile texture"
print "press <h> to create a cool gaussian curve on your terrain"
print "press <g> to be gay"
rem randomize
if keystate( 19 ) then RandomizeTerrain( MyTerrain , 100 )
rem full texture
if keystate( 33 ) then CalculateTerrainUV( MyTerrain , TERRAIN_FULL )
rem tile texture
if keystate( 20 ) then CalculateTerrainUV( MyTerrain , TERRAIN_TILED )
rem gaussian curve
rem I'll be using the entire terrain (0,0,20,20), but if you want to just affect one area
rem you can change this to something different
if keystate( 35 ) then CalculateGaussianTerrain( MyTerrain , 0 , 0 , 20 , 20 , 10 , 10 , 3.5 , 100 )
rem gay
if keystate( 34 ) then center text 512 , 50 , "You're GAY"
sync
loop
rem ------------------------------------------
rem Functions for terrains as a mesh
rem ------------------------------------------
rem maximum amount of terrains
#constant MaxTerrain 20
rem for image UVs
#constant TERRAIN_TILED 0
#constant TERRAIN_FULL 1
rem vector 3 UDT
type vec3
x# as float
y# as float
z# as float
endtype
rem UDT for terrain
type TerrainAT
Obj as word
Width as float
Length as float
DivisionsX as integer
DivisionsY as integer
endtype
rem initialises anything to do with the terrains
function InitTerrain()
rem global arrays
global dim Terrain( MaxTerrain ) as TerrainAT
endfunction
rem returns the terrain ID
function GenerateTerrainObject( Width , Length , DivisionsX , DivisionsY )
rem local variables
local n as integer
local x as integer
local y as integer
local vert as integer
rem find a free slot
for n = 0 to MaxTerrain
if Terrain( n ).Obj = 0 then exit
next n
rem no free slot found
if n = MaxTerrain + 1 then exitfunction -1
rem create terrain
Terrain( n ).Obj = find free object()
make object plain Terrain( n ).Obj , Width , Length , DivisionsX , DivisionsY
rem reformat it to use FVF 338
convert object fvf Terrain( n ).Obj , 338
rem brighten terrain (default diffuse is 0)
vert = 0
lock vertexdata for limb Terrain( n ).Obj , 0
for x = 0 to DivisionsX
for y = 0 to DivisionsY
set vertexdata diffuse vert , rgb( 255 , 255 , 255 )
inc vert
next y
next x
unlock vertexdata
rem store some data
Terrain( n ).Width = Width
Terrain( n ).Length = Length
Terrain( n ).DivisionsX = DivisionsX
Terrain( n ).DivisionsY = DivisionsY
endfunction n
function DestroyTerrainObject( n )
rem make sure active
if n < 0 or n > MaxTerrain then exitfunction -1
if Terrain( n ).Obj = 0 then exitfunction -1
rem delete
delete object Terrain( n ).Obj
Terrain( n ).Obj = 0
endfunction n
rem requires the ID of the terrain
function RandomizeTerrain( n , Amplitude )
rem make sure terrain is active
if n < 0 or n > MaxTerrain then exitfunction -1
if Terrain( n ).Obj = 0 then exitfunction -1
rem local variables
local x as integer
local y as integer
local vert as integer
rem edit vertexdata
lock vertexdata for limb Terrain( n ).Obj , 0
rem loop through all vertices
vert = 0
for y = Terrain( n ).DivisionsY to 0 step -1
for x = 0 to Terrain( n ).DivisionsX
rem change height of vertex
set vertexdata position vert , get vertexdata position x( vert ) , (rnd( 1000 )/1000.0) * Amplitude , get vertexdata position z( vert )
rem next vertex
inc vert
next x
next y
unlock vertexdata
endfunction n
function SetTerrainHeight( n , DivisionX , DivisionY , height )
rem make sure active
if n < 0 or n > MaxTerrain then exitfunction -1
if Terrain( n ).Obj = 0 then exitfunction -1
rem local variables
local x as integer
local y as integer
local vert as integer
local success as integer
rem find vertex
vert = FindVertex( n , DivisionX , DivisionY )
rem edit height
lock vertexdata for limb Terrain( n ).Obj , 0
set vertexdata position vert , get vertexdata position x( vert ) , height , get vertexdata position z( vert )
unlock vertexdata
endfunction n
function CalculateTerrainUV( n , mode )
rem make sure active
if n < 0 or n > MaxTerrain then exitfunction -1
if Terrain( n ).Obj = 0 then exitfunction -1
rem local variables
local x# as float
local y# as float
rem edit vertices
lock vertexdata for limb Terrain( n ).Obj , 0
rem stretch over entire terrain
if mode = TERRAIN_FULL
vert = 0
for y = Terrain( n ).DivisionsY to 0 step -1
for x = 0 to Terrain( n ).DivisionsX
x# = x
y# = y
set vertexdata uv vert , x# / Terrain( n ).DivisionsX , y# / Terrain( n ).DivisionsY
inc vert
next x
next y
endif
rem tile image
if mode = TERRAIN_TILED
vert = 0
for y = Terrain( n ).DivisionsY to 0 step -1
for x = 0 to Terrain( n ).DivisionsX
set vertexdata uv vert , (x&&1) , (y&&1)
inc vert
next x
next y
endif
unlock vertexdata
endfunction n
function TextureTerrain( n , img )
rem make sure active
if n < 0 or n > MaxTerrain then exitfunction -1
if Terrain( n ).Obj = 0 then exitfunction -1
rem texture
texture object Terrain( n ).Obj , img
endfunction n
function CalculateGaussianTerrain( n , StartX , StartY , EndX , EndY , CenterX , CenterY , spread# , intensity )
rem make sure active
if n < 0 or n > MaxTerrain then exitfunction -1
if Terrain( n ).Obj = 0 then exitfunction -1
rem local variables
local x# as float
local y# as float
local height# as float
local x as integer
local y as integer
local vert as integer
rem lock vertexdata for editing
lock vertexdata for limb Terrain( n ).Obj , 0
rem loop through
vert = 0
for y = Terrain( n ).DivisionsY to 0 step -1
for x = 0 to Terrain( n ).DivisionsX
rem check if calculation is in bounds
if x >= StartX and x <= EndX and y >= StartY and y <= EndY
rem gaussian function to calculate height
x# = ((x-CenterX)/spread#)^2
y# = ((y-CenterY)/spread#)^2
height# = intensity*2.718281828^(0-(x#+y#))
rem set height
set vertexdata position vert , get vertexdata position x( vert ) , height# , get vertexdata position z( vert )
endif
rem next vertex
inc vert
next x
next y
unlock vertexdata
endfunction n
function SetTerrainDiffuse( n , x , y , color as dword )
rem make sure active
if n < 0 or n > MaxTerrain then exitfunction -1
if Terrain( n ).Obj = 0 then exitfunction -1
rem lock and edit diffuse
lock vertexdata for limb Terrain( n ).Obj , 0
set vertexdata diffuse FindVertex( n , x , y ) , color
unlock vertexdata
endfunction n
function FindVertex( n , DivisionX , DivisionY )
rem local variables
local success as integer
local vert as integer
local x as integer
local y as integer
rem find vertex. This function can be optimised by using an array to index the vertices
success = 0
vert = 0
for y = Terrain( n ).DivisionsY to 0 step -1
for x = 0 to Terrain( n ).DivisionsX
if DivisionX = x and DivisionY = y then success = 1:exit
inc vert
next x
if success = 1 then exit
next y
endfunction vert
TheComet
