Rem Project: Island
Rem Created: 17/05/2006 15:25:06
 
Rem ***** Main Source File *****
 
gosub INIT_VariablesAndDatastructures
 
gosub INIT_3DEnvironment
 
gosub INIT_SkyBox
 
gosub INIT_LandMatrix
 
gosub INIT_WaterMatrix
 
rem **************************************************
rem **************************************************
rem **************************************************
 
k#=0.999:invk#=1-k#
 
gosub Set_Params
 
do
 
    gosub HUD_DisplayGameStats
 
    if rnd(20)>19 or max=0 or increase#=0 then gosub Set_Params
 
    gosub RaiseLand
 
    gosub MOVE_GetPlayerInput
 
    gosub MOVE_UpdateCamera
 
    gosub MOVE_Sun
 
    sync
 
loop
 
rem **************************************************
rem **************************************************
rem **************************************************
 
Set_Params:
 
    increase# = (rnd(15)-5)
    if increase#>0 then increase#=increase#/5
 
    cx=rnd(49)+10
    cy=rnd(49)+10
 
    if cx>25
        maxx=47-cx
    else
        maxx=cx-1
    endif
 
    if cx=25 then maxx=0
 
    if cy>25
        maxy=47-cy
    else
        maxy=cy-1
    endif
 
    if cy=25 then maxy=0
 
    if maxx>maxy
        max=maxy
    else
        max=maxx
    endif
 
    max=rnd(max)
 
return
 
MOVE_Sun:
 
   angle# = wrapvalue(angle#+.1)
   lx# = sin(angle#)*3000
   ly# = cos(angle#)*1000
   set point light 1, lx#,ly#-300,0
   position object 2,lx#,ly#-300,0
 
return
 
MOVE_GetPlayerInput:
 
    PD(0).Pitch# = mousemovey()
    PD(0).Yaw# = mousemovex()
 
    PD(0).Speed# = (keystate(17) - keystate(31))*5
 
return
 
rem **************************************************
 
MOVE_UpdateCamera:
 
    inc PD(0).Xang#, PD(0).Pitch#
    inc PD(0).Yang#, PD(0).Yaw#
 
    rotate camera PD(0).Xang#, PD(0).Yang#, PD(0).Zang#
 
    move camera PD(0).Speed#
 
    if camera position x() >= -3000 and camera position x() <= 3000
        PD(0).Xpos# = camera position x()
    endif
 
    if camera position y() >= get ground height( 1, camera position x() + 3000, camera position z() + 3000 )
        PD(0).Ypos# = camera position y()
    else
        PD(0).Ypos# = get ground height( 1, camera position x() + 3000, camera position z() + 3000 )
    endif
 
    if camera position z() >= -3000 and camera position z() <= 3000
        PD(0).Zpos# = camera position z()
    endif
 
    position camera PD(0).Xpos#,PD(0).Ypos#,PD(0).Zpos#
 
return
 
rem **************************************************
 
