Rem Dark Basic Classic Project: Golf Hole Number 1
Rem Created: 11/06/2007 18:06:21
Rem Author: TDK_Man
 
Gosub Setup
 
Do
  CX# = Camera Angle X(): CY# = Camera Angle Y(): CZ# = Camera Angle Z()
  CY# = Wrapvalue(CY#+mousemovex())
  CX# = Wrapvalue(CX#+mousemovey())
  Rotate Camera CX#,CY#,CZ#
  If MouseClick()=1 Then Move Camera 50
  If MouseClick()=2 Then Move Camera -50
  CHeight# = Get Ground Height(1,Camera Position X(),Camera Position Z())
  If Camera Position Y() < CHeight#+40.0 Then Position Camera Camera Position X(), CHeight#+40.0, Camera Position Z()
  YRotate Object 4,Wrapvalue(Object Angle Y(4)+1)
  Gosub SizeNumber
  Sync
Loop
 
SizeNumber:
  X1 = Camera Position X()
  Y1 = Camera Position Y()
  Z1 = Camera Position Z()
  X2 = Object Position X(1)
  Y2 = Object Position Y(1)
  Z2 = Object Position Z(1)
  Dist# = sqrt((x1-x2)^2+(y1-y2)^2+(z1-z2)^2)
  Size = Dist# / 50
  If Size < 100 Then Size = 100
  Scale Object 4,Size,Size,100
Return
 
Setup:
  Set Display Mode 800,600,32
  Hide Mouse
  Sync On: Sync Rate 60: CLS 0
  AutoCam Off
  Backdrop On: Color Backdrop RGB(100,100,255)
  Randomize 65535
 
  Wire=1: Trans=0: Cull=1: Filter=1: Light=0: Fog=0: Ambient=0
  TilesX=70: TilesZ=70: Tilesize#=2048.0: MatZPos#=0.0
  MatWidth#=50000: MatHeight#=50000
  MatCentreX#=MatWidth#/2.0: MatCentreZ#=MatHeight#/2.0
  Dim MatX#(TilesX)
  Dim MatZ#(TilesZ)
  Dim MHeight#(70,70)
 
  Create Bitmap 1,800,600
  Set camera view 0,0,1,1
  Make Matrix 1,MatWidth#,MatHeight#,TilesX,TilesZ
  Set Matrix 1, Wireframe, Transparency, Cull, Filter, Light, Fog, Ambient
 
  Randomize Matrix 1,3000
  Gosub Smooth
  For N = 1 To 80
    X=Rnd(TilesX-2)+1: Z=Rnd(TilesZ-2)+1
    Set Matrix Height 1,x,z,14000
    Set Matrix Height 1,x-1,z-1,12000
    Set Matrix Height 1,x+1,z+1,11000
    Set Matrix Height 1,x+1,z-1,1800
    Set Matrix Height 1,x-1,z+1,1600
  Next N
  For N = 0 To TilesX
    Set Matrix Height 1,N,0,Get Matrix Height(1,N,TilesZ): Rem Match edges for scrolling
  Next N
  For N=1 To 14
    Gosub Smooth
  Next N
 
  CLS 0
  Set Text Font "Wingdings",2
  Set Text Size 32
  Ink RGB(5,0,5),0
  Text 0,0,Chr$(140)
  Blur Bitmap 1,2
  Get Image 4,0,0,24,32
  Set Text Font "Verdana",1
  Set Text Size 16
 
  CLS 0
  SpreadGap = MatWidth#/512
  High=0
  Low=100000
  For Tz=0 To 512
    For Tx=0 To 512
      Mh = Get Ground Height(1,Tx*SpreadGap,Tz*SpreadGap)
      If Mh>High Then High=Mh
      If Mh<Low Then Low=Mh
    Next Tx
  Next Tz
  ColourRange = High-Low
  Gradient# = ColourRange/255.0
  For Tz=512 To 0 Step -1
    For Tx=0 To 512
      Mh = Get Ground Height(1,Tx*SpreadGap,Tz*SpreadGap)
      M = (Mh-Low)/ Gradient# : Rem Number between 1 and 255
      Grass = 20
      Mud = 12
      Sand = 2
      Water = -10
      Rem ************ WATER ************
      If M <= Water
        For N=1 To 4
          R = Rnd(6)-3
          EdgeDist = Water-M
          If EdgeDist<2
            Speckle = Rnd(EdgeDist)
          Else
            Speckle = 1
          Endif
          If Speckle = 0
            Ink Rgb(80,80,255),0: Rem Foam
          Else
            Ink Rgb(0,0,M+140+Rnd(10)),0: Rem Water
          Endif
          Dot Tx,511-Tz
          Dot Tx+R,511-Tz+R
        Next N
      Endif
      Rem ************ SAND ************
      If M > Water and M<= Sand
        For N=1 To 4
          R = Rnd(10)-5
          EdgeDist = Sand-M
          If EdgeDist<2
            Speckle = Rnd(EdgeDist)
          Else
            Speckle = 1
          Endif
          If Speckle = 0
            Ink Rgb(M+140,M+80,0),0: Rem Mud
          Else
            Ink Rgb(M+180+Rnd(20),M+140+Rnd(20),0),0: Rem Sand
          Endif
          Dot Tx,511-Tz
          Dot Tx+R,511-Tz+R
        Next N
      Endif
      Rem ************ MUD ************
      If M > Sand and M < Mud
        For N=1 To 2
          R = Rnd(6)-3
          EdgeDist = Mud-M
          If EdgeDist<2
            Speckle = Rnd(EdgeDist)
          Else
            Speckle = 1
          Endif
          If Speckle = 0
            Ink Rgb(140,M,0),0: Rem Grass
          Else
            Ink Rgb(M+180+Rnd(20),M+160+Rnd(20),0),0: Rem Sand
          Endif
          Dot Tx,511-Tz
          Dot Tx+R,511-Tz+R
        Next N
      Endif
      Rem ************ GRASS ************
      If M > Mud
        For N=1 To 2
          R = Rnd(6)-3
          EdgeDist = M-Mud
          If EdgeDist<5
            Speckle = Rnd(EdgeDist)
          Else
            Speckle = 1
          Endif
          If Speckle = 0
            Ink Rgb(M+180+Rnd(20),M+140+Rnd(20),0),0: Rem Sand
          Else
            Ink Rgb(30,M,30),0: Rem Grass
          Endif
          Dot Tx,511-Tz
          Dot Tx+R,511-Tz+R
        Next N
      Endif
    Next Tx
  Next Tz
  Sync
 
  For Nc=1 To 5
    Blur Bitmap 1,8
  Next Nc
 
  Ink RGB(20,180,20),0
  For N=1 To 32
    Circle 120,150,N
    Circle 120,151,N
  Next N
  Ink RGB(255,0,0),0: Box 410,410,450,440
  Ink RGB(200,255,200),0: Box 412,412,448,438
  Blur Bitmap 1,4
 
  Get Image 1,0,0,512,512
  If File Exist("Golf1.bmp") Then Delete File "Golf1.bmp"
  Save Image "Golf1.bmp",1
  Sleep 1
 
  Delete Bitmap 1
  Prepare Matrix Texture 1,1,TilesX,TilesZ
  Set Matrix Texture 1,2,1
 
  t=1
  For z=TilesZ-1 to 0 Step -1
    For x=0 to TilesX-1
      Set Matrix Tile 1,x,z,t
      Inc t
    Next x
  Next z
  Normalise(1)
 
  Fog Distance 60000.0
  FOG COLOR RGB(50,30,0)
  Fog On
  Set Camera Range 20.0, 100000.0
 
  Ratio# = MatWidth#/512.0
  Make Object Cylinder 1,10
  Scale Object 1,100,8500,100
  Position Object 1,120*Ratio#,Get Ground Height(1,120*Ratio#,150*Ratio#),(512-150)*Ratio#
 
  Make Object Cylinder 2,60
  Color Object 2,0
  Scale Object 2,100,60,100
  Position Object 2,120*Ratio#, Get Ground Height(1,120*Ratio#,150*Ratio#)-245, (512-150)*Ratio#
 
  Make Object Triangle 3,0.0,0.0,0.0,   0.0,60.0,0.0,  180.0,30.0,0.0
  Color Object 3,RGB(255,0,0)
  Position Object 3,120*Ratio#, Get Ground Height(1,120*Ratio#,150*Ratio#)+340, (512-150)*Ratio#
 
  Make Object Plain 4,150,150
  Texture Object 4,4
  Position Object 4,120*Ratio#, Get Ground Height(1,120*Ratio#,150*Ratio#)+1200, (512-150)*Ratio#
  Set Object 4,1,0,0
  Scale Object 4,1000,1000,100
 
  Height# = Get Ground Height(1,45270,5791)
  Position Camera 45270,Height#+3500,5791
  Point Camera Object Position X(1),Object Position Y(1),Object Position Z(1)
  Set MipMap Mode 2
  Set camera view 0,0,800,600
 
  Ink RGB(255,255,255),0
