remstart
   ==============================================================
   =  Title  : Single hole Golf ?
   =  Author : Latch Grapple
   =  Date   : 06/19/2007
   =  Update :
   =  Version:
   ==============================================================
   Comments    single hole for golf?  not finished
   ==============================================================
remend
 
rem =============================================================
rem = SET UP DISPLAY
rem =============================================================
   autocam off
   set display mode 800,600,32
   sync on
   sync rate 60
 
rem =============================================================
rem = MAIN
rem =============================================================
   gosub _textures
   gosub _matrix
   gosub _lighting
 
   camx#=500
   camy#=150
   camz#=1000
 
   position camera camx#,camy#,camz#
   do
      gosub _wave_matrix
      gosub _move_camera
      gosub _blow_flag
 
 
 
      sync
   loop
 
   end
 
rem =============================================================
rem = SUBROUTINES - PROCEDURES
rem =============================================================
`----------------------------------------------------------------
   _move_camera:
      yang#=wrapvalue(yang#+mousemovex())
      xang#=wrapvalue(xang#+mousemovey())
      if upkey()=1 then move camera 10
      if downkey()=1 then move camera -10
      yrotate camera yang#
      xrotate camera xang#
      y#=get ground height(1,camera position x(),camera position z())
      camx#=camera position x()
      camz#=camera position z()
      if camera position x() < 5 then camx#=10
      if camera position x() > 5995 then camx#=5995
      if camera position z() < 5 then camz#=5
      if camera position z() > 5995 then camz#=5995
      position camera camx#,y#+150,camz#
 
   return
`----------------------------------------------------------------
   _textures:
      create bitmap 1,600,600
      grass=1
      wbasin=2
      gosub _grass
      gosub _water_basin
      blur bitmap 1,3
      get image grass,0,0,600,600
 
      gosub _water
      gosub _green
      delete bitmap 1
   return
`----------------------------------------------------------------
   _grass:
      CLS RGB(0,20,0)
      For N=1 To 20000
         Ink RGB(Rnd(15),Rnd(60)+20,Rnd(5)),0
         Dot Rnd(599),Rnd(599)
      Next N
      ink rgb(22,121,4),0
      box 10,450,80,550
      ink RGB(22,80,4),0
      box 460,100,570,510
      for n=1 to 90
         line 100,600-n,500,(600-n)-90
      next n
 
   return
`----------------------------------------------------------------
   _water_basin:
      rem water
      r#=80
      while r# > 70
         r#=r#-.3
         while ang# < 360
            inc ang#,.1
            ink RGB(rnd(32)+50,rnd(16)+32,10),0
            x#=-1*(2*r#*(cos(ang#)-(.5*cos(2*ang#))))+200
            y#=(2*r#*(sin(ang#)-(.1*sin(2*ang#))))+300
            dot x#,y#
         endwhile
         ang#=-.1
         sync
      endwhile
 
   return
`----------------------------------------------------------------
   _green:
      cls rgb(0,70,0)
      make object sphere 3,1200
      scale object 3,100,15,100
      CLS RGB(0,95,0)
      For N=1 To 20000
         Ink RGB(Rnd(15),Rnd(10)+80,Rnd(5)),0
         Dot Rnd(255),Rnd(255)
      Next N
      green=3
      while image exist(green)=1
         inc green
      endwhile
      get image green,0,0,256,256
      texture object 3,green
      position object 3,5000,0,5000
 
      rem hole and flag
      cls 0
      make object cylinder 4,20
      position object 4,5000,81,5000
      color object 4,0
 
      make object cylinder 5,180
      scale object 5,2,100,2
      position object 5,5000,170,5000
 
      make object triangle 6,0,0,0,0,25,0,25,10,0
      make mesh from object 1,6
 
      add limb 5,1,1
      scale limb 5,1,9800,100,9800
      offset limb 5,1,0,60,0
      color limb 5,1,RGB(255,128,0)
 
      set object 5,1,1,0
 
      rem cleanup
      delete object 6
      delete mesh 1
   return
`-------------------------------------------------------------------
   _blow_flag:
      tilt=timer()
 
      if timer()>=rnd(10)+tilt
         yrotate object 5, wrapvalue(rnd(30)-15)
      endif
 
      if object angle y(5) >= 30 then yrotate object (5),0
   return
