;Grass rendering algorhytm
;By Matt Merkulov
;E-mail: MattMerk[@]mail[.]ru
;ICQ: 392-274-050

SeedRnd MilliSecs()

Const LandscapeSize = 256
Const DitheringTextureSize = 512
Const DitheringTextureScale = 4
Const LandscapeSizeMask = LandscapeSize - 1
Const LandscapeHeight# = 32

Const GrassColor = 100
Const GrassDColor = 20
Const GrassBackground = 100
Const MaxGrassSpreadingRadius# = 0.72

Const BushesThreshold# = 0.28
Const MaxBushesThreshold# = 0.34
Const SandThreshold# = 0.3
Const HillsMinRadius = 16
Const HillsMaxRadius = 64
Const HillsMinHeight# = 0.2
Const HillsMaxHeight# = 1.0
Const HillsQuantity# = 100

Const BushTypesQuantity = 2
Const BushModelsQuantity = 2
Const BushTextureSize = 256

Const BushModelScaleMin# = 0.3
Const BushModelScaleMax# = 0.6

Const PlayerHeight# = 1.5
Const PlayerSpeedPerSecond# = 10.0
Const PlayerTurnPerSecond# = 180.0

Const FadingTimeInSeconds# = 1.0
Const MaxAlpha# = 1.0



;Small grass quadrants - smooth, but slow grass rendering
Const GrassGridCellSize# = 2.0
Const BushesQuantityPerSquare = 12
Const GrassRadiusInSquares# = 8


;Largel grass quadrants - jerky, but fast grass rendering
;Const GrassGridCellSize# = 8.0
;Const BushesQuantityPerSquare = 192
;Const GrassRadiusInSquares# = 2


Const GrassGridSize = LandscapeSize / GrassGridCellSize#
Const BushTextureXTexSize# = 1.0 / BushTypesQuantity
Const BushTextureYTexSize# = 1.0 / BushModelsQuantity
Const GrassRadius# = GrassRadiusInSquares# * GrassGridCellSize#

Graphics3D 800, 600
Camera = CreateCamera()
ScaleEntity camera, 0.3, 0.3, 0.3
PositionEntity Camera, LandscapeSize / 2, 100, LandscapeSize / 2
;RotateEntity Camera, 45, 0, 0
RotateEntity CreateLight(), 45, 45, 0


Type ActiveSquare
 Field X, Z, JustAdded
End Type

Type FadingBush
 Field Alpha#, FadingMode, X, Z
End Type

Dim ServiceMap(LandscapeSize, LandscapeSize)
Const VisibleActiveSquare = %11
Const InvisibleActiveSquare = %10
Const VisibleSquare = %01
Const InvisibleSquare = %00
Const Visibility = %01
Const Activity = %10

Dim BushModel(BushTypesQuantity - 1, BushModelsQuantity - 1)
Dim BushQuantityMap#(GrassGridSize - 1, GrassGridSize - 1)
Dim BushMap(GrassGridSize - 1, GrassGridSize - 1)
Dim BushFader.FadingBush(GrassGridSize - 1, GrassGridSize - 1)

Global Landscape = CreateTerrain(LandscapeSize)
Global LandscapeTexture = CreateTexture(LandscapeSize, LandscapeSize, 15)
Global LandscapeDitheringTexture = CreateTexture(DitheringTextureSize, DitheringTextureSize, 15)
Global Grass = CreateTexture(BushTextureSize * BushTypesQuantity, BushTextureSize * BushModelsQuantity, 13)
ScaleEntity Landscape, 1, LandscapeHeight#, 1

CreateLandscape

CreateBushes

PaintTextures

TryToAddSquare EntityX(Camera) / GrassGridCellSize#, EntityZ(Camera) / GrassGridCellSize#

Const FadingIn = 1, FadingOut = 2