Return
 
Rem **************************************************
Rem                  Smooth Matrix
Rem **************************************************
Smooth:
  Rem Averages matrix heights to remove jagged edges
  For Z=0 to TilesZ
    For X=0 to TilesX
      P0#=Get Matrix Height(1,X,Z):     Rem Current point height
      Rem Get 4 adjoining points heights (if they exist)
      If Z-1 > 0
        P1#=Get Matrix Height(1,X,Z-1)
      Else
        P1#=P0#
      Endif
      If X+1 < TilesX
        P2#=Get Matrix Height(1,X+1,Z)
      Else
        P2#=P0#
      Endif
      If Z+1 < TilesZ
        P3#=Get Matrix Height(1,X,Z+1)
      Else
        P3#=P0#
      Endif
      If X-1 > 0
        P4#=Get Matrix Height(1,X-1,Z)
      Else
        P4#=P0#
      Endif
      Average#=(P0#+P1#+P2#+P3#+P4#)/5: Rem Av height of other points
      Set Matrix Height 1,x,z,Average#
      MHeight#(X,Z)=Average#
    Next x
  Next z
Return
 
Function Normalise(MatNum)
  Rem By Lee Bamber From DB Example - Adds shaded areas to matrix to give depth
  For z=1 to 70
    For x=1 to 70
      h8#=MHeight#(X,Z-1)
      h4#=MHeight#(X-1,Z)
      h#=MHeight#(X,Z)
      h2#=MHeight#(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
EndFunction