Sorry your browser is not supported!

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)



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

rem textures



`gives final random wash
for x=0 to is
for y=0 to is
col(x,y)=col(x,y)+rnd(40)
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

if col#>200 then col#=150
inc col#,rnd(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

rem indian
load object "C:\Program Files\The Game Creators\Dark Basic Professional Online\Projects\MyProj\ISL\ISL_Certification_I-IV\models/MAN2.X",13
position object 13, 200,150,200
scale object 13,500,500,500
color object 13,80


load object "C:\Program Files\The Game Creators\Dark Basic Professional Online\Projects\MyProj\ISL\ISL_Certification_I-IV\models/MAN2.X",14
position object 14, 300,150,200
scale object 14,500,500,500
color object 14,80

load object "C:\Program Files\The Game Creators\Dark Basic Professional Online\Projects\MyProj\ISL\ISL_Certification_I-IV\models/MAN2.X",15
position object 15, 400,150,200
scale object 15,500,500,500
color object 15,80

load object "C:\Program Files\The Game Creators\Dark Basic Professional Online\Projects\MyProj\ISL\ISL_Certification_I-IV\models/MAN2.X",16
position object 16, 500,150,200
scale object 16,500,500,500
color object 16,80

rem make object character
make object box 17,50,50,50
position object 17, 600,150,200

get image 2000,0,0,200,200,1
cls 0
endfunction

`Declarations
#CONSTANT mycube     1

GLOBAL speed# = 0.05

`Setup display and camera
SET DISPLAY MODE DESKTOP WIDTH(), DESKTOP HEIGHT(), 32
AUTOCAM OFF
POSITION CAMERA 0, 0,0,0
COLOR BACKDROP RGB(0,0,0)

`Create the object
MAKE OBJECT CUBE mycube, 0.5
POSITION OBJECT mycube, 0,0,5

`Mainloop:
WHILE SCANCODE() <> 16
      `Call dbpro's control camera with arrows function
      CONTROL CAMERA USING ARROWKEYS 0, speed# / 5, speed# / 2
      `Cull our cube control function
      ControlCube()
      `Print instructions to screen
      TEXT 1, 50, "Press arrow keys to move camera, press wasd to move cube, press q or Esc to exit"
ENDWHILE
END



Function ControlCube()
`The following is a set of WASD controls

      `If W pressed
      IF KEYSTATE(17) = 1
            `Move object forward in it's facing direction using our predefined speed. I slowed it dow for smoother play
            MOVE OBJECT mycube, speed# / 5
      ENDIF
      `If S pressed
      IF KEYSTATE(31) = 1
            `Move object backwards from its facing direction using a negative number for velocity
            MOVE OBJECT mycube, speed# / -5
      ENDIF
      `If A pressed, rotate object on it's Y-axis, ie left/right
      IF KEYSTATE(30) = 1
            `Negative speed used for left turn
            YROTATE OBJECT mycube, OBJECT ANGLE Y(mycube) - speed#
      ENDIF
      `If D pressed, rotate right
      IF KEYSTATE(32) = 1
            `Positive rotation value used for right turn
            YROTATE OBJECT mycube, OBJECT ANGLE Y(mycube) + speed#
      ENDIF
EndFunction