Repeat
 MoveEntity Camera, 0, 0, PrevFrameRenderingTimeInSeconds# * PlayerSpeedPerSecond# * (KeyDown(200) - KeyDown(208))
 TurnEntity Camera, 0, PrevFrameRenderingTimeInSeconds# * PlayerTurnPerSecond# * (KeyDown(203) - KeyDown(205)), 0

 FrameBeginningTime = MilliSecs()

 PlayerX# = EntityX(Camera)
 PlayerZ# = EntityZ(Camera)
 PositionEntity Camera, PlayerX#, TerrainY#(Landscape, PlayerX#, 0, PlayerZ#) + PlayerHeight#, PlayerZ#

 SetBuffer TextureBuffer(LandscapeTexture)

 qua = 0
 For S.ActiveSquare=Each ActiveSquare
 tmp = ServiceMap(S\X, S\Z)
 If (ServiceMap(S\X, S\Z) And Activity) = Activity And S\JustAdded Then
 Delete S
 Else
 S\JustAdded = False
 Dist# = EntityDistance(BushMap(S\X, S\Z), Camera)
 ;Stop
 If Dist# > GrassRadius# Then
 If (ServiceMap(S\X, S\Z) And Visibility) = VisibleSquare Then
 ExpandSquare S
 If Paint Then WritePixel S\X * GrassGridCellSize#, S\Z * GrassGridCellSize#, $FF00FFFF
 If BushMap(S\X, S\Z) Or GrassMethod = MethodHide Then
 If BushFader(S\X, S\Z) <> Null Then
 FB.FadingBush = BushFader(S\X, S\Z)
 Else
 FB.FadingBush = New FadingBush
 FB\X = S\X
 FB\Z = S\Z
 FB\Alpha# = MaxAlpha#
 BushFader(S\X, S\Z) = FB
 End If
 FB\FadingMode = FadingOut
 End If
 ServiceMap(S\X, S\Z) = InvisibleActiveSquare
 Else
 If CountNeighbors(S, VisibleSquare) = 0 Then
 ServiceMap(S\X, S\Z) = InvisibleSquare
 Delete S
 Else
 ServiceMap(S\X, S\Z) = InvisibleActiveSquare
 End If
 End If
 Else
 If (ServiceMap(S\X, S\Z) And Visibility) = InvisibleSquare Then
 ExpandSquare S
 If Paint Then WritePixel S\X * GrassGridCellSize#, S\Z * GrassGridCellSize#, $FFFF0000
 ServiceMap(S\X, S\Z) = VisibleActiveSquare
 S\JustAdded = False
 ShowEntity BushMap(S\X, S\Z)
 If BushFader(S\X, S\Z) <> Null Then
 FB.FadingBush = BushFader(S\X, S\Z)
 Else
 FB.FadingBush = New FadingBush
 FB\X = S\X
 FB\Z = S\Z
 FB\Alpha# = 0.0
 BushFader(S\X, S\Z) = FB
 End If
 FB\FadingMode = FadingIn
 Else
 If CountNeighbors(S, InvisibleSquare) = 0 Then
 ServiceMap(S\X, S\Z) = VisibleSquare
 Delete S
 Else
 ServiceMap(S\X, S\Z) = VisibleActiveSquare
 End If
 End If
 End If
 End If
 Next

 DFading# = PrevFrameRenderingTimeInSeconds# / FadingTimeInSeconds#
 For FB.FadingBush = Each FadingBush
 A# = FB\Alpha#
 If FB\FadingMode = FadingIn Then
 A# = A# + DFading#
 If A# > MaxAlpha# Then A# = MaxAlpha#
 FB\Alpha# = A#
 EntityAlpha BushMap(FB\X, FB\Z), A#
 If A# = MaxAlpha# Then Delete FB
 Else
 A# = A# - DFading#
 If A# < 0.0 Then A# = 0.0
 FB\Alpha# = A#
 EntityAlpha BushMap(FB\X, FB\Z), A#
 If A# = 0.0 Then
 HideEntity BushMap(FB\X, FB\Z)
 BushFader(FB\X, FB\Z) = Null
 Delete FB
 End If
 End If
 Next

 For S.ActiveSquare=Each ActiveSquare
 qua = qua + 1
 Next

 SetBuffer BackBuffer()
 
 RenderWorld

 ;Stop

 If FPSCounterResetTime <= MilliSecs() Then
 FPSCounterResetTime = MilliSecs() + 1000
 FPS = FPSCounter
 FPSCounter = 0
 Else
 FPSCounter = FPSCounter + 1
 End If
 Text 0, 0, "Frames / sec:" + FPS + ", activesquares: " + qua

 Flip

 PrevFrameRenderingTimeInSeconds# = 0.001 * (MilliSecs() - FrameBeginningTime)