`-------------------------------------------------------------------
   rem water
   _water:
      cls rgb(0,30,50)
 
      for n=1 to 2000
         color=rgb(0,rnd(20),rnd(100))
         ink color,0
         x=rnd(127)
         y=rnd(127)
         dot x,y
      next n
 
      water=2
      while image exist(water)=1
         inc water
      endwhile
 
      get image water,0,0,128,128
 
      cls 0
 
      rem debris
      for n=1 to 200
         color=rgb(0,rnd(10),rnd(40))
         ink color,0
         x=rnd(127)
         y=rnd(127)
         dot x,y
      next n
 
      debris=2
      while image exist(debris)=1
         inc debris
      endwhile
 
      get image debris,0,0,128,128
   return
`----------------------------------------------------------------
   _matrix:
      randomize 10
      make matrix 1,6000,6000,60,60
      randomize matrix 1,60
      `SET MATRIX Matrix Number, Wireframe, Transparency, Cull, Filter, Light, Fog, Ambient
      rem set for transparency and light sensitivity
      set matrix 1,1,0,1,1,1,1,1
      prepare matrix texture 1,grass,60,60
      tilenum = -1
      rem tile matrix
      for z=59 to 0 step -1
         for x=0 to 59
            inc tilenum
            set matrix tile 1,x,z,tilenum
         next x
      next z
      update matrix 1
 
      rem flatten green area
      for z = 5 to 15
         for x = 1 to 9
            set matrix height 1,x,z,0
         next x
      next z
      update matrix 1
 
      for z = 10 to 49
         for x = 46 to 57
            set matrix height 1,x,z,0
         next x
      next z
      update matrix 1
 
      z=3
      for n=1 to 9
         for x=10 to 50
            if x=15 or x=30 or x=45
               inc z
            endif
            set matrix height 1,x,z,-5
         next x
         dec z,2
      next n
 
      update matrix 1
 
 
      rem carve out lake
      r#=8
      while r# > 0
         dec r#,.1
         while ang# < 360
            inc ang#,.1
            x=-1*(1.9*r#*(cos(ang#)-(.5*cos(2*ang#))))+21
            z=(2*r#*(sin(ang#)-(.1*sin(2*ang#))))+30
            set matrix height 1,x,z,-500
         endwhile
         ang#=-.1
      endwhile
 
      update matrix 1
 
      calc_mat_normals(1,60,60,30.0,30.0)
      smooth(1,60,60)
 
      gosub _bottom
      gosub _waves
 
   return
`----------------------------------------------------------------
   _bottom:
      make object plain 1,3600,3600
      set object 1,1,0,1
      xrotate object 1,90
      position object 1,2600,-400,3000
      texture object 1,debris
      ghost object on 1
 
      make object plain 2,3600,3600
      xrotate object 2,90
      position object 2,2600,-450,3000
      color object 2,90
   return
`----------------------------------------------------------------
   _waves:
      make matrix 2,3600,3600,10,10
      prepare matrix texture 2,water,10,10
      tilenum=0
      for z=9 to 0 step -1
         for x=0 to 9
            inc tilenum
            set matrix tile 2,x,z,tilenum
         next x
      next z
      position matrix 2,800,-350,1200
      ghost matrix on 2
      update matrix 2
   return
`----------------------------------------------------------------
   _wave_matrix:
   amp#=50
 
   for z = 0 to 10
      for x = 0 to 10
 
         rem set y sin value for matrix heights
         y#=amp#*sin(degrees)+phase#
 
         rem set matrix height
         set matrix height 2,z,x,y#
      next x
 
      rem increment degrees to calculate sin() for y#
      inc degrees,65
      if degrees >= 360
         degrees = wrapvalue(degrees)
         `update matrix 1
      endif
 
   next z
   update matrix 2
 
   rem scroll underwater plane
   scrl#=.0002
   scroll object texture 1,scrl#,scrl#
 
   return
 
`----------------------------------------------------------------
   _lighting:
      set camera range 1,10000
      set ambient light 30
      color light 0,rgb(255,255,255)
      set directional light 0,10,-6,0
      color backdrop rgb(32,32,32)
      fog on
      fog distance 5000
 
   return
rem =============================================================
rem = FUNCTIONS
rem =============================================================
   Function calc_mat_normals(mat,tilex,tilez,sizex#,sizez#)
   Rem By Lee Bamber From DB Example - Adds shaded areas to matrix to give depth
   rem added tile and tile size factor for normal depth adjustment - latch
      for z=1 to tilez
         for x=1 to tilex
 
            rem Get matrix heights
            h8#=get matrix height(mat,x,z-1)
            h4#=get matrix height(mat,x-1,z)
            h#=get matrix height(mat,x,z)
            h2#=get matrix height(mat,x,z)
 
            rem Calculate projected angle X using heights
            x1#=(x-1)*sizex# : y1#=h#
            x2#=(x+0)*sizex# : y2#=h4#
            dx#=x2#-x1#
            dy#=y2#-y1#
            ax#=atanfull(dx#,dy#)
            ax#=wrapvalue(90-ax#)
 
            rem Calculate projected angle Z using heights
            z1#=(z-1)*sizez# : y1#=h2#
            z2#=(z+0)*sizez# : y2#=h8#
            dz#=z2#-z1#
            dy#=y2#-y1#
            az#=atanfull(dz#,dy#)
            az#=wrapvalue(90-az#)
 
            rem Make normal from projected angle
            nx#=sin(ax#)
            ny#=cos(ax#)
            nz#=sin(az#)
 
            rem Setting matrix normal for smoothness
            set matrix normal mat,x,z,nx#,ny#,nz#
 
         next x
      next z
      update matrix mat
   EndFunction
`----------------------------------------------------------------
   function smooth(mat,tilex,tilez)
      rem TDK's average matrix points for smoothness routine
      Rem Averages matrix heights to remove jagged edges
      for Z=0 to tilez
         for X=0 to tilex
            P0#=Get Matrix Height(mat,X,Z):     Rem Current point height
            Rem Get 4 adjoining points heights (if they exist)
            If Z-1>=0
               P1#=Get Matrix Height(mat,X,Z-1)
            Else
               P1#=P0#
            Endif
            If X+1<=TilesX
               P2#=Get Matrix Height(mat,X+1,Z)
            Else
               P2#=P0#
            Endif
            If Z+1<=TilesZ
               P3#=Get Matrix Height(mat,X,Z+1)
            Else
               P3#=P0#
            Endif
            If X-1>=0
               P4#=Get Matrix Height(mat,X-1,Z)
            Else
               P4#=P0#
            Endif
            Average#=(P0#+P1#+P2#+P3#+P4#)/5: Rem Av height of other points
            RHeight#=Average#
            Set Matrix Height mat,x,z,RHeight#
         Next x
      Next z
      Update Matrix mat
   endfunction
 
rem =============================================================
rem = DATA STATEMENTS
rem =============================================================