ISO simple ASCII procedural terrain

[xra7en]

I tried this for a few years, but I just cannot grasp the concept of "noise" "Parlin noise" or at least how to implement it in qb64.
Everything I try comes out too random.

looking for something as simple as this.
https://i.imgur.com/NunOIhN.png

do not need anything more 7 tilesets

so if anyone has a starter sample, or a link that explains how this is done (in english LOL) - found lots of resources for 3d like Minecraft etc.. but 2d ascii does not seem to exist.
thansk

[bplus]

When I think of 2D landscape I think of this:

Code: QB64: [Select]

1. _Title "Drawlandscape Demo" ' b+ 2021-11-08
2. Const Xmax = 800, Ymax = 600
3. Screen _NewImage(Xmax, Ymax, 32)
4. _ScreenMove 200, 50
5. Do
6.     drawLandscape
7.     _Limit .5
8. Loop Until _KeyDown(27)
9.  
10. Sub drawLandscape
11.     'needs midInk, irnd
12.  
13.     Dim i As Long, startH As Single, rr As Long, gg As Long, bb As Long
14.     Dim mountain As Long, Xright As Single, y As Single, upDown As Single, range As Single
15.     Dim lastx As Single, X As Long
16.     'the sky
17.     For i = 0 To Ymax
18.         midInk 0, 0, 128, 128, 128, 200, i / Ymax
19.         Line (0, i)-(Xmax, i)
20.     Next
21.     'the land
22.     startH = Ymax - 200
23.     rr = 70: gg = 70: bb = 90
24.     For mountain = 1 To 6
25.         Xright = 0
26.         y = startH
27.         While Xright < Xmax
28.             ' upDown = local up / down over range, change along Y
29.             ' range = how far up / down, along X
30.             upDown = (Rnd * .8 - .35) * (mountain * .5)
31.             range = Xright + irnd&(15, 25) * 2.5 / mountain
32.             lastx = Xright - 1
33.             For X = Xright To range
34.                 y = y + upDown
35.                 Color _RGB(rr, gg, bb)
36.                 Line (lastx, y)-(X, Ymax), , BF 'just lines weren't filling right
37.                 lastx = X
38.             Next
39.             Xright = range
40.         Wend
41.         rr = irnd&(rr - 15, rr): gg = irnd&(gg - 15, gg): bb = irnd&(bb - 25, bb)
42.         If rr < 0 Then rr = 0
43.         If gg < 0 Then gg = 0
44.         If bb < 0 Then bb = 0
45.         startH = startH + irnd&(5, 20)
46.     Next
47. End Sub
48.  
49. Function irnd& (n1, n2) 'return an integer between 2 numbers
50.     Dim l%, h%
51.     If n1 > n2 Then l% = n2: h% = n1 Else l% = n1: h% = n2
52.     irnd& = Int(Rnd * (h% - l% + 1)) + l%
53. End Function
54.  
55. Sub midInk (r1%, g1%, b1%, r2%, g2%, b2%, fr##)
56.     Color _RGB32(r1% + (r2% - r1%) * fr##, g1% + (g2% - g1%) * fr##, b1% + (b2% - b1%) * fr##)
57. End Sub
58.  
59.  

Then I thought of this:

Code: QB64: [Select]

1. _Title "Drawlandscape Parallax test" 'started 2019-03-27
2. 'test if can get end of landscape level to start for big looping background
3. '2019-03-27 a more gentle adjustment back to Mountain starting height for
4. 'more seamless connect of back end to front
5. '2019-03-27 start this file with parallax drawing test
6.  
7.  
8. Randomize Timer
9. Screen _NewImage(800, 600, 32)
10. _ScreenMove 100, 20
11. Type parallaxType
12.     handle As Long
13.     rate As Single 'number of pixels per frame added to le (leading edge)
14.     le As Single
15. End Type
16. Dim Shared nLevels As Integer
17. nLevels = 6
18. Dim Shared para(1 To nLevels) As parallaxType
19.  
20. Dim Shared scape&
21. LoadLandscape
22. scapeWidth = _Width(para(1).handle)
23. scapeHeight = _Height(para(1).handle)
24.  
25. While t < 6000
26.     Cls
27.     For i = 1 To nLevels
28.         If para(i).le + 800 > scapeWidth Then
29.             te = scapeWidth - para(i).le
30.             _PutImage (0, 0)-(te, scapeHeight), para(i).handle, 0, (scapeWidth - te, 0)-(scapeWidth, scapeHeight)
31.             _PutImage (te, 0)-(800, scapeHeight), para(i).handle, 0, (0, 0)-(800 - te, scapeHeight)
32.  
33.         Else
34.             _PutImage (0, 0)-(800, scapeHeight), para(i).handle, 0, (para(i).le, 0)-(para(i).le + 800, scapeHeight)
35.         End If
36.  
37.         para(i).le = para(i).le - para(i).rate
38.         If para(i).le < 0 Then para(i).le = scapeWidth
39.     Next
40.     t = t + 1
41.     _Display
42.     _Limit 120
43. Wend
44.  
45. Sub LoadLandscape
46.     cur& = _Dest
47.     xmax = 800 * 3.25: ymax = 600
48.     hdl& = 1
49.     para(hdl&).handle = _NewImage(xmax, ymax, 32)
50.     _Dest para(hdl&).handle
51.  
52.     For i = 0 To ymax
53.         midInk 0, 0, 128, 128, 128, 200, i / ymax
54.         Line (0, i)-(xmax, i)
55.     Next
56.     'the land
57.     startH = ymax - 200
58.     rr = 70: gg = 70: bb = 90
59.     For mountain = 1 To nLevels
60.         If mountain > 1 Then
61.             para(mountain).handle = _NewImage(xmax, ymax, 32)
62.             _Dest para(mountain).handle
63.         End If
64.         Xright = 0
65.         y = startH
66.         Color _RGB(rr, gg, bb)
67.         While Xright < xmax - 50
68.             ' upDown = local up / down over range, change along Y
69.             ' range = how far up / down, along X
70.             upDown = (Rnd * .8 - .4) * (mountain * .5)
71.             range = Xright + rand%(15, 25) * 2.5 / mountain
72.             If range > xmax - 50 Then range = xmax - 50
73.             lastx = Xright - 1
74.             For x = Xright To range 'need less flat tops
75.                 test = y + upDown
76.                 test2 = y - upDown
77.                 If Abs(test - startH) < .13 * startH Then y = test Else y = test2: upDown = -upDown
78.                 Line (lastx, y)-(x, ymax), , BF 'just lines weren't filling right
79.                 lastx = x
80.             Next
81.             Xright = range
82.         Wend
83.         x = lastx + 1
84.         dy = (startH - y) / 50 'more gentle adjustment back to start of screen
85.         While x <= xmax
86.             y = y + dy
87.             Line (lastx, y)-(x, ymax), , BF 'just lines weren't filling right
88.             lastx = x
89.             x = x + 1
90.         Wend
91.         rr = rand%(rr - 15, rr): gg = rand%(gg - 15, gg): bb = rand%(bb - 25, bb)
92.         If rr < 0 Then rr = 0
93.         If gg < 0 Then gg = 0
94.         If bb < 0 Then bb = 0
95.         startH = startH + mountain * rand%(2, 10)
96.         para(mountain).le = xmax - 800
97.         para(mountain).rate = mountain * .5
98.     Next
99.     _Dest cur&
100. End Sub
101.  
102. Function rand% (lo%, hi%)
103.     rand% = Int(Rnd * (hi% - lo% + 1)) + lo%
104. End Function
105.  
106. Sub midInk (r1%, g1%, b1%, r2%, g2%, b2%, fr##)
107.     Color _RGB(r1% + (r2% - r1%) * fr##, g1% + (g2% - g1%) * fr##, b1% + (b2% - b1%) * fr##)
108. End Sub
109.  
110.  

Sure that could be reduced to ASCII?

[xra7en]

Love those
what I am trying to do (as in the image) is do a top down ascii style -
think dwarf fortress, but not that elaborate - just 5 or 6 tiles - I think DF has like 100 tiles LOL

[xra7en]

So I put this request up in 2012 in a game dev site, did not get many responses. I thought it was strange that a ascii top down terrain gen would be difficult (so at least I am not the only one LOL)
Many of the responses were like this - 3D models that were not land types.

So I'll take another stab at what I can do, post it here and see if someone can improve on it.

Team work

[bplus]

@xra7en would you have images you would like converted, photos of something?

[johnno56]

... like an ASCII rpg?

ASCII. Old school. But cool.

[xra7en]

@xra7en would you have images you would like converted, photos of something?

O I've done that before - looks cool, but what I want is a procedurally generated one.

The first style I used to do for small games - and it served its purpose

Code: QB64: [Select]

1. Dim tile(5) As String
2. tile(1) = "T"
3. tile(2) = "."
4. tile(3) = "="
5. tile(4) = "~"
6. tile(5) = " "
7.  
8.  
9. For i = 1 To 10
10.     For j = 1 To 10
11.         Print " "; tile(Int(Rnd * 5) + 1); " ";
12.     Next
13.     Print
14. Next

but as I started looking at modern indi games, their land "made sense"  - like Minecraft, everything worked. This is too random, no clumping of areas

[xra7en]

... like an ASCII rpg?

ASCII. Old school. But cool.

yup, have a simple one in mind, but want to have a large map that displays only a small portion where the player is at live.

easy to make, just obsessing over the random generator

[bplus]

I think you could paint a map with a mouse, click an ascii on one screen maybe pick a color too then on the map screen paint it with a mouse, mouse down paints until mouse up.

[bplus]

Code: QB64: [Select]

1. Dim tile(9) As String
2. tile(0) = " "
3. tile(1) = "T"
4. tile(2) = "."
5. tile(3) = "="
6. tile(4) = "~"
7. tile(5) = "b"
8. tile(6) = "+"
9. tile(7) = "M"
10. tile(8) = Chr$(1)
11. tile(9) = Chr$(3)
12.  
13. Do
14.     k$ = InKey$
15.     If k$ <> "" Then
16.         If Asc(k$) >= 48 And Asc(k$) <= 57 Then kp = Asc(k$) - 48
17.         Locate 1, 1: Print tile(kp);
18.     End If
19.     While _MouseInput: Wend
20.     mx = _MouseX: my = _MouseY: mb1 = _MouseButton(1)
21.     If my < 25 Then 'dang scrolling
22.         If mb1 Then Locate my, mx: Print tile(kp);
23.     End If
24. Loop Until _KeyDown(27)
25.  

  [ You are not allowed to view this attachment ]  

[xra7en]

very clever!! lol
At first look I was like WOW, smaller script than mine, then I saw the inkey$.
but the END RESULT is what i am looking for as procedural

working on one right now - I think I am on to something :-)
I'll post it here later.

[bplus]

I have added code to save to file with s keypress: (Had to start a Project Folder to save maps.)

Code: QB64: [Select]

1. Dim tile(9) As String
2. tile(0) = " "
3. tile(1) = "T"
4. tile(2) = "."
5. tile(3) = "="
6. tile(4) = "~"
7. tile(5) = "b"
8. tile(6) = "+"
9. tile(7) = "M"
10. tile(8) = Chr$(1)
11. tile(9) = Chr$(3)
12.  
13. Do
14.     k$ = InKey$
15.     If k$ <> "" Then
16.         If Asc(k$) >= 48 And Asc(k$) <= 57 Then
17.             kp = Asc(k$) - 48: Locate 1, 1: Print tile(kp);
18.         ElseIf k$ = "s" Then 'save pic
19.             Open "Save Map.txt" For Output As #1
20.             For y = 1 To 25
21.                 b$ = ""
22.                 For x = 1 To 80
23.                     b$ = b$ + Chr$(Screen(y, x))
24.                 Next
25.                 Print #1, b$
26.             Next
27.             Close #1
28.         End If
29.     End If
30.     While _MouseInput: Wend
31.     mx = _MouseX: my = _MouseY: mb1 = _MouseButton(1)
32.     If my < 25 Then 'dang scrolling
33.         If mb1 Then Locate my, mx: Print tile(kp);
34.     End If
35. Loop Until _KeyDown(27)
36.  

Here is sample of map (Save Map.txt) :

Code: QB64: [Select]

1. +                                                                              
2.                                                                                
3.                                                              +++++              
4.                                                             +++++++            
5.                            bbbbb                            ++++++              
6.                         b bb  bbbbbbbbbbbbbbb                ++ ++              
7.                         bbbbbbb            bbb      ++++++++++++++++++++++      
8.                           bbbbbbb          bbbb    ++++++++++++++++++++++++    
9.                           b bbb             bbbb    +++++++++++++++++++++      
10.                           b bb              bbbb             ++++              
11.                           b bb              bb              +++++++            
12.                           b bb            bbb               +++++++            
13.                           bbb          bbbb                   +++              
14.                           bbb          bbbbbbbb                                
15.                           bb              bbbbbbbb                              
16.                           bbb               bbbb b                              
17.                           bbb                b bbb                              
18.                           bbb              bbbbb                                
19.                        bbbbbbbbbbbbbbbbbbbbbbb                                  
20.                        bbbbbbbbbbbbbbbbbbbbbb                                  
21.                           b   bbbbbbbbbbbbb                                    
22.                              bb                                                
23.                                                                                
24.                                                                                
25.                                                                              
26.  

If you like it, save it under a new name otherwise it will just be written over with next drawing.

[xra7en]

ok try this-
closer to what im shooting for

yes yes yes. redundant code (easy to clean up later)

currently just using squares.. but may change this to diamonds mix

Code: QB64: [Select]

1. Randomize (-Timer)
2.  
3. Dim tile(5) As String
4. Dim area(75, 20) As Integer
5.  
6. tile(1) = "T"
7. tile(2) = "."
8. tile(3) = "="
9. tile(4) = "~"
10. tile(5) = " "
11.  
12. '// Clear the map
13. For i = 1 To 75: For j = 1 To 20: area(i, j) = 0: Next: Next
14.  
15. '// lets try some random squares
16. For i = 1 To 30 ' <-- bigger number more dense
17.     x = r(72)
18.     y = r(18)
19.     For k = y - 1 To y + 1
20.         For j = x - 5 To x + 5
21.             If j > 0 And j < 76 And k > 0 And k < 21 Then
22.                 area(j, k) = 1
23.             End If
24.  
25.         Next
26.     Next
27. Next
28.  
29. For i = 1 To 15 ' <-- bigger number more dense
30.     x = r(72)
31.     y = r(18)
32.     For k = y - 1 To y + 1
33.         For j = x - 5 To x + 5
34.             If j > 0 And j < 76 And k > 0 And k < 21 Then
35.                 area(j, k) = 2
36.             End If
37.  
38.         Next
39.     Next
40. Next
41.  
42. For i = 1 To 7 ' <-- bigger number more dense
43.     x = r(72)
44.     y = r(18)
45.     For k = y - 1 To y + 1
46.         For j = x - 5 To x + 5
47.             If j > 0 And j < 76 And k > 0 And k < 21 Then
48.                 area(j, k) = 3
49.             End If
50.  
51.         Next
52.     Next
53. Next
54.  
55. For i = 1 To 7 ' <-- bigger number more dense
56.     x = r(72)
57.     y = r(18)
58.     For k = y - 1 To y + 1
59.         For j = x - 5 To x + 5
60.             If j > 0 And j < 76 And k > 0 And k < 21 Then
61.                 area(j, k) = 4
62.             End If
63.  
64.         Next
65.     Next
66. Next
67.  
68.  
69.  
70.  
71.  
72. Cls
73.  
74.  
75. For j = 1 To 20
76.     For i = 1 To 75
77.  
78.         Select Case area(i, j)
79.             Case 0: Print " ";
80.             Case 1: Print "T";
81.             Case 2: Print "#";
82.             Case 3: Print ".";
83.             Case 4: Print ".";
84.  
85.         End Select
86.     Next
87.  
88.     Print
89. Next
90.  
91.  
92. Function r (num As Integer)
93.     r = Int(Rnd * num) + 1
94. End Function
95.  

[bplus]

When you are ready to alter the look of the characters, I have a Character Editor.

[xra7en]

When you are ready to alter the look of the characters, I have a Character Editor.

thank you.. !!

for simplicity I'll keep it in the extended table for now..

is your editor similar to the DF characters?