ANYway. Now with my rage gone, I have redone your ENTIRE code to be more easy to handle for people.
I need you to help me fix ONE thing.
WHY is the bloody camera moving by itself? ><
set display mode 800, 600, 0, 1
set window on
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 ENTIRE_SIZE = 256
global dim Terr(ENTIRE_SIZE) 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
Global TerrHM
Global TerrTX
Global TerrDet
`load the heightmap
TerrHM = FreeImage()
load image "Terrain\Terrain1_HM.bmp", TerrHM, 1
`load the texturemap
TerrTX = FreeImage()
load image "Terrain\Terrain1_TX.png", TerrTX, 1
TerrDet = FreeImage()
load image "Terrain\detail.tga", TerrDet, 1
`clear the screen and flip the text into view
cls
center text screen width()/2, screen height()/2, "Separating Maps.."
sync
`RGB pixel format, where 8 bits are reserved for each color.
set bitmap format 22
`create a blank ENTIRE_SIZExENTIRE_SIZE bitmap
create bitmap 1, ENTIRE_SIZE, ENTIRE_SIZE
`set i to 0
i = 0
rem set the bitmap format
set bitmap format 22
rem create the bitmap
create bitmap 1, ENTIRE_SIZE, ENTIRE_SIZE
i = 0
rem loop through x and y
global ENTIRESECTORS_WIDTH
ENTIRESECTORS_WIDTH = image width(TerrTX)/ENTIRE_SIZE-1
global ENTIRESECTORS_HEIGHT
ENTIRESECTORS_HEIGHT = image height(TerrTX)/ENTIRE_SIZE-1
for y = ENTIRESECTORS_HEIGHT to 0 step -1
for x = 0 to ENTIRESECTORS_WIDTH
cls 0
i = i + 1
Terr(i).img_h = FreeImage()
rem paste terrain image
paste image TerrHM, -(ENTIRE_SIZE * x), -(ENTIRE_SIZE * y), 1
rem get image portion - bottom right portion of image
get image Terr(i).img_h, 0, 0, ENTIRE_SIZE, ENTIRE_SIZE
next x
next y
rem delete bitmap
delete bitmap 1
rem delete image
delete image TerrHM : TerrHM = 0
rem set the bitmap format
set bitmap format 21
rem create the bitmap
create bitmap 1, ENTIRE_SIZE, ENTIRE_SIZE
i = 0
rem set text size
set text size 68
rem loop through x and y
for y = ENTIRESECTOR_HEIGHT to 0 step -1
for x = 0 to ENTIRESECTOR_WIDTH
cls 0
i = i + 1
Terr(i).img_t = FreeImage()
rem paste terrain image
paste image TerrTX, -(ENTIRE_SIZE * x), -(ENTIRE_SIZE * y)
`draw lines at sector points of split texture
line 0, 0, ENTIRE_SIZE, 0, rgb(255,64,64)
line 0, 0, 0, ENTIRE_SIZE, rgb(255,64,64)
line ENTIRE_SIZE, 0, ENTIRE_SIZE, ENTIRE_SIZE, rgb(255,64,64)
line 0, ENTIRE_SIZE, ENTIRE_SIZE, ENTIRE_SIZE, rgb(255,64,64)
line 0, ENTIRE_SIZE/2, ENTIRE_SIZE, ENTIRE_SIZE/2, rgb(255,255,64)
line ENTIRE_SIZE/2, 0, ENTIRE_SIZE/2, ENTIRE_SIZE, rgb(255,255,64)
ink rgb(rnd(255), rnd(255), rnd(255))
`put the bitmap size of the texture on the texture
center text ENTIRE_SIZE/2, ENTIRE_SIZE/2, str$(i)
ink rgb(255, 255, 255)
rem get image portion - bottom right portion of image / the text from above
get image Terr(i).img_t, 0, 0, ENTIRE_SIZE, ENTIRE_SIZE
next x
next y
rem delete bitmap
delete image TerrTX : TerrTX = 0
rem set the text size back to 14
set text size 14
rem set the current bitmap ID in queue back to 0
set current bitmap 0
rem delete bitmap
delete bitmap 1
rem 3D Stuff
BT SetATMode 1
global TerrScale as integer = ENTIRESECTOR_WIDTH
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 ENTIRE_SIZE
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 ENTIRE_SIZE
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 = FreeObj()
BT BuildTerrain Terr(tt).id, Terr(tt).objid, 1
texture object Terr(tt).objid, 1, TerrDet
set blend mapping on Terr(tt).objid, 0, TerrDet, 0, 10 `10, 17, 24
set blend mapping on Terr(tt).objid, 1, Terr(tt).img_t, 3, 7
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()
t# = timer()
Diff# = t# - flast#
flast# = t#
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
function FreeObj()
for fx = 1 to 1000
if object exist(fx) = 0
res = fx
exit
endif
next fx
endfunction res
function FreeImage()
for fx = 1 to 1000
if image exist(fx) = 0
res = fx
exit
endif
next fx
endfunction res
Thanks!
CHECK OUT MY WEBSITE AT http://imageposeidon.com/ !
