Many Mountains Terrain on One Grid

[SierraKen]

ChatGPT is getting better and better. It helped me break down my 4 section grid one from my other thread and just make 1 section but with many mountains. This one is also a lot easier to learn by. Press the Space Bar for more random designs. 

Code: (Select All)

_Title "Many Mountains - by SierraKen and ChatGPT - Press Space Bar For More - Esc to quit"

Cls

Screen _NewImage(800, 600, 32)

Do

    ' === Initialize arrays for mountains and indentations ===

    Dim XA(20), YA(20), ZA(20) ' Mountains

    Dim XB(20), YB(20), ZB(20) ' Indentations



    ' === Generate 20 indentions ===

    For I = 0 To 19

        XA(I) = Rnd * 80

        YA(I) = Rnd * 40

        ZA(I) = Rnd * 20 + 10 ' height

    Next



    ' === Generate 20 mountains ===

    For I = 0 To 19

        XB(I) = Rnd * 80

        YB(I) = Rnd * 40

        ZB(I) = Rnd * -20 - 10 ' depth (negative)

    Next



    ' === Draw grid lines horizontally ===

    For Y = 0 To 40

        For X = 0 To 80

            T = X

            GoSub calculations

        Next

    Next



    ' === Draw grid lines vertically ===

    For X = 0 To 80

        For Y = 0 To 40

            T = Y

            GoSub calculations

        Next

    Next



    Do

        a$ = InKey$

        If a$ = Chr$(27) Then End

    Loop Until a$ = " "

    Cls

Loop

End



calculations:

XNEW = X * 20 + 10 * Y - 300 ' Perspective X



' === Calculate cumulative height adjustment ===

ZTotal = 0



' Indentions

For I = 0 To 19

    L = Sqr((XA(I) - X) ^ 2 + (YA(I) - Y) ^ 2) + 1

    ZTotal = ZTotal + ZA(I) / L

Next



' Mountains

For I = 0 To 19

    L2 = Sqr((XB(I) - X) ^ 2 + (YB(I) - Y) ^ 2) + 1

    ZTotal = ZTotal + ZB(I) / L2

Next



YNEW = 200 - Y * 5 - 10 * ZTotal + 300 ' Perspective Y



If T > 0 Then Line (XOLD, YOLD)-(XNEW, YNEW), _RGB32(0, 255, 0)

XOLD = XNEW: YOLD = YNEW

Return

[SierraKen]

Here is a better version, with the grid layed out better and mountains. 

Code: (Select All)

_Title "Many Mountains - by SierraKen and ChatGPT - Press Space Bar For More - Esc to quit"

Cls

Screen _NewImage(800, 600, 32)

Dim XA(40), YA(40), ZA(40) ' Mountains

Dim XB(40), YB(40), ZB(40) ' Indentations



Do

    a = Int(Rnd * 37) + 3

    ' === Initialize arrays for mountains and indentations ===



    ' === Generate 20 indentions ===

    For I = 0 To a - 1

        XA(I) = Rnd * 80

        YA(I) = Rnd * 100

        ZA(I) = Rnd * 20 + 10 ' height

    Next



    ' === Generate 20 mountains ===

    For I = 0 To a - 1

        XB(I) = Rnd * 80

        YB(I) = Rnd * 100

        ZB(I) = Rnd * -20 - 10 ' depth (negative)

    Next



    ' === Draw grid lines horizontally ===

    For Y = 0 To 100

        For X = 0 To 200

            T = X

            GoSub calculations

        Next

    Next



    ' === Draw grid lines vertically ===

    For X = 0 To 200

        For Y = 0 To 100

            T = Y

            GoSub calculations

        Next

    Next



    Do

        a$ = InKey$

        If a$ = Chr$(27) Then End

    Loop Until a$ = " "

    Cls

Loop

End



calculations:

XNEW = X * 20 + 10 * Y - 600 ' Perspective X



' === Calculate cumulative height adjustment ===

ZTotal = 0



' Mountains

For I = 0 To a - 1

    L = Sqr((XA(I) - X) ^ 2 + (YA(I) - Y) ^ 2) + 1

    ZTotal = ZTotal + ZA(I) / (L ^ 1.5)

Next



' Indentations

For I = 0 To a - 1

    L2 = Sqr((XB(I) - X) ^ 2 + (YB(I) - Y) ^ 2) + 1

    ZTotal = ZTotal + ZB(I) / L2

Next



YNEW = 200 - (Y * 5 - 10 * ZTotal) + 600 ' Perspective Y



If T > 0 Then Line (XOLD, YOLD)-(XNEW, YNEW), _RGB32(0, 255, 0)

XOLD = XNEW: YOLD = YNEW

Return

[SierraKen]

