Grass on a landscape (lite version)


Tweet blitz3d code-archives miscellaneous
(Posted 4 months ago) RonTek

Grass rendering algorhytm by Matt Merkulov. Only most effective method - pre-generating of grass surfaces.

Author: Matt Merkulov

Image

;Grass rendering algorhytm by Matt Merkulov

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

Reply To Topic (minimum 10 characters)

Please log in to reply