Sorry your browser is not supported!

`setup
sync on : sync rate 60
set display mode 1024,768,32 : hide mouse
autocam off : set camera range 1,0x7fffffff
backdrop on : color backdrop 0
fog on : fog color rgb(255,255,255) : fog distance 1000
set ambient light 30 : color ambient light rgb(255,0,0)

`Setup Constants
#CONSTANT SEA_VEC1 10
#CONSTANT SEA_VEC2 11
#CONSTANT SEA_TILES 32
#CONSTANT SEA_SIZE 6.0
#CONSTANT SEA_ELAST 0.002
#CONSTANT SEA_DAMP 0.995
#CONSTANT SEA_AMP 3.0
#CONSTANT SEA_FREQ 2.0
#CONSTANT SEA_FC 4

`Setup Vectors
null = make vector2(SEA_VEC1)
null = make vector3(SEA_VEC2)

`Setup Arrays
Dim WaveVerts(SEA_TILES, SEA_TILES, 6)
Dim WaveArrayOffset(5, 2)
Dim WaveHeight(SEA_TILES, SEA_TILES) as float
Dim ObjTaken(0) as boolean
Dim ImgTaken(0) as boolean
Dim MemTaken(0) as boolean
Dim MeshTaken(0) as boolean
Dim Tile(SEA_TILES+1,SEA_TILES+1)
Dim TileV(SEA_TILES*SEA_TILES) as float
Dim TileF(SEA_TILES*SEA_TILES) as boolean
Dim TileH(SEA_TILES*SEA_TILES) as float
Dim TileRX(SEA_FC)
Dim TileRZ(SEA_FC)

`Setup Globals
Global SEA_OBJ as Integer : SEA_OBJ=FreeObject()
Global SEA_SPH as Integer : SEA_SPH=FreeImage()
Global SEA_MEM as Integer : SEA_MEM=FreeMemblock()
Global SEA_MESH as Integer : SEA_MESH=FreeMesh()
Global SEA_ANG as float

`Create Sea
createSeaTexture()
createSea()
Set Sphere Mapping On SEA_OBJ,SEA_SPH
Set Object Specular SEA_OBJ,rgb(0,128,128) : Set Object Specular Power 1,10
for x=1 to SEA_TILES
   for z=1 to SEA_TILES
      Tile(x,z)=tileC
      inc tileC
   next x
next z
TileRX(1)=2             : TileRZ(1)=2
TileRX(2)=SEA_TILES-1   : TileRZ(2)=2
TileRX(3)=2             : TileRZ(3)=SEA_TILES-1
TileRX(4)=SEA_TILES-1   : TileRZ(4)=SEA_TILES-1
   for f=1 to SEA_FC
      TileF(Tile(TileRX(f),TileRZ(f)))=1
   next f

`Camera
dist#=200
ax#=320 : ay#=42


`Main Loop
do

   `Camera
   ax#=wrapvalue(ax#+mousemoveY())
   ay#=wrapvalue(ay#-mousemoveX())
   if mouseclick()=1 then dec dist#
   if mouseclick()=2 then inc dist#
   x#=(sin(ay#)*cos(ax#))*dist#
   y#=-sin(ax#)*dist#
   z#=(cos(ay#)*cos(ax#))*dist#
   position camera x#,y#,z# : point camera 0,0,0


   `Control Waves
   if spacekey() then wstart=1
   if wstart=1
   controlSea()
   endif

   `User Text
   ink rgb(255,255,255),0
   Text 10,10,"FPS: "+str$(screen fps())
   Text 10,30,"Press Space to Start Waves"

   sync
loop



`Functions
function createSea()
WaveArrayOffset(0,0)=0 : WaveArrayOffset(0,1)=0
WaveArrayOffset(1,0)=0 : WaveArrayOffset(1,1)=-1
WaveArrayOffset(2,0)=-1: WaveArrayOffset(2,1)=0
WaveArrayOffset(3,0)=0 : WaveArrayOffset(3,1)=-1
WaveArrayOffset(4,0)=-1: WaveArrayOffset(4,1)=-1
WaveArrayOffset(5,0)=-1: WaveArrayOffset(5,1)=0
   make memblock SEA_MEM,12+(32*3*2*SEA_TILES*SEA_TILES)
   write memblock dword SEA_MEM,0,274
   write memblock dword SEA_MEM,4,32
   write memblock dword SEA_MEM,8,SEA_TILES*SEA_TILES*2*3
      for i=0 to SEA_TILES-1
         for j=0 to SEA_TILES-1
            x=(i-(SEA_TILES*0.5))*SEA_SIZE
            z=(j-(SEA_TILES*0.5))*SEA_SIZE
            p=((i*SEA_TILES)+j)
               MakeMeshEntry(SEA_MEM,12+(p*192)     ,x         ,0,z         ,0,1,0,0.0,0.0)
               MakeMeshEntry(SEA_MEM,12+(p*192)+32  ,x         ,0,z+SEA_SIZE,0,1,0,0.0,1.0)
               MakeMeshEntry(SEA_MEM,12+(p*192)+64  ,x+SEA_SIZE,0,z         ,0,1,0,1.0,0.0)
               MakeMeshEntry(SEA_MEM,12+(p*192)+96  ,x         ,0,z+SEA_SIZE,0,1,0,0.0,1.0)
               MakeMeshEntry(SEA_MEM,12+(p*192)+128 ,x+SEA_SIZE,0,z+SEA_SIZE,0,1,0,1.0,1.0)
               MakeMeshEntry(SEA_MEM,12+(p*192)+160 ,x+SEA_SIZE,0,z         ,0,1,0,1.0,0.0)
                  for n=0 to 5
                     WaveVerts(i,j,n)=(p*6)+n
                  next n
         next j
      next i
   make mesh from memblock SEA_MESH, SEA_MEM : Delete Memblock SEA_MEM
   make object SEA_OBJ, SEA_MESH, 0 : Delete Mesh SEA_MESH
   set object transparency SEA_OBJ, 3
