Sorry your browser is not supported!

land_w = 1000
land_d = 1000
make matrix 1,land_w,land_d
dim height_map(land_w,land_d)

for y = 0 to land_d
  for x = 0 to land_w
    set matrix height x,y,height_map(x,y)
  next x
next y

rem ********************************
rem ** Bump and Color Map Project **
rem *** GrimVis ********************
rem ********************4-11-06*****

remstart
**VERY IMPORTANT!!!!!!!!!!!!!!**
   Bump Map images should be equevalent to the size value stated below in pixles
   and in greyscale--(black= sea level | white= very tall mountain).
   texture maps should be no more than 256x256 pxls.

   Note: For better results use Lee Bamber's Normalize routine and lighting.
remend

rem turn manual sync on and autocam off
sync on
autocam off

rem make matrix for bump mapping
Size=25
make matrix 1,1000,1000,size,size

rem set a nuetral camera position
position camera 500,900,-300
point camera 500,0,200

rem load the bump and texture map images
load image "grass2.bmp",1
load image "coast2.bmp",2
prepare matrix texture 1,2,size+1,size+1
paste image 1,0,0

rem preset variables and arrays(bump array stores the height for each point on the matrix)
dim bump(size,size)
x=0
y=0

rem get data from bump image
for y=0 to size
for x=0 to size
paste image 1,0,0
bump(x,y)=point(x,y)
next x
next y
sync

rem texture matrix from texture map
x=0
y=0
b=0
l=0
for y=0 to size-1
if l>0 then b=b+1
for x=0 to size-1
 b=b+1:l=1
if x=5 then l=0
paste image 2,0,0
set matrix tile 1,x,y,b
next x
next y
sync

rem Build matrix from bump map
x=0
y=0
b=0
for y=0 to size
for x=0 to size
f=bump(x,y)/70000
set matrix height 1,x,y,f
update matrix 1
next x
next y
sync

rem update matrix
update matrix 1
sync

rem reposition camera
position camera 500,900,-300
point camera 500,0,200


do

elapsedtime#=(timer()-start)/1000.0
start=timer()

xrot#=camera angle x(0)
if mouseclick() = 1
    inc speed#,100*elapsedtime#
    if speed#>500.0 then speed#=500.0
endif
if mouseclick() = 2
    inc speed#,-100*elapsedtime#
    if speed#<-500.0 then speed#=-500.0
endif

if mouseclick()=0
    if speed#>0
        inc speed#,-500*elapsedtime#
        if speed#<0.0 then speed#=0.0
    else
        inc speed#,500*elapsedtime#
        if speed#>0.0 then speed#=0.0
    endif
endif

rotate camera maincam,xrot#+mousemovey()/6.0,camera angle y()+mousemovex()/6.0,0

move camera 0,speed#*elapsedtime#

sync
loop


end

sync on
sync rate 30

land_w = 9
land_d = 9

dim height_map(land_w,land_d)
make matrix 1,10,10,land_w,land_d

rem height map data
data 4,4,4,4,4,4,5,6,7,7
data 4,4,4,4,4,4,5,6,7,7
data 6,4,4,5,4,4,5,6,7,7
data 6,4,4,4,4,4,4,4,7,7
data 5,4,4,4,4,4,4,4,7,7
data 5,5,5,5,5,5,4,4,6,7
data 6,7,7,7,7,5,4,4,6,7
data 6,7,7,7,7,5,4,4,6,6
data 6,7,7,7,7,5,4,4,6,6
data 6,6,6,6,6,5,4,4,6,6

for z = 0 to land_w
  for x = 0 to land_d
    read height_map(x,z)
    set matrix height 1,x,z,height_map(x,z)
  next x
next z

update matrix 1

Do
  n = wrapvalue(n+1)
  position camera sin(n)*20,20,cos(n)*20
  point camera 5,0,5
  sync
Loop

`-------------------------------------
`Heightmap Function
`-------------------------------------
Function Heightmap_Function(Mt,Mx,My,Tx,Ty,Heightmap$)
Total=(Tx*Ty)+(Tx+Ty)+1 : Amount=0
If Image Exist(1)=1
	Save Image "Temp.BMP",1
	Delete Image 1
	Saved=1
Endif
Load Image Heightmap$,1
Dim Heightmap(Total)
For X=0 to Tx
	For Y=0 to Ty
		Cls
		Paste Image 1,0,0
		Heightmap(Amount)=Point(X,Y)/100000
		Amount=Amount+1
		Center Text 320,240,Str$(Amount)+" out of "+Str$(Total)
		Sync
	Next Y
Next X
Amount=0
Make Matrix Mt,Mx,My,Tx,Ty
For X=0 to Tx
	For Y=0 to Ty
		Set Matrix Height Mt,X,Y,Heightmap(Amount)
		Amount=Amount+1
	Next Y
Next X
Update Matrix Mt
Delete Image 1
If Saved=1
	Load Image "Temp.BMP",1
	Saved=0
Endif
Endfunction

sync on:sync rate 1000:hide mouse

Heightmap_Function(Mt,Mx,My,Tx,Ty,"Image Name")

position camera 350,200,350
point camera 350,0,350
do
if upkey()=1 then move camera 10
if downkey()=1 then move camera -10
mmy=mousemovey()
mmx=mousemovex()
mmy#=wrapvalue(mmy#+mmy)
mmx#=wrapvalue(mmx#+mmx)
rotate camera mmy#,mmx#,0
sync
loop

`-------------------------------------
`Heightmap Function
`-------------------------------------
Function Heightmap_Function(Mt,Mx,My,Tx,Ty,Heightmap$)
Total=(Tx*Ty)+(Tx+Ty)+1 : Amount=0
If Image Exist(1)=1
	Save Image "Temp.BMP",1
	Delete Image 1
	Saved=1
Endif
Load Image Heightmap$,1
Dim Heightmap(Total)
For X=0 to Tx
	For Y=0 to Ty
		Cls
		Paste Image 1,0,0
		Heightmap(Amount)=Point(X,Y)/100000
		Amount=Amount+1
		Center Text 320,240,Str$(Amount)+" out of "+Str$(Total)
		Sync
	Next Y
Next X
Amount=0
Make Matrix Mt,Mx,My,Tx,Ty
For X=0 to Tx
	For Y=0 to Ty
		Set Matrix Height Mt,X,Y,Heightmap(Amount)
		Amount=Amount+1
	Next Y
Next X
Update Matrix Mt
Delete Image 1
If Saved=1
	Load Image "Temp.BMP",1
	Saved=0
Endif
Endfunction