Gosub Setup
 
Do
  Gosub SubAngle
  Gosub ReadKeys
  Gosub MoveMatrix
  Gosub Wavey
  Gosub Bubbles
  Sync
Loop
 
Wavey:
  If Speed#>0.0
    SET CAMERA FOV 3.14/F#
    If IncF=0
      Inc F#,.004
      Inc FCounter
      If FCounter= 25 Then IncF=1: FCounter=0
    Else
      Dec F#,.004
      Inc FCounter
      If FCounter= 25 Then IncF=0: FCounter=0
    Endif
  Endif
Return
 
ReadKeys:
  I$=Upper$(Inkey$())
  If Asc(I$)>47 and Asc(I$)<58 Then NewSpeed#=Val(I$)/4: Rem Number Keys
  If Speed#<NewSpeed#: Rem Speeding Up
    Inc Speed#,.05: If Speed#>NewSpeed# Then Speed#=NewSpeed#
  Endif
  If Speed#>NewSpeed#: Rem Slowing Down
    Dec Speed#,.05: If Speed#<NewSpeed# Then Speed#=NewSpeed#
  Endif
Return
 
MoveMatrix:
  If Speed#>0.0
    OAY#=Object Angle Y(1)
    SpeedX#=ABS(Speed#*SIN(OAy#))
    SpeedZ#=ABS(Speed#*COS(OAy#))
    BubbleXSpeed#=ABS(Speed#* SIN(Oy#))
    BubbleZSpeed#=ABS(Speed#* COS(Oy#))
    Gosub Direction
    Select TravelDir
      Case 0
        Rem Up                                                     Move OK - Speed OK
        If MSZ#>MatZPos#+Speed#-Tilesize#
          Dec MSZ#,Speed#
        Else
          MSZ#=MatZPos#
          SHIFT MATRIX Up 1
          SHIFT MATRIX Up 2
        Endif
      EndCase
      Case 1
        Rem Up & Right
        If MSZ#>MatZPos#+SpeedZ#-Tilesize#: Rem Up
          Dec MSZ#,SpeedZ#
        Else
          MSZ#=MatZPos#
          SHIFT MATRIX Up 1
          SHIFT MATRIX Up 2
        Endif
        If MSX#>MatXPos#+SpeedX#-Tilesize#: Rem Right
          Dec MSX#,SpeedX#
        Else
          MSX#=MatXPos#
          SHIFT MATRIX Left 1
          SHIFT MATRIX Left 2
        Endif
      EndCase
      Case 2
        Rem Right                                                   Move OK - Speed OK
        If MSX#>MatXPos#+Speed#-Tilesize#
          Dec MSX#,Speed#
        Else
          MSX#=MatXPos#
          SHIFT MATRIX Left 1
          SHIFT MATRIX Left 2
        Endif
      EndCase
      Case 3
        Rem Down & Right
        If MSZ#<MatZPos#+Tilesize#-SpeedZ#
          Inc MSZ#,SpeedZ#
        Else
          MSZ#=MatZPos#
          SHIFT MATRIX Down 1
          SHIFT MATRIX Down 2
        Endif
        If MSX#>MatXPos#+SpeedX#-Tilesize#
          Dec MSX#,SpeedX#
        Else
          MSX#=MatXPos#
          SHIFT MATRIX Left 1
          SHIFT MATRIX Left 2
        Endif
      EndCase
      Case 4
        Rem Down                                                   Move OK - Speed OK
        If MSZ#<MatZPos#+Tilesize#-Speed#
          Inc MSZ#,Speed#
        Else
          MSZ#=MatZPos#
          SHIFT MATRIX Down 1
          SHIFT MATRIX Down 2
        Endif
      EndCase
      Case 5
        Rem Down & Left
        If MSZ#<MatZPos#+Tilesize#-SpeedZ#
          Inc MSZ#,SpeedZ#
        Else
          MSZ#=MatZPos#
          SHIFT MATRIX Down 1
          SHIFT MATRIX Down 2
        Endif
        If MSX#<MatXPos#+Tilesize#-SpeedX#
          Inc MSX#,SpeedX#
        Else
          MSX#=MatXPos#
          SHIFT MATRIX Right 1
          SHIFT MATRIX Right 2
        Endif
      EndCase
      Case 6
        Rem Left                                                   Move OK - Speed OK
        rem If MSX#<MatXPos#+Tilesize#+SpeedX#
        If MSX#<MatXPos#+Tilesize#-Speed#
          Inc MSX#,Speed#
        Else
          MSX#=MatXPos#
          SHIFT MATRIX Right 1
          SHIFT MATRIX Right 2
        Endif
      EndCase
      Case 7
        Rem Up & Left
        If MSZ#>MatZPos#+SpeedZ#-Tilesize#
          Dec MSZ#,SpeedZ#
        Else
          MSZ#=MatZPos#
          SHIFT MATRIX Up 1
          SHIFT MATRIX Up 2
        Endif
        If MSX#<MatXPos#+Tilesize#-SpeedX#
          Inc MSX#,SpeedX#
        Else
          MSX#=MatXPos#
          SHIFT MATRIX Right 1
          SHIFT MATRIX Right 2
        Endif
      EndCase
      Position Matrix 1,MSX#,0.0,MSZ#: Rem Seabed
      Position Matrix 2,MSX#,IceY#,MSZ#: Rem Ice Surface
    EndSelect
  Endif
