Sorry your browser is not supported!

set window on
set display mode 800, 600, 0, 1
set window title "BLAH!"
set window position desktop width()/4, desktop height()/8

sync on : sync rate 60
autocam off
set camera range 0, 1, 50000

global factor# as float
global flast# as float
global dim factors(30) as float

type player_data
    map as dword
    x as float
    z as float
endtype
global dim Players(0) as player_data

type terrain_data
    id as dword
    objid as dword
    img_h as dword
    img_t as dword
endtype
global dim Terr(256) as terrain_data

global dim Map(18,18) as dword
z = 0
for y = 2 to 17
    for x = 2 to 17
        inc z
        Map(x,y) = z
    next x
next y
for x = 2 to 17
    Map(x,1) = Map(x,17)
    Map(x,18) = Map(x,2)
next x
for y = 1 to 18
    Map(1,y) = Map(17,y)
    Map(18,y) = Map(2,y)
next y
global dim myMap(9) as dword

TerrHM = find free image()
load image "Terrain\Terrain1_HM.bmp", TerrHM, 1
TerrTX = find free image()
load image "Terrain\Terrain1_TX.png", TerrTX, 1

cls
center text screen width()/2, screen height()/2, "Separating Maps.."
sync

set bitmap format 22
create bitmap 1, 256, 256
i = 0
for y = 15 to 0 step -1
    for x = 0 to 15
        cls 0
        i = i + 1
        Terr(i).img_h = find free image()
        paste image TerrHM, -(256 * x), -(256 * y)
        get image Terr(i).img_h, 0, 0, 256, 256
    next x
next y
delete bitmap 1
delete image TerrHM : TerrHM = 0
set bitmap format 21
create bitmap 1, 256, 256
i = 0
set text size 68
for y = 15 to 0 step -1
    for x = 0 to 15
        cls 0
        i = i + 1
        Terr(i).img_t = find free image()
        paste image TerrTX, -(256 * x), -(256 * y)
        line 0, 0, 256, 0, rgb(255,64,64)
        line 0, 0, 0, 256, rgb(255,64,64)
        line 256, 0, 256, 256, rgb(255,64,64)
        line 0, 256, 256, 256, rgb(255,64,64)
        line 0, 128, 256, 128, rgb(255,255,64)
        line 128, 0, 128, 256, rgb(255,255,64)
        center text 128, 128, str$(i)
        get image Terr(i).img_t, 0, 0, 256, 256
    next x
next y
delete image TerrTX : TerrTX = 0
set text size 14
set current bitmap 0
delete bitmap 1

BT SetATMode 1
global TerrScale as integer = 16
global TerrWidth as integer
TerrWidth = (image width(Terr(1).img_h) * TerrScale) - TerrScale

` Player object
global pObj as dword
pObj = find free object()
make object cube pObj, 1
hide object pObj
position object pObj, 100.0, 0.0, 100.0

Players(0).map = 1
Players(0).x = 100.0
Players(0).z = 100.0

` Set the map matrix around the player
SetMyMap()
` Load the appropriate terrains based on the map matrix
MapCheck()

while not escapekey()
    
    tbm1_Update()
    
    text 10, 10, "FPS : "+str$(screen fps())
    text 10, 30, "W,A,S,D - Move around - Hold Shift to move faster"
    text 10, 50, "X : "+str$(Object position x(pObj),2)+"  Z : "+str$(object position z(pObj),2)
    
    ` Movement
    speed# = 100.0
    if keystate(42) then speed# = 300.0
    if keystate(17) and intime = 0 then    move object pObj, speed# * factor#
    if keystate(30) and intime = 0 then move object left pObj, speed# * factor#
    if keystate(31) and intime = 0 then move object pObj, -speed# * factor#
    if keystate(32) and intime = 0 then move object right pObj, speed# * factor#
    cx# = BT GetGroundHeight(Terr(Players(0).map).id, object position x(pObj), object position z(pObj))
    position object pObj, object position x(pObj), cx#+35, object position z(pObj)
    if has focus()
        hide mouse
        position mouse screen width()/2, screen height()/2
    else
        show mouse
    endif
    cx#=object angle x(pObj) + mousemovey() / 4.0
    if cx#>90.0 then cx#=90.0
    if cx#<-90.0 then cx#=-90.0
    rotate object pObj, cx#, camera angle y(0) + mousemovex() / 4.0, 0.0
    set camera to object orientation 0, pObj
    position camera 0, object position x(pObj), object position y(pObj), object position z(pObj)
    move camera 0, -3
    Players(0).x = object position x(pObj)
    Players(0).z = object position z(pObj)
    
    ` If the player moves to another map, reset their map matrix
    if Players(0).map <> MyMap(5) then SetMyMap()
    ` Load / Unload the appropriate maps surrounding the player
    MapCheck()
    
    BT SetCurrentCamera 0
    for t = 1 to 256
        if Terr(t).id > 0
            if BT TerrainExist(Terr(t).id)
                BT UpdateTerrainCull Terr(t).id
                BT UpdateTerrainLOD Terr(t).id
                BT RenderTerrain Terr(t).id
            endif
        endif
    next t
    
    sync
    