Until KeyHit(1)

For X = 0 To GrassGridSize - 1
 For Y = 0 To GrassGridSize - 1
 If BushMap(X, Y) Then FreeEntity BushMap(X, Y)
 Next
Next

FreeEntity Landscape
FreeTexture LandscapeTexture
FreeTexture LandscapeDitheringTexture

Function CreateLandscape()
 SetBuffer FrontBuffer()
 Text 0, 0, "Generating landscape..."
 For n = 1 To HillsQuantity
 HillRadius = Rnd(HillsMinRadius, HillsMaxRadius)
 HillX = Rand(0, LandscapeSize)
 HillY = Rand(0, LandscapeSize)
 HillHeight# = Rnd(HillsMinHeight#, HillsMaxHeight#)

 If -HillRadius < -HillX Then DXFrom = -HillX Else DXFrom = -HillRadius
 If HillRadius > LandscapeSize - HillX Then DXTo = LandscapeSize - HillX - 1 Else DXTo = HillRadius
 If -HillRadius < -HillY Then DYFrom = -HillY Else DYFrom = -HillRadius
 If HillRadius > LandscapeSize - HillY Then DYTo = LandscapeSize - HillY - 1 Else DYTo = HillRadius

 For DY = DYFrom To DYTo
 For DX = DXFrom To DXTo
 X = HillX + DX
 Y = HillY + DY
 K# = Sqr(DX * DX + DY * DY) / HillRadius
 If K# > 1.0 Then K# = 1.0
 Height# = 0.5 * (1.0 + Cos(180.0 * K#)) * HillHeight# * HillRadius / 64
 If Height# > TerrainHeight#(Landscape, X, Y) Then ModifyTerrain Landscape, X, Y, Height#
 Next
 Next
 Next

 SetBuffer FrontBuffer()
 Text 0, 10, "Painting landscape..."
 SetBuffer TextureBuffer(LandscapeTexture)
 For Y = 0 To LandscapeSize - 1
 For X = 0 To LandscapeSize - 1
 If TerrainHeight#(Landscape, X, Y) > SandThreshold# Then
 WritePixel X, Y, $FF00FF00
 Else
 WritePixel X, Y, $FFFFFF00
 End If
 Next
 Next
End Function

Function PaintTextures()
 ScaleTexture LandscapeTexture, LandscapeSize, -LandscapeSize
 TerrainShading Landscape, True

 ScaleTexture LandscapeDitheringTexture, DitheringTextureScale, DitheringTextureScale
 SetBuffer TextureBuffer(LandscapeDitheringTexture)
 For Y = 0 To DitheringTextureSize
 For X = 0 To DitheringTextureSize
 WritePixel X, Y, (Rand(96,160) * $010101) Or $FF000000
 Next
 Next

 EntityTexture Landscape, LandscapeDitheringTexture
 EntityTexture Landscape, LandscapeTexture, 0, 1
 TextureBlend LandscapeTexture, 2
End Function