endfunction
function createSeaTexture()
create bitmap 1,128,128 : set current bitmap 1
ink rgb(0,0,0),0 : box 0,0,128,128
for x=1 to 1000
   ink rgb(0,128,255),0
   dot rnd(128),rnd(128)
next x
for x=1 to 1000
   ink rgb(0,128,0),0
   dot rnd(128),rnd(128)
next x
get Image SEA_SPH,0,0,128,128
set current bitmap 0 : delete bitmap 1
endfunction
function controlSea()
SEA_ANG=wrapvalue(SEA_ANG+SEA_FREQ)
y#=sin(SEA_ANG)*SEA_AMP
for f=1 to SEA_FC
   if TileF(Tile(TileRX(f),TileRZ(f)))
      TileH(Tile(TileRX(f),TileRZ(f)))=y#
   endif
next f
   lock vertexdata for limb SEA_OBJ, 0
   for x = 2 to SEA_TILES-1
      for z = 2 to SEA_TILES-1
         if x<SEA_TILES then dxp#=TileH(Tile(x+1,z))-TileH(Tile(x,z))
         if x>1 then dxm#=TileH(Tile(x-1,z))-TileH(Tile(x,z))
         if z<SEA_TILES then dzp#=TileH(Tile(x,z+1))-TileH(Tile(x,z))
         if z>1 then dzm#=TileH(Tile(x,z-1))-TileH(Tile(x,z))
            vsum#=dxp#+dxm#+dzp#+dzm#
            acc#=vsum#*SEA_ELAST
            TileV(Tile(x,z))=TileV(Tile(x,z))+acc#
               if TileF(Tile(x,z))=0
                  TileH(Tile(x,z))=TileH(Tile(x,z))+TileV(Tile(x,z))
               endif
         createNormal(TileH(Tile(x,z)),TileH(Tile(x,z-1)),TileH(Tile(x+1,z)),TileH(Tile(x,z+1)),TileH(Tile(x-1,z)))
         for i = 0 to 5
            v = WaveVerts(x + WaveArrayOffset(i, 0), z + WaveArrayOffset(i, 1), i)
            set vertexdata position v, get vertexdata position x(v), TileH(Tile(x,z)), get vertexdata position z(v)
            set vertexdata normals v, x vector3(SEA_VEC2), y vector3(SEA_VEC2), z vector3(SEA_VEC2)
         next i
      next z
   next x
   unlock vertexdata
endfunction


function createNormal(hMiddle#, hUp#, hRight#, hDown#, hLeft#)
   set vector3 SEA_VEC2, hLeft#-hRight#, SEA_SIZE, hUp#-hDown#
   normalize vector3 SEA_VEC2, SEA_VEC2
endfunction
function MakeMeshEntry(mbNum, n,    x#, y#, z#,   nx#, ny#, nz#,    u#, v#)
   write memblock float mbNum, n +  0, x#
   write memblock float mbNum, n +  4, y#
   write memblock float mbNum, n +  8, z#
   write memblock float mbNum, n + 12, nx#
   write memblock float mbNum, n + 16, ny#
   write memblock float mbNum, n + 20, nz#
   write memblock float mbNum, n + 24, u#
   write memblock float mbNum, n + 28, v#
endfunction




Function FreeObject()
local num as integer
array insert at bottom objtaken()
num=array count(objtaken())
if objtaken(num)=0 and object exist(num)=0
   objtaken(num)=1 : exitfunction num
endif
Endfunction 0
Function FreeImage()
local num as integer
array insert at bottom imgtaken()
num=array count(imgtaken())
if imgtaken(num)=0 and image exist(num)=0
   imgtaken(num)=1 : exitfunction num
endif
Endfunction 0
Function FreeMemblock()
local num as integer
array insert at bottom memtaken()
num=array count(memtaken())
if memtaken(num)=0 and memblock exist(num)=0
   memtaken(num)=1 : exitfunction num
endif
Endfunction 0
Function FreeMesh()
local num as integer
array insert at bottom meshtaken()
num=array count(meshtaken())
if meshtaken(num)=0 and mesh exist(num)=0
   meshtaken(num)=1 : exitfunction num
endif
Endfunction 0