endwhile

for t = 1 to 256
    if Terr(t).id > 0
        if BT TerrainExist(Terr(t).id)
            BT DeleteTerrain Terr(t).id
        endif
    endif
next t

end



function LoadTerrain(tt as dword, tx as integer, tz as integer)
    Terr(tt).id = BT MakeTerrain()
    BT SetTerrainHeightMap Terr(tt).id, Terr(tt).img_h
    BT SetTerrainScale Terr(tt).id, TerrScale
    BT SetTerrainYScale Terr(tt).id, 4.0
    BT SetTerrainSplit Terr(tt).id, 8
    BT SetTerrainLOD Terr(tt).id, 3
    BT SetTerrainLODDistance Terr(tt).id, 1, 1500.0
    BT SetTerrainLODDistance Terr(tt).id, 2, 2000.0
    BT SetTerrainSmoothing Terr(tt).id, 1
    BT SetTerrainQuadRotation Terr(tt).id, 1
    Terr(tt).objid = find free object()
    BT BuildTerrain Terr(tt).id, Terr(tt).objid, 1
    texture object Terr(tt).objid, 0, Terr(tt).img_t
    position object Terr(tt).objid, TerrWidth * tx, 0.0, TerrWidth * tz
endfunction


function RemoveTerrain(tt as dword)
    if Terr(tt).id > 0
        if BT TerrainExist(Terr(tt).id)
            BT DeleteTerrain Terr(tt).id
        endif
    endif
    if Terr(tt).objid > 0
        if object exist(Terr(tt).objid)
            delete object Terr(tt).objid
        endif
    endif
    Terr(tt).id = 0
    Terr(tt).objid = 0
endfunction


function SetMyMap()
    z = 0
    MyMap(5) = Players(0).map
    for x = 2 to 17
        for y = 2 to 17
            if Map(x,y) = MyMap(5) and z = 0
                a = x : b = y : z = 1
            endif
        next y
    next x
    MyMap(7) = Map(a-1,b+1) : MyMap(8) = Map(a,b+1) : MyMap(9) = Map(a+1,b+1)
    MyMap(4) = Map(a-1,b)   :                         MyMap(6) = Map(a+1,b)
    MyMap(1) = Map(a-1,b-1) : MyMap(2) = Map(a,b-1) : MyMap(3) = Map(a+1,b-1)
    z = 0
    for y = -1 to 1
        for x = -1 to 1
            inc z
            if Terr(MyMap(z)).id > 0 then position object Terr(MyMap(z)).objid, TerrWidth * x, 0.0, TerrWidth * y
        next x
    next y
endfunction