Function CreateBushes()
 ;SetBuffer BackBuffer()
 SetBuffer FrontBuffer()
 Text 0, 20, "Painting textures..."

 SetBuffer TextureBuffer(Grass)
 For Y = 0 To BushTextureSize * BushTypesQuantity - 1
 For X = 0 To BushTextureSize * BushModelsQuantity - 1
 WritePixel X, Y, 256 * GrassBackground
 Next
 Next

 For n1 = 0 To BushTypesQuantity - 1
 For n2 = 0 To BushModelsQuantity - 1
 
 m = CreateMesh()
 s = CreateSurface(m)
 If n1 = 0 Then
 For nn = 1 To 100 + n2 * 100
 Radius# = Rnd(BushTextureSize / 2, BushTextureSize)
 X = BushTextureSize * (Rnd(0,1) ^ 2 * (Rand(0, 1) * 2 - 1) + 1) * 0.5
 Repeat
 Angle# = Rnd(70, 110)
 X2 = Cos(Angle#) * Radius# + X
 Y2 = BushTextureSize - 1 - Sin(Angle#) * Radius# + n2 * BushTextureSize
 Until X2 >=0 And X2 < BushTextureSize
 For DeltaX = -3 To 3
 Color 0, GrassColor + DeltaX * GrassDColor, 0
 Line X + DeltaX, (n2 + 1) * BushTextureSize - 1, X2, Y2
 Next
 Next
 For nn= 0 To 7
 Angle# = nn * 45
 ;CreateQuad s, Cos(Angle# - 45), Sin(Angle# - 45), Cos(Angle# + 45), Sin(Angle# + 45), Cos(Angle#) * 0.75, Sin(Angle#) * 0.75
 CreateQuad s, Cos(Angle#) * 0.5, Sin(Angle#) * 0.5, -Cos(Angle#) * 0.5, -Sin(Angle#) * 0.5, n1, n2, Cos(Angle# + 90), Sin(Angle# + 90)
 Next
 Else
 For nn = 1 To 150 + n2 * 150
 X = Rnd(BushTextureSize * 2 / 5, BushTextureSize * 3 / 5) + BushTextureSize
 Angle# = Rnd(10, 170)
 Radius# = Rnd(0, 1) * (1 - Abs(angle - 90) / 133) * BushTextureSize
 X2 = Cos(Angle#) * Radius# + BushTextureSize / 2 + BushTextureSize
 Y2 = (n2 + 1) * BushTextureSize - 1 - Sin(Angle#) * Radius# 
 For DeltaX = -3 To 3
 Color 0, GrassColor + DeltaX * GrassDColor, 0
 Line X + DeltaX, (n2 + 1) * BushTextureSize - 1, X2, Y2
 Next
 Next
 For nn = 0 To 3
 Angle# = nn * 45
 xx# = Cos(Angle#)
 yy# = Sin(Angle#)
 CreateQuad s, xx#, yy#, -xx#, -yy#, n1, n2
 Next
 End If
 BushModel(n1, n2) = m
 HideEntity m
 Next
 Next

 SetBuffer FrontBuffer()
 Color 255, 255, 255
 Text 0, 30, "Generating grass squares (it might take some more time)..."

 For Z = 0 To GrassGridSize - 1
 For X = 0 To GrassGridSize - 1
 m = CreateMesh()
 EX# = X * GrassGridCellSize#
 EZ# = Z * GrassGridCellSize#
 EH# = TerrainY(Landscape, EX#, 0, EZ#)
 For n3 = 1 To BushesQuantityPerSquare
 Repeat
 DX# = Rnd(-MaxGrassSpreadingRadius#, MaxGrassSpreadingRadius#)
 DZ# = Rnd(-MaxGrassSpreadingRadius#, MaxGrassSpreadingRadius#)
 If Sqr(DX# * DX# + DZ# * DZ#) <= MaxGrassSpreadingRadius# Then
 LX# = DX# * GrassGridCellSize# + EX#
 LZ# = DZ# * GrassGridCellSize# + EZ#
 LH# = TerrainY(Landscape, LX#, 0, LZ#)
 DH# = LH# - EH#

 Height# = LH# / LandscapeHeight#
 If Height# > BushesThreshold# Then
 Quantity# = 1.0 * (Height# - BushesThreshold#) / (MaxBushesThreshold# - BushesThreshold#)
 If Rnd(1) < Quantity# Then
 m2 = CopyMesh(BushModel(Rand(0, BushTypesQuantity - 1), Rand(0, BushModelsQuantity - 1)))
 SXZ# = Rnd(BushModelScaleMin#, BushModelScaleMax#)
 SY# = Rnd(BushModelScaleMin#, BushModelScaleMax#)
 DY1# = TerrainY(Landscape, LX# + 1.0, 0, LZ#) - LH#
 DY2# = TerrainY(Landscape, LX#, 0, LZ# + 1.0) - LH#
 AlignToVector m2, -DY1#, 1.0, -DY2#, 2
 RotateMesh m2, 0, Rnd(0,359), 0
 ScaleMesh m2, SXZ#, SY#, SXZ#
 s = GetSurface(m2, 1)
 For n = 0 To CountVertices(s) - 1
 VertexNormal s, n, 0, 1, 0
 Next
 RotateMesh m2, EntityPitch(m2), EntityYaw(m2) , EntityRoll(m2)
 PositionMesh m2, DX# * GrassGridCellSize#, DH#, DZ# * GrassGridCellSize#
 AddMesh m2, m
 FreeEntity m2
 End If
 End If
 Exit
 End If
 Forever
 Next
 BushMap(X, Z) = m
 PositionEntity m, EX#, EH#, EZ#
 EntityFX m, 16
 EntityTexture m, Grass
 HideEntity m
 EntityAlpha m, 0.0
 Next
 Next

 For n1 = 0 To BushTypesQuantity - 1
 For n2 = 0 To BushModelsQuantity - 1
 FreeEntity BushModel(n1, n2)
 Next
 Next
End Function

Function CreateQuad(Surface, X1#, Y1#, X2#, Y2#, XTex#, YTex#, DX# = 0, DY# = 0)
 XTex# = XTex# * BushTextureXTexSize#
 YTex# = YTex# * BushTextureYTexSize#
 v1 = AddVertex(Surface, X1#, 0, Y1#, XTex#, YTex# + BushTextureYTexSize#)
 v2 = AddVertex(Surface, X1# + DX#, 1, Y1# + DY#, XTex#, YTex#)
 v3 = AddVertex(Surface, X2# + DX#, 1, Y2# + DY#, XTex# + BushTextureYTexSize#, YTex#)
 v4 = AddVertex(Surface, X2#, 0, Y2#, XTex# + BushTextureYTexSize#, YTex# + BushTextureYTexSize#)
 AddTriangle Surface, v1, v2, v3
 AddTriangle Surface, v3, v4, v1
End Function

Function TryToAddSquare(X, Z)
 S.ActiveSquare = New ActiveSquare
 S\X = X
 S\Z = Z
 S\JustAdded = True
End Function

Function ExpandSquare(S.ActiveSquare)
 If S\X > 0 Then TryToAddSquare S\X - 1, S\Z
 If S\X < GrassGridSize - 1 Then TryToAddSquare S\X + 1, S\Z
 If S\Z > 0 Then TryToAddSquare S\X, S\Z - 1
 If S\Z < GrassGridSize - 1 Then TryToAddSquare S\X, S\Z + 1
End Function

Function CountNeighbors(S.ActiveSquare, NeighborType)
 If S\X > 0 Then If (ServiceMap(S\X - 1, S\Z) And Visibility) = NeighborType Then SquaresQuantity = SquaresQuantity + 1
 If S\X < GrassGridSize - 1 Then If (ServiceMap(S\X + 1, S\Z) And Visibility) = NeighborType Then SquaresQuantity = SquaresQuantity + 1
 If S\Z > 0 Then If (ServiceMap(S\X, S\Z - 1) And Visibility) = NeighborType Then SquaresQuantity = SquaresQuantity + 1
 If S\Z < GrassGridSize - 1 Then If (ServiceMap(S\X, S\Z + 1) And Visibility) = NeighborType Then SquaresQuantity = SquaresQuantity + 1
 Return SquaresQuantity
End Function