Sorry your browser is not supported!

Rem Project: construct
Rem Created: Monday, June 20, 2011

Rem ***** Main Source File *****

rem Standard Setup Code for all examples
sync on : sync rate 30 : color backdrop 0
set text font "arial" : set text size 16
set text to bold : set text transparent
SET DISPLAY MODE 1024, 768, 32
SET WINDOW ON
MAXIMIZE WINDOW
phy start
autocam off

TERRAINBUILT=0
do
_start:
rem new
butbox=1
lenbitton=100
butx=100
buty=20
but$="new"
gosub _connection_button
if mouseclick1=1
    SET CURSOR 300,300
    input "enter size X*X[(64---512)])=",x
    if x>=64 and x<=512
        
        CREATE BITMAP 1,x,x rem height
        get image 1,0,0,x,x
        save image "map.bmp",1
        
        create bitmap 2,x,x rem texture
        get image 2,0,0,x,x
        save image "textured.bmp" ,2
        
        set current bitmap 0
        load image "textured.bmp", 1
        load image "detail.tga", 2
      
   make object terrain 1
   set terrain heightmap 1, "map.bmp"
   set terrain scale 1, 10, 10,10
   set terrain split 1, 16
   set terrain tiling 1, 4
   set terrain light 1, 1, -0.25, 0, 1, 1, 0.78, 0.5
   set terrain texture 1, 1, 2
   build terrain 1 
   phy make rigid body static terrain 1
   else 
        cls
        mouseclick1=0
        goto _start
    ENDIF
    cls
    mouseclick1=0
    TERRAINBUILT=1
   
endif

rem load
butbox=1
lenbitton=100
butx=100
buty=50
but$="load"
gosub _connection_button

rem save height map
butbox=1
lenbitton=100
butx=100
buty=80
but$="save height map"
gosub _connection_button

rem save texturemap
butbox=1
lenbitton=100
butx=100
buty=110
but$="save texturemap"
gosub _connection_button

rem save map
butbox=1
lenbitton=100
butx=100
buty=140
but$="save map"
gosub _connection_button

rem PLATE
butbox=1
lenbitton=100
butx=100
buty=170
but$="PLATE"
gosub _connection_button
if mouseclick1=1
    _latre1:
    set cursor 300,0
    sync
    input "radius = 1-20",radius1
    if radius1<=1 or radius1>=20
    cls
    goto _latre1 
    endif
    _latre2:
    sync
    set cursor 300,30
    input "height main = 0-255",heightmain
    if heightmain<0 or heightmain>255
    cls
    goto _latre2
    endif
ENDIF


rem HILL
butbox=1
lenbitton=100
butx=100
buty=200
but$="HILL"
gosub _connection_button
if mouseclick1=1
    _latre1:
    set cursor 300,0
    sync
    input "radius = 1-20",radius1
    if radius1<=1 or radius1>=20
    cls
    goto _latre1 
    endif
    _latre2:
    sync
    set cursor 300,30
    input "height main = 0-255",heightmain
    if heightmain<0 or heightmain>255
    cls
    goto _latre2
    endif
ENDIF


rem ERASEE
butbox=1
lenbitton=100
butx=100
buty=230
but$="ERASE"
gosub _connection_button
if mouseclick1=1
    _latre1:
    set cursor 300,0
    sync
    input "radius = 1-20",radius1
    if radius1<=1 or radius1>=20
    cls
    goto _latre1 
    endif
    _latre2:
    sync
    set cursor 300,30
    input "height main = 0-255",heightmain
    if heightmain<0 or heightmain>255
    cls
    goto _latre2
    endif
ENDIF


ter=1
   UPDATE TERRAIN 1
   XAngle = WrapValue( Xangle + MouseMoveY() )
   YAngle = WrapValue( YAngle + MouseMoveX() )
   Rotate Camera XAngle,YAngle,0
   xxx=CAMERA POSITION X()
   zzz=CAMERA POSITION Z()
   IF Camera position x()<0 
   xxx=0
   endif
   IF Camera position x()>x*12.2 
   xxx=x*12.2
   endif
   IF Camera position z()<0 
   zzz=0
   endif
   IF Camera position z()>x*12.2
   zzz=x*12.2
   endif
   
   IF TERRAINBUILT=1
   QWE=GET TERRAIN ground HEIGHT(1,xxx,zzz)
   ENDIF
   position caMERA xxx,QWE+100,zzz
   IF UPKEY()=1 THEN MOVE CAMERA 10
   IF DOWNKEY()=1 THEN MOVE CAMERA -10
     text 500,500,str$(CAMERA POSITION X())
     sync
     phy update
loop

rem кнопка
_connection_button:
    w=lenbitton : h=(text height(but$))
    if butbox=1
        ink rgb(200,200,220),0 : box butx-w,buty-h,butx+w,buty+h/2
        ink rgb(20,20,30),0 : box (butx-w)+1,(buty-h)+1,butx+w,buty+h/2
        ink rgb(100,100,120),0 : box (butx-w)+1,(buty-h)+1,(butx+w)-1,(buty+h/2)-1
    endif
    buton=0
    if mousex()>butx-w and mousex()<butx+w
        if mousey()>buty-h and mousey()<buty+h
            buton=1
        endif
    endif
    if buton=1 then ink rgb(255,255,255),0 else ink rgb(50,50,50),0
    center text butx,buty-12,but$
    IF MOUSEclick()=1 and buton=1 then mouseclick1=1 else mouseclick1=0
return

QWE=GET TERRAIN ground HEIGHT(1,xxx,zzz)

IF UPKEY()=1  
   MOVE CAMERA 1
   if GET TERRAIN ground HEIGHT(1,CAMERA POSITION X(),CAMERA POSITION Z())=0
   move camera -1
   endif
   endif
   IF DOWNKEY()=1 
   MOVE CAMERA -1
   if GET TERRAIN ground HEIGHT(1,CAMERA POSITION X(),CAMERA POSITION Z())=0
   move camera 1
   endif
   endif

update terrain IDTerrain

rem camera limits
if camera position x()<0 then position camera 0,camera position y(),camera position z()
if camera position z()<0 then position camera camera position x(),camera position y(),0
if camera position x()> object size x(1) then position camera object size x(1),camera position y(),camera position z()
if camera position z()> object size z(1) then position camera camera position x(),camera position y(),object size z(1)

object size x(id)