function MapCheck()
    if Players(0).x < TerrWidth/2 and Players(0).x > 0
        if Terr(MyMap(3)).id > 0 then RemoveTerrain(MyMap(3))
        if Terr(MyMap(6)).id > 0 then RemoveTerrain(MyMap(6))
        if Terr(MyMap(9)).id > 0 then RemoveTerrain(MyMap(9))
        if Terr(MyMap(5)).id = 0 then LoadTerrain(MyMap(5), 0, 0)
        if Players(0).z < TerrWidth/2 and Players(0).z > 0 ` Lower Left Corner
            if Terr(MyMap(7)).id > 0 then RemoveTerrain(MyMap(7))
            if Terr(MyMap(8)).id > 0 then RemoveTerrain(MyMap(8))
            if Terr(MyMap(1)).id = 0 then LoadTerrain(MyMap(1), -1, -1)
            if Terr(MyMap(2)).id = 0 then LoadTerrain(MyMap(2), 0, -1)
            if Terr(MyMap(4)).id = 0 then LoadTerrain(MyMap(4), -1, 0)
        endif
        if Players(0).z > TerrWidth/2 and Players(0).z < TerrWidth ` Upper Left Corner
            if Terr(MyMap(1)).id > 0 then RemoveTerrain(MyMap(1))
            if Terr(MyMap(2)).id > 0 then RemoveTerrain(MyMap(2))
            if Terr(MyMap(4)).id = 0 then LoadTerrain(MyMap(4), -1, 0)
            if Terr(MyMap(7)).id = 0 then LoadTerrain(MyMap(7), -1, 1)
            if Terr(MyMap(8)).id = 0 then LoadTerrain(MyMap(8), 0, 1)
        endif
    endif
    if Players(0).x > TerrWidth/2 and Players(0).x < TerrWidth
        if Terr(MyMap(1)).id > 0 then RemoveTerrain(MyMap(1))
        if Terr(MyMap(4)).id > 0 then RemoveTerrain(MyMap(4))
        if Terr(MyMap(7)).id > 0 then RemoveTerrain(MyMap(7))
        if Terr(MyMap(5)).id = 0 then LoadTerrain(MyMap(5), 0, 0)
        if Players(0).z < TerrWidth/2 and Players(0).z > 0 ` Lower Right Corner
            if Terr(MyMap(8)).id > 0 then RemoveTerrain(MyMap(8))
            if Terr(MyMap(9)).id > 0 then RemoveTerrain(MyMap(9))
            if Terr(MyMap(2)).id = 0 then LoadTerrain(MyMap(2), 0, -1)
            if Terr(MyMap(3)).id = 0 then LoadTerrain(MyMap(3), 1, -1)
            if Terr(MyMap(6)).id = 0 then LoadTerrain(MyMap(6), 1, 0)
        endif
        if Players(0).z > TerrWidth/2 and Players(0).z < TerrWidth ` Upper Right Corner
            if Terr(MyMap(2)).id > 0 then RemoveTerrain(MyMap(2))
            if Terr(MyMap(3)).id > 0 then RemoveTerrain(MyMap(3))
            if Terr(MyMap(6)).id = 0 then LoadTerrain(MyMap(6), 1, 0)
            if Terr(MyMap(8)).id = 0 then LoadTerrain(MyMap(8), 0, 1)
            if Terr(MyMap(9)).id = 0 then LoadTerrain(MyMap(9), 1, 1)
        endif
    endif    
    if Players(0).x < 1
        Players(0).map = MyMap(4)
        Players(0).x = Players(0).x + (TerrWidth - 2)
    endif
    if Players(0).x > TerrWidth-1
        Players(0).map = MyMap(6)
        Players(0).x = Players(0).x - (TerrWidth - 2)
    endif
    if Players(0).z < 1
        Players(0).map = MyMap(2)
        Players(0).z = Players(0).z + (TerrWidth - 2)
    endif
    if Players(0).z > TerrWidth-1
        Players(0).map = MyMap(8)
        Players(0).z = Players(0).z - (TerrWidth - 2)
    endif
    position object pObj, Players(0).x, object position y(pObj), Players(0).z
endfunction


function tbm1_update()
    Diff# = hitimer() - flast#
    flast# = hitimer()
    factor# = 0.0
    for tx = 1 to 29
        factors(tx) = factors(tx+1)
        factor# = factor# + factors(tx)
    next tx
    factors(30) = Diff# / 1000.0
    factor# = (factor# + factors(30)) / 30.0
endfunction

Load Image "Image_Texture.png", imgTex
Load Image "Image_Normals.png", imgNorm
Load Object "Terrain.x", ObjID

Set Blend Mapping on ObjID, 0, imgNorm, 0, 24
Set Blend Mapping on ObjID, 1, imgTex, 3, 7

//Load media
    global g_HeightmapImgID : global g_TextureImgID : global g_DetailmapImgID
    g_HeightmapImgID=1 : g_TextureImgID=2 : g_DetailmapImgID=3
    load image "..\Media\heightmap.bmp",g_HeightmapImgID, 1
    load image "..\Media\texture.jpg",g_TextureImgID, 1
    load image "..\Media\detail.tga",g_DetailmapImgID, 0
    
    global terrainbuild = 0
    
    if terrainbuild = 1
    