OK, I think I outdone myself with ChatGPT LOL... Using it, and also experimenting on my own (it kept the grid, I filled it in on accident). I created this. Now it makes completely random forests. I also added a Save Picture selection to save it as a JPG.  

Code: (Select All)

_Title "Random Forest Generator - by SierraKen and ChatGPT - Press S To Save To File, Space Bar For More - Esc to quit"

Cls

Screen _NewImage(800, 600, 32)



Dim XA(40), YA(40), ZA(40) ' Indentions

Dim XB(40), YB(40), ZB(40) ' Mountains

Dim img As Long

Dim col(40)



Do

    Cls

    bl = 255

    For by = 0 To 600

        bl = bl - .5

        Line (0, by)-(800, by), _RGB32(0, 0, bl)

    Next by



    a = Int(Rnd * 37) + 3



    ' === Generate indentations ===

    For i = 0 To a - 1

        XA(i) = Rnd * 80

        YA(i) = Rnd * 100

        ZA(i) = Rnd * (20 + 10) * .2

    Next



    ' === Generate mountains ===

    For i = 0 To a - 1

        XB(i) = Rnd * 80

        YB(i) = Rnd * 100

        ZB(i) = Rnd * (-15 - 7.5)

    Next



    ' === Draw grid horizontally ===

    For Y = 0 To 100

        XOLD = -9999: YOLD = -9999

        For X = 0 To 200

            T = X

            GoSub calculations

        Next

    Next



    ' === Draw grid vertically ===

    For X = 0 To 200

        XOLD = -9999: YOLD = -9999

        For Y = 0 To 100

            T = Y

            GoSub calculations

        Next

    Next



    ' === Wait for key ===

    Do

        a$ = InKey$

        If a$ = Chr$(27) Then End



        If a$ = "s" Or a$ = "S" Then

            title$ = "Save picture as..."

            result$ = _SaveFileDialog$(title$, "", "*.jpg", "Picture Files (.jpg)")

            If result$ <> "" Then

                img = _CopyImage(0)

                _SaveImage result$, img

                _MessageBox "Picture Saved", "Picture saved as: " + result$

                _FreeImage img

            End If

        End If

    Loop Until a$ = " "



Loop

End



' === Terrain drawing calculations ===

calculations:

XNEW = X * 20 + 10 * Y - 1000 ' Perspective X

ZTotal = 0



' --- Add indentations

For i = 0 To a - 1

    L = Sqr((XA(i) - X) ^ 2 + (YA(i) - Y) ^ 2) + 1

    ZTotal = ZTotal + ZA(i) / (L ^ 1.5)

Next



' --- Add mountains

For i = 0 To a - 1 Step .5

    col(i) = XB(i) * 5

    L2 = Sqr((XB(i) - X) ^ 2 + (YB(i) - Y) ^ 2) + 1

    ZTotal = ZTotal + ZB(i) / L2

    ' --- Clamp ZTotal for stability

    If ZTotal > 100 Then ZTotal = 100

    If ZTotal < -100 Then ZTotal = -100



    YNEW = 200 - (Y * 5 - 10 * ZTotal) + 700 ' Perspective Y



    ' === Atmospheric Fog

    fogDepth = (Y / 100) ^ 1.5

    If fogDepth > 1 Then fogDepth = 1



    ' Forest base color

    If col(0) < 20 Then col(0) = 20

    r = col(0) / 3

    g = col(0)

    b = col(0) / 4



    ' Fog color (black)

    fogR = 0: fogG = 0: fogB = 0



    ' Blend terrain color with fog

    r = r * (1 - fogDepth) + fogR * fogDepth

    g = g * (1 - fogDepth) + fogG * fogDepth

    b = b * (1 - fogDepth) + fogB * fogDepth



    ' === Draw line if valid

    If XOLD > -9999 Then

        Line (XOLD, YOLD)-(XNEW, YNEW), _RGB32(r, g, b)

    End If



Next





XOLD = XNEW: YOLD = YNEW

Return

---

Here is another picture it made...

[SierraKen]

My first 2 postings had the wrong areas for the labels "indentions" and "mountains", they were actually swapped. So if you want the first 2 posts again, I edited them above.

[DANILIN]

2021: Relief 3d multivariate parametric
https://qb64forum.alephc.xyz/index.php?topic=4398

https://boxgaming.github.io/qbjs-samples...or=DANILIN

Run Online
https://boxgaming.github.io/qbjs-samples...ief-3d.bas

School themes from USSR
https://qb64phoenix.com/forum/showthread.php?tid=310

Hitherto no cultures of start of program online on page as in topic

New QBJS Samples Site
https://qb64phoenix.com/forum/showthread...4#pid31254

Code: (Select All)

[qbjs]https://qbjs.org/?mode=auto&src=https://qb64phoenix.com/forum/attachment.php?aid=4620[/qbjs]