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 0

        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