A useful little function that you can use to randomly generate a terrain that doesn't just look like a randomized matrix.
sync rate 100
`Terrain scale
xscale#=5
yscale#=1
zscale#=5
`Height map size in pixels
is=255
smooth=10 `Sets the smoothness of the terrain (1=least smooth)
detail=100 `Sets the detail of the terrain (1=least detailed)
Rndmap(is,smooth,detail)
Maketextures(is)
Maketerrain(1,xscale#,yscale#,zscale#)
px#=(get terrain x size(1)*xscale#)/2
pz#=(get terrain z size(1)*zscale#)/2
py#=get terrain ground height(1,px#,pz#)
position camera px#,py#+5,pz#
Do
gosub controlcamera
loop
controlcamera:
`Little bit of code just to move the camera about
px#=Camera position x()
pz#=Camera position z()
py#=Camera position y()
pang#=Camera angle y()
speed#=curvevalue((upkey()-downkey()),speed#,15)
AngleY# = WrapValue(AngleY#+(rightkey()-leftkey())*5)
pang#=CurveAngle(AngleY#,camera angle y(),15)
px#=newxvalue(px#,pang#,speed#)
pz#=newzvalue(pz#,pang#,speed#)
py#=get terrain ground height(1,px#,pz#)
position camera px#,py#+20,pz#
yrotate camera pang#
return
function Rndmap(is,smooth,detail)
dim col(is,is)
dim newcol(is,is)
`Quick random high level wash
for x=0 to is
for y=0 to is
col(x,y)=rnd(30)+200
next y
next x
`leaves the outer edges high but lower's the middle
for x=9 to is-9
for y=9 to is-9
col(x,y)=rnd(80)+80
next y
next x
`Adds in random boxes and circles of different heights
for d=1 to detail
col=rnd(80)+80
if rnd(1)=1
rad=rnd(20)+1
rx=rnd((is-rad*4)-8)+rad*2+4
ry=rnd((is-rad*4)-8)+rad*2+4
for r=0 to rad
for ang=1 to 360
col(int(rx+sin(ang)*r),int(ry+cos(ang)*r))=col
next ang
next r
else
xs=rnd(20)+1
ys=rnd(20)+1
rx=rnd((is-xs*4)-8)+xs*2+4
ry=rnd((is-ys*4)-8)+ys*2+4
for x=rx-xs to rx+xs
for y=ry-ys to ry+ys
col(x,y)=col
next y
next x
endif
next d
`gives final random wash
for x=0 to is
for y=0 to is
col(x,y)=col(x,y)+(rnd(40)-20)
if col(x,y)>255 then col(x,y)=255
next y
next x
`Smooths out the texture
for s=1 to smooth
for x=2 to is-2
for y=2 to is-2
tcol=0
av=0
for sx=-2 to 2
for sy=-2 to 2
inc av
inc tcol,col(x+sx,y+sy)
next sy
next sx
newcol(x,y)=tcol/av
next y
next x
if s<5
for x=3 to is-3
for y=3 to is-3
col(x,y)=newcol(x,y)
next y
next x
endif
next s
`Draws image
lock pixels
for x=0 to is
for y=0 to is
dot x,y,rgb(newcol(x,y),newcol(x,y),newcol(x,y))
next y
next x
unlock pixels
`Saves image
get image 5000,0,0,is,is
if file exist("heightmap.jpg") then delete file "heightmap.jpg"
save image "heightmap.jpg",5000
delete image 5000
cls 0
undim col(0)
`The code below is commented out purely as i'm using the data in this array later on
`to generate the textures. It would usually be left in.
`undim newcol(0)
endfunction
function Maketerrain(tn,xscale#,yscale#,zscale#)
make object terrain tn
set terrain heightmap tn ,"heightmap.jpg"
set terrain scale tn ,xscale#,yscale#,zscale#
set terrain split tn ,16
set terrain tiling tn ,16
set terrain light tn ,1,-1,0,1,1,1,0.5
set terrain texture tn ,1000,2000
build terrain tn
update terrain tn
endfunction
Function Maketextures(is)
`Set to 0 for grass, 1 for sand
map=1
`Makes a random terrain texture
lock pixels
for x=0 to is
for y=0 to is
col#=newcol(x,y)
if col#>200 then col#=150
inc col#,rnd(20)-20
if map=0
dot x,y,rgb(0,col#,0)
else
dot x,y,rgb(col#,int(col#/1.1),int(col#/2))
endif
next y
next x
unlock pixels
get image 1000,0,0,is,is
cls 0
`Makes a random detail map
lock pixels
for x=0 to 200
for y=0 to 200
col#=rnd(40)+100+map*30
dot x,y,rgb(col#,col#,col#)
next y
next x
unlock pixels
get image 2000,0,0,200,200,1
cls 0
endfunction
The function above comes with a quick demo. The textures in the code above are just quickly generated for the demo and are not necessarily part of the random terrain generator.
