+- QB64 Phoenix Edition (https://qb64phoenix.com/forum)
+-- Forum: QB64 Rising (https://qb64phoenix.com/forum/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://qb64phoenix.com/forum/forumdisplay.php?fid=3)
+---- Forum: Programs (https://qb64phoenix.com/forum/forumdisplay.php?fid=7)
+---- Thread: Many Mountains Terrain on One Grid (/showthread.php?tid=3827)
Many Mountains Terrain on One Grid - SierraKen - 07-19-2025
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.
![[Image: Many-Mountains-Grid-by-Sierra-Ken-and-Chat-GPT.png]](https://i.ibb.co/S7yCQ4H1/Many-Mountains-Grid-by-Sierra-Ken-and-Chat-GPT.png)
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
RE: Many Mountains Terrain on One Grid - SierraKen - 07-20-2025
Here is a better version, with the grid layed out better and mountains.
![[Image: Many-Mountains-2-Grid-by-Sierra-Ken-and-Chat-GPT.png]](https://i.ibb.co/B76GXGm/Many-Mountains-2-Grid-by-Sierra-Ken-and-Chat-GPT.png)
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
RE: Many Mountains Terrain on One Grid - SierraKen - 07-21-2025
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.
![[Image: Forest-4.jpg]](https://i.ibb.co/6zFRsjw/Forest-4.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...
RE: Many Mountains Terrain on One Grid - SierraKen - 07-21-2025
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.
RE: Many Mountains Terrain on One Grid - DANILIN - 07-30-2025
2021: Relief 3d multivariate parametric
https://qb64forum.alephc.xyz/index.php?topic=4398
https://boxgaming.github.io/qbjs-samples/#author=DANILIN
Run Online
https://boxgaming.github.io/qbjs-samples/#src=relief-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.php?tid=3170&pid=31254#pid31254
Code: (Select All)
[qbjs]https://qbjs.org/?mode=auto&src=https://qb64phoenix.com/forum/attachment.php?aid=4620[/qbjs]