//Create terrain
    //Make the terrain
    global g_TerrainID
    g_TerrainID=BT MakeTerrain()
    
    //Set images
    BT SetTerrainHeightmap g_TerrainID,g_HeightmapImgID
    BT SetTerrainTexture g_TerrainID,g_TextureImgID
    BT SetTerrainDetail g_TerrainID,g_DetailmapImgID
    
    //Set some other values
    BT SetTerrainScale g_TerrainID,12.0
    BT SetTerrainYScale g_TerrainID,2.0
    BT SetTerrainSplit g_TerrainID,16
    BT SetTerrainDetailTile g_TerrainID,4.0
    
    //LOD
    BT SetTerrainLOD g_TerrainID,4 //3 LOD levels
    BT SetTerrainLODDistance g_TerrainID,1,1000.0 //LOD Distances start at one and go up to 1 less the LOD level count
    BT SetTerrainLODDistance g_TerrainID,2,2000.0
    
    //Smoothing (you can set the smoothing factor from 0 - 100)
    BT SetTerrainSmoothing g_TerrainID,1
    
    //Build
    global g_TerrainObjectID
    g_TerrainObjectID=1
    
    //This command processes the heightmap and creates all the internal structures for the terrain
    BT BuildTerrain g_TerrainID,g_TerrainObjectID,1
    
    bt maketerrainobject g_TerrainID, 2, 10001
    
    set object smoothing 10001, 100
    
    `make mesh from object 10002, 10001, 0
    
    `save mesh "Terrain.X", 10002
    
    if file exist("Terrain.DBO") = 1 then delete file "Terrain.DBO"
    
    save object "Terrain.DBO", 10001
    
    else
    
    load object "Terrain.DBO", 1
    
    set object smoothing 1, 100
        
    `texture object 1, 1, g_DetailMapImgID, 1
    texture object 1, 1, g_TextureImgID

    endif

// terrain
BT_Init();
TerrainID = BT_MakeTerrain();
BT_SetTerrainHeightmap( TerrainID, HeightMap );
BT_SetTerrainTexture( TerrainID, TerrainTexture );
BT_SetTerrainDetail( TerrainID, DetailTexture );
BT_SetTerrainDetailTile( TerrainID, 3.0f );
BT_SetTerrainSplit( TerrainID, 16 );
BT_SetTerrainScale( TerrainID, 12.0f );
BT_SetTerrainYScale( TerrainID, 2.0f );
TerrainObjectID = GetFreeObjectID();
BT_BuildTerrain( TerrainID, TerrainObjectID, true );
BT_EnableAutoRender( true );

// #pragma comment(lib,"BlitzTerrainRTTMS.lib")

BlitzTerrain.lib(main.obj) : warning LNK4229: invalid directive '/FAILIFMISMATCH:_MSC_VER=1600' encountered; ignored
BlitzTerrain.lib(main.obj) : warning LNK4229: invalid directive '/FAILIFMISMATCH:_ITERATOR_DEBUG_LEVEL=0' encountered; ignored
BlitzTerrain.lib(quadmapping.obj) : warning LNK4229: invalid directive '/FAILIFMISMATCH:_MSC_VER=1600' encountered; ignored
BlitzTerrain.lib(quadmapping.obj) : warning LNK4229: invalid directive '/FAILIFMISMATCH:_ITERATOR_DEBUG_LEVEL=0' encountered; ignored
BlitzTerrain.lib(rttms.obj) : warning LNK4229: invalid directive '/FAILIFMISMATCH:_MSC_VER=1600' encountered; ignored
BlitzTerrain.lib(rttms.obj) : warning LNK4229: invalid directive '/FAILIFMISMATCH:_ITERATOR_DEBUG_LEVEL=0' encountered; ignored
BlitzTerrain.lib(code-from-dbp.obj) : warning LNK4229: invalid directive '/FAILIFMISMATCH:_MSC_VER=1600' encountered; ignored
BlitzTerrain.lib(code-from-dbp.obj) : warning LNK4229: invalid directive '/FAILIFMISMATCH:_ITERATOR_DEBUG_LEVEL=0' encountered; ignored
BlitzTerrain.lib(CreateObject.obj) : warning LNK4229: invalid directive '/FAILIFMISMATCH:_MSC_VER=1600' encountered; ignored
BlitzTerrain.lib(CreateObject.obj) : warning LNK4229: invalid directive '/FAILIFMISMATCH:_ITERATOR_DEBUG_LEVEL=0' encountered; ignored