HUD_DisplayGameStats:
 
    text 10,10, "Co-Ords :  " + str$( int(PD(0).Xpos#) ) + ", " + str$( int(PD(0).Ypos#) ) + ", " + str$( int(PD(0).Zpos#) )
 
    text 10,30, "FPS     :  " + str$( screen fps() )
 
return
 
rem **************************************************
 
INIT_VariablesAndDatastructures:
 
    ViewLimit#=1000
    DeepestDepth# = -100
 
    type Player_Data
 
        Xpos#
        Ypos#
        Zpos#
 
        XAng#
        YAng#
        ZAng#
 
        Pitch#
        Yaw#
 
        Speed#
 
    endtype
 
    dim PD(0) as Player_Data
 
    #constant N1 = 3
    #constant N2 = 4
    #constant N3 = 5
    #constant N4 = 6
 
    for t = 1 to 6
       null = make vector3(t)
    next t
 
return
 
rem **************************************************
 
INIT_3DEnvironment:
 
    hide mouse
    autocam off
 
    sync on
    sync rate 0
 
    set ambient light 5
 
    rem fog on
    fog color 100,100,200
    fog distance 1900
 
    backdrop on
    color backdrop 0
 
    set camera range 1, ViewLimit# * 10
 
    make light 1
    set light range 1, ViewLimit# * 10
 
    make object sphere 2,10
    set object fog 2,0
    set object light 2,0
 
return
 
rem **************************************************
 
INIT_SkyBox:
 
    make object cube 1, (ViewLimit# * -8)
 
        create bitmap 1, 256,256
        cls rgb(100,100,200)
 
        get image 1,0,0,255,255
        delete bitmap 1
 
    texture object 1, 1
 
    set object light 1,0
    set object fog 1,0
 
    Position object 1,0,0,0
 
return
 
rem **************************************************
 
INIT_LandMatrix:
 
    make matrix 1, 6000,6000,69,69
 
        create bitmap 1, 256,256
        cls rgb(100,200,0)
 
        for l = 1 to 5000
 
            dot rnd(255), rnd(255), 0
 
        next l
 
        blur bitmap 1,6
        blur bitmap 1,6
 
        get image 2,0,0,255,255
        delete bitmap 1
 
    prepare matrix texture 1,2,1,1
    fill matrix 1,0,1
 
    position matrix 1, -3000, DeepestDepth#, -3000
 
    LandCellSize# = 6000.0/69.0
 
return
 
rem **************************************************
 
INIT_WaterMatrix:
 
    make matrix 2, 8000,8000,40,40
 
        create bitmap 1, 256,256
        cls rgb(0,50,200)
 
        for l = 1 to 5000
 
            dot rnd(255), rnd(255), rgb(255,255,255)
 
        next l
 
        blur bitmap 1,6
        blur bitmap 1,6
 
        get image 3,0,0,255,255
        delete bitmap 1
 
    prepare matrix texture 2,3,1,1
    fill matrix 2,0,1
 
    ghost matrix on 2
    set matrix 2,0,0,0,2,1,1,1
 
    position matrix 2, -4000,0,-4000
 
return
 
rem **************************************************
 
RaiseLand:
 
    for l = cx-max to cx+max
 
        for m = cy-max to cy+max
 
            xsq#=(cx-l)*(cx-l)
            ysq#=(cy-m)*(cy-m)
            d#=sqrt(xsq#+ysq#)
 
            hi#=rnd(max-d#)
            if hi#<0 then hi#=0
 
            div#=rnd(int(d#)+5)
            div#=(div#^2)*(increase#)
 
            set matrix height 1,l,m,get matrix height(1,l,m) + (hi#/div#)
 
        next m
 
    next l
 
    update matrix 1
 
    for x = cx-max-1 to cx+max+1
        for z = cy-max-1 to cy+max+1
 
            nh#=(get matrix height(1,x,z) * k#) + (get matrix height(1,x+1,z) * invk#)
            set matrix height 1,x,z,nh#
 
        next z
    next x
 
    for x = cx+max+1 to cx-max-1 step -1
        for z = cy-max-1 to cy+max+1
 
            nh#=(get matrix height(1,x,z) * k#) + (get matrix height(1,x+1,z) * invk#)
            set matrix height 1,x,z,nh#
 
        next z
    next x
 
    for x = cx-max-1 to cx+max+1
        for z = cy-max-1 to cy+max+1
 
            nh#=(get matrix height(1,x,z) * k#) + (get matrix height(1,x,z+1) * invk#)
            set matrix height 1,x,z,nh#
 
        next z
    next x
 
    for x = cx-max-1 to cx+max+1
        for z = cy+max+1 to cy-max-1 step -1
 
            nh#=(get matrix height(1,x,z) * k#) + (get matrix height(1,x,z+1) * invk#)
            set matrix height 1,x,z,nh#
 
        next z
    next x
 
    update matrix 1
 
    CheapNormals( 1, cx, cy, max, (6000.0/69.0) )
 
return
 
function createNormal(v, SIZE#, hUp#, hRight#, hDown#, hLeft#)
   set vector3 v, hLeft#-hRight#, SIZE#, hUp#-hDown#
   normalize vector3 v, v
endfunction
 
function CheapNormals( Matrix, cx, cy, max, CellSize# )
 
    null = make vector3(1)
    for x = cx-max to cx+max
      for z = cy-max to cy+max
         createNormal(1, 40, get matrix height(Matrix,x,z-1), get matrix height(Matrix,x+1,z), get matrix height(Matrix,x,z+1), get matrix height(Matrix,x-1,z))
         set matrix normal 1, x, z, x vector3(1), y vector3(1), z vector3(1)
      next z
    next x
    null = delete vector3(1)
 
    update matrix 1
 
endfunction
 
function Set_Normals( Matrix, Lx, Tz, Range, CellSize# )
 
   for z = Tz-Range to Tz+Range
 
      for x = Lx-Range to Lx+Range
 
         rem upper right
         set vector3 1,x*CellSize#,get matrix height(Matrix,x,z+1),(z+1)*CellSize#
 
         set vector3 2,(x+1)*CellSize#,get matrix height(Matrix,x+1,z),z*CellSize#
 
         cross product vector3 N1,2,1
         normalize vector3 N1, 1
 
         rem upper left
         set vector3 1,x*CellSize#,get matrix height(Matrix,x,z+1),(z+1)*CellSize#
 
         set vector3 2,(x-1)*CellSize#,get matrix height(Matrix,x-1,z),z*CellSize#
 
         cross product vector3 N2,2,1
         normalize vector3 N2, 1
 
         rem lower left
         set vector3 1,x*CellSize#,get matrix height(Matrix,x,z-1),(z-1)*CellSize#
 
         set vector3 2,(x-1)*CellSize#,get matrix height(Matrix,x-1,z),z*CellSize#
 
         cross product vector3 N3,2,1
         normalize vector3 N3, 1
 
         rem lower right
         set vector3 1,x*CellSize#,get matrix height(Matrix,x,z-1),(z-1)*CellSize#
 
         set vector3 2,(x+1)*CellSize#,get matrix height(Matrix,x+1,z),z*CellSize#
 
         cross product vector3 N4,2,1
         normalize vector3 N4, 1
 
         rem average 4 normals
         add vector3 N1,N1,N2
         add vector3 N1,N1,N3
         add vector3 N1,N1,N4
 
         divide vector3 N1,4
         normalize vector3 N1, N1
 
         nx# = x vector3(N1)
         ny# = y vector3(N1)
         nz# = z vector3(N1)
 
         set matrix normal Matrix, x, z, nx#, ny#, nz#
 
      next x
 
   next z
 
   update matrix 1
 
endfunction