Return
 
SubAngle:
  Rem UP/DOWN
  If DownKey()=1 And Speed#>0.0: Rem Going Up
    pitchspeed#=curvevalue(2.0,pitchspeed#,20.0)
  Endif
  If UpKey()=1 And Speed#>0.0
    pitchspeed#=curvevalue(-2.0,pitchspeed#,20.0)
  Endif
  If Upkey()=0 and downkey()=0 then pitchspeed#=curvevalue(0.0,pitchspeed#,20.0)
  rem Actually Alter Object Angles
  pitch object up 1,pitchspeed#
  Rotate Object 2,Object Angle X(2),Object Angle Y(1),Object Angle Z(2)
  rem Get angles for movement calculation
  move object 1,1
  newx#=object position x(1) : newy#=object position y(1) : newz#=object position z(1)
  move object 1,-1
  oldx#=object position x(1) : oldy#=object position y(1) : oldz#=object position z(1)
  OAY#=wrapvalue(atanfull(newx#-oldx#,newz#-oldz#))
  OAX#=wrapvalue(asin(newy#-oldy#))
  rem change depth
  Inc Depth#,(newy#-oldy#)*DiveSpeed#
  rem get the ground height
  Gh#=Get Ground Height(1,0.0-MSX#,0.0-MSZ#)+5
  If Depth#<Gh#+1 Then Depth#=Gh#+1: Rem Hit Floor
  If Depth#>800
    Depth#=800
    Rotate Object 1,0.0,0.0,0.0: Rem Hit Ice Ceiling
    pitchspeed#=0.0
  Endif
  Rem Draw Submarine
  If Speed#>0
    Position Object 1,0.0,Depth#,0.0
    Position Object 2,0.0,Gh#,0.0: Rem Shadow
  Endif
  CAMFOLLOW:
  Ch#=Depth#+3: If Ch#>795 Then Ch#=795
  SET CAMERA TO FOLLOW 0.0,Depth#,0.0,OAY#,10,Ch#,8,0
  Point Camera 0.0,Depth#,0.0
Return
 
Direction:
  If Int(Oay#)=0 Then TravelDir=0
  If Int(Oay#)>0 And Int(Oay#)<90 Then TravelDir=1
  If Int(Oay#)=90 Then TravelDir=2
  If Int(Oay#)>91 And Int(Oay#)<180 Then TravelDir=3
  If Int(Oay#)=180 Then TravelDir=4
  If Int(Oay#)>181 And Int(Oay#)<270 Then TravelDir=5
  If Int(Oay#)=270 Then TravelDir=6
  If Int(Oay#)>271 And Int(Oay#)<359 Then TravelDir=7
Return
 
Bubbles:
  Rem Create Bubbles
  If BubbleCount<300 Then Inc BubbleCount
  O2=Rnd(8)-4
  Lx#=Rnd(500)-250: Ly#=0.0: Lz#=Rnd(500)
  Bubbles#(0,0,BubbleCount)=Lx#+O2:           Rem X Start Position
  Bubbles#(0,1,BubbleCount)=Ly#:              Rem Y Start Position
  Bubbles#(0,2,BubbleCount)=Lz#:              Rem Z Start Position
  Bubbles#(0,3,BubbleCount)=.0001:            Rem Rise speed
 
  Rem Move Existing Bubbles
  For Nb=0 To BubbleCount
    Bubbles#(0,0,Nb)=Bubbles#(0,0,Nb)-BubbleXSpeed#:      Rem 0=X Position <<<<<<<<<<<<<<
    Bubbles#(0,1,Nb)=Bubbles#(0,1,Nb)+Bubbles#(0,3,Nb):   Rem 1=Depth
    Bubbles#(0,2,Nb)=Bubbles#(0,2,Nb)-Speed#:             Rem 2=Z Position <<<<<<<<<<<<<<
    Bubbles#(0,3,Nb)=Bubbles#(0,3,Nb)+.003:               Rem Increase this bubble's rise rate
    POINT OBJECT Nb+100,Camera Position X(),Camera Position Y(),Camera Position Z()
    Rem Hit the surface so make new bubble
    If Bubbles#(0,1,Nb)>Camera Position Y()+50 or Bubbles#(0,2,Nb)< 0
      O1=Rnd(4)+1: O2=Rnd(8)-4
      Lx#=Rnd(500)-250: Ly#=0.0: Lz#=Rnd(500)
      Bubbles#(0,0,Nb)=Lx#+O2
      Bubbles#(0,1,Nb)=Ly#
      Bubbles#(0,2,Nb)=Lz#
      Bubbles#(0,3,Nb)=.0001
    Endif
    Position Object Nb+100,Bubbles#(0,0,Nb),Bubbles#(0,1,Nb),Bubbles#(0,2,Nb): Rem Bubble!!
  Next Nb
Return
 
Normalise:
  Rem By Lee Bamber From DB Example
  For z=1 to TilesZ
    For x=1 to TilesX
      h8#=get matrix height(MatNum,x,z-1)
      h4#=get matrix height(MatNum,x-1,z)
      h#=get matrix height(MatNum,x,z)
      h2#=get matrix height(MatNum,x,z)
      x1#=(x-1)*25.0
      y1#=h#
      x2#=(x+0)*25.0
      y2#=h4#
      dx#=x2#-x1#
      dy#=y2#-y1#
      ax#=atanfull(dx#,dy#)
      ax#=wrapvalue(90-ax#)
      z1#=(z-1)*25.0
      y1#=h2#
      z2#=(z+0)*25.0
      y2#=h8#
      dz#=z2#-z1#
      dy#=y2#-y1#
      az#=atanfull(dz#,dy#)
      az#=wrapvalue(90-az#)
      nx#=sin(ax#)
      ny#=cos(ax#)
      nz#=sin(az#)
      Set matrix normal MatNum,x,z,nx#,ny#,nz#
    next x
  next z
  Update Matrix MatNum
Return
 
MakeMatrices:
  Rem ----------------
  Rem Create Sea Floor
  Rem ----------------
 
  Rem Make A Floor Texture
  Create Bitmap 1,Tilesize#,Tilesize#
  CLS RGB(80,80,80)
  For T=1 To 5000
    M=Rnd(30)+50
    Ink Rgb(m,m,m),0
    Dot Rnd(Tilesize#-2)+1,Rnd(Tilesize#-2)+1
  Next T
  Get Image 1,0,0,Tilesize#,Tilesize#
  Delete Bitmap 1
 
  Rem Matrix Variables
  MatWidth#=TilesX*Tilesize#: MatHeight#=TilesZ*Tilesize#
  MSX#=0-(MatWidth#/2.0): Rem (-3200)
  MSZ#=0-(MatHeight#/2.0): Rem (-3200)
  MatXPos#=MSX#
  MatZPos#=MSZ#
 
  Rem Make The Seabed Matrix
  Make Matrix 1,MatWidth#,MatHeight#,TilesX,TilesZ
  PREPARE MATRIX TEXTURE 1,1,1,1
  Position Matrix 1, MSX#,0.0,MSZ#
  Randomize Matrix 1,20
  Update Matrix 1
  MatNum=1: Gosub Normalise
 
  Rem ---------------------
  Rem Create Frozen Surface
  Rem ---------------------
 
  Rem Make An Ice Texture
  Create Bitmap 1,Tilesize#,Tilesize#
  CLS RGB(255,255,255)
  For T=1 To 5000
    M=Rnd(15)+240
    Ink Rgb(m-5,m-5,m),0
    Dot Rnd(Tilesize#-2)+1,Rnd(Tilesize#-2)+1
  Next T
  Get Image 2,0,0,Tilesize#,Tilesize#
  Delete Bitmap 1
 
  Rem Make The Floating Ice Matrix
  Make Matrix 2,MatWidth#,MatHeight#,TilesX,TilesZ
  PREPARE MATRIX TEXTURE 2,2,1,1
  Position Matrix 2, MSX#,IceY#,MSZ#
  Randomize Matrix 2,50
  Update Matrix 2
  MatNum=2: Gosub Normalise
Return
 
MakeMedia:
  Rem Submarine
  Make Object Box 1,1,1,2
  Rem Submarine Shadow
  Make Object Box 2,1,1,2: Scale Object 2,100,10,100: Color Object 2,0
 
  Create Bitmap 1,640,480
  Rem Image For Bubble Particle
  CLS 0
  Ink RGB(230,255,255),0
  Circle 18,18,17
  Circle 12,8,3
  Blur Bitmap 1,4
  Get Image 5,0,0,37,37
 
  Set Current Bitmap 0
  Delete Bitmap 1
 
Return
 
Setup:
  Rem Program Setup
  Set Display Mode 800,600,32
  Hide Mouse
  Sync On
  SET GAMMA 0,0,0
  Autocam off
 
  Backdrop on
  Color Backdrop rgb(0,30,50)
  Fog On
  Fog Distance 600
  FOG COLOR RGB(0,30,50)
  Dim Bubbles#(10,3,403): Rem Stream,XYZ,Number
 
  TilesX=50: TilesZ=50: Tilesize#=128.0: Speed#=0: IceY#=800.0: Depth#=IceY#-790.0
  NewHead#=0.0: Head#=0.0
  pitchspeed#=0.0
  turnspeed#=0.0
  DiveSpeed#=1.5
  Rollspeed#=0.0
  rolled#=0.0
  F#=2.905
 
  Set Ambient light 40
 
  Gosub MakeMedia
  Gosub MakeMatrices
 
  Rem Position Submarine
  Gh#=Get Ground Height(1,0.0-MSX#,0.0-MSZ#)+5
  Position Object 1,0.0, Depth#, 0.0
  Position Object 2,0.0,Gh#,0.0: Rem Shadow
 
  STARTCAM:
  Rem Set Up Camera
  Set Camera Range 5.0, 10000.0
  Position Camera 0.0-40,Depth#+150,-30.0
  Point Camera 0.0,Depth#,0.0
 
  Rem Create Objects For Bubble Particle System
  For N=0 To 400
    Make Object Plain N+100,.8,.8
    Ghost Object On N+100
    Texture object N+100,5
    Ghost object on N+100
    Set Object N+100,1,0,0
  Next N
  Randomize Timer()
  T=Timer()
  FadeIn()
Return
 
Function FadeIn
  Done=0: NewLevel#=0
  Time=Timer()
  EndTime#=Time+(3*1000)
  Step#=EndTime#-Time
  Repeat
    T#=Timer()-Time
    Perc#=T#/Step#
    T1=(255*Perc#)
    If T1>255 then T1=255 : Done=1
    Set Gamma T1,T1,T1
    Sync
  Until Done=1
EndFunction