ISO simple ASCII procedural terrain

[bplus]

Don't know what DF characters are?

Char Editor is for 8 X16 Font and I was modifying for 8x8 font I think.

[bplus]

Code: QB64: [Select]

1. _Title "8X16 ASCII Character Editor"
2. 'started 2018-08-27 by bplus
3. 'QB64 X 64 version 1.2 20180228/86  from git b301f92
4. ' 2020-09-18 modified to coexist with the 8X8 Character Editor in the same Folder
5.  
6. '========================== Instructions: =================================
7. '
8. ' Arrow keys move the highlighter around, spacebar toggles tile on/off
9. ' or just click with mouse to do the same.
10.  
11. ' Click buttons to either
12. ' 1. Enter an ascii by number to edit.
13. ' 2. Enter a character by pressing the key(s) from which the ascii number is taken.
14. ' 3. Save a modified character.
15. ' 4. Save all edits made to file called "Character Set.DAT".
16. ' Note: If want to work with more sets, just rename Character Set.DAT
17. '       If that file isn't found, this app will start from scratch.
18. '
19. '==========================================================================
20. Const cFile$ = "8X16 Character Set.DAT"
21. Const CW = 8
22. Const CH = 16
23. Const SQ = 25
24. Const XOFF = 60
25. Const YOFF = 80
26. Const WW = 800
27. Const WH = 600
28. Screen _NewImage(WW, WH, 32)
29. _ScreenMove (1280 - WW) / 2 + 30, (760 - WH) / 2
30. Dim Shared AN%, CX, CY, BLK As _Unsigned Long, WHT As _Unsigned Long, SAVED
31. Dim Shared MAP(CW + 2, CH + 2) As String * 1
32. Dim Shared CS(256) As String * 128
33. WHT = _RGB32(255, 255, 255)
34. BLK = _RGB32(0, 0, 0)
35.  
36. '==============================   main
37.  
38. 'see if there is a file in the works to load else start from scratch
39. If _FileExists(cFile$) Then
40.     Open cFile$ For Input As #1
41.     For i = 1 To 256
42.         Input #1, CS(i - 1)
43.     Next
44.     Close #1
45.     SAVED = -1
46. Else
47.     For a = 0 To 255
48.         Cls
49.         _PrintString (0, 0), Chr$(a)
50.         b$ = ""
51.         For y = 0 To CH - 1
52.             For x = 0 To CW - 1
53.                 If Point(x, y) <> BLK Then b$ = b$ + "1" Else b$ = b$ + "0"
54.             Next
55.         Next
56.         CS(a) = b$
57.     Next
58.     SAVED = 0
59. End If
60.  
61. For i = 1 To 128
62.     Print Mid$(CS(1), i, 1);
63.     If i Mod CW = 0 Then Print
64. Next
65. 'END
66. 'sample B for starters
67. AN% = 66
68. load AN%
69. CX = 1: CY = 1
70. Do
71.     While _MouseInput: Wend
72.     If _MouseButton(1) Then
73.         mx = _MouseX
74.         my = _MouseY
75.         _Delay .2
76.         'ascii #  to edit
77.         If mx > 500 And mx < 700 And my > 50 And my < 100 Then
78.             Color WHT, 0
79.             Line (500, 50)-(700, 100), BLK, BF
80.             Locate 5, 67: Input "Ascii # "; a%
81.             If a% >= 0 And a% <= 255 Then AN% = a%: load AN%
82.         End If
83.         'chr$  to edit
84.         If mx > 500 And mx < 700 And my > 110 And my < 160 Then
85.             Color WHT, 0
86.             Line (500, 110)-(700, 160), BLK, BF
87.             Locate 9, 67: Input "Enter Chr$ "; char$
88.             a% = Asc(char$)
89.             If a% >= 0 And a% <= 255 Then AN% = a%: load AN%
90.         End If
91.         'save character edit
92.         If mx > 500 And mx < 700 And my > 170 And my < 220 Then
93.             b$ = ""
94.             For y = 1 To CH
95.                 For x = 1 To CW
96.                     b$ = b$ + MAP(x, y)
97.                 Next
98.             Next
99.             CS(AN%) = b$
100.             Color WHT, 0
101.             Line (500, 170)-(700, 220), BLK, BF
102.             Locate 13, 67: Print " Character recorded. "
103.             SAVED = 0
104.             _Display
105.             _Delay 1.5
106.         End If
107.         'file character set
108.         If mx > 500 And mx < 700 And my > 230 And my < 280 Then
109.             Color WHT, 0
110.             Line (500, 230)-(700, 280), BLK, BF
111.             Open cFile$ For Output As #1
112.             For a = 0 To 255
113.                 Print #1, CS(a)
114.             Next
115.             Close #1
116.             Locate 16, 65: Print cFile$
117.             Locate 17, 71: Print "File Saved"
118.             SAVED = -1
119.             _Display
120.             _Delay 1.5
121.         End If
122.  
123.         'mouse over edit box, toggle tiles and update cursor
124.         tx = (mx - XOFF) \ SQ: ty = (my - YOFF) \ SQ
125.         If tx >= 1 And tx <= CW And ty >= 1 And ty <= CH Then
126.             CX = tx: CY = ty
127.             If MAP(CX, CY) = "1" Then MAP(CX, CY) = "0" Else MAP(CX, CY) = "1"
128.         End If
129.     End If
130.     KH& = _KeyHit
131.     Select Case KH&
132.         Case 32 'space bar
133.             If MAP(CX, CY) = "1" Then MAP(CX, CY) = "0" Else MAP(CX, CY) = "1"
134.         Case 18432 'up
135.             If CY - 1 >= 1 Then CY = CY - 1
136.         Case 20480 'down
137.             If CY + 1 <= CH Then CY = CY + 1
138.         Case 19200 'left
139.             If CX - 1 >= 1 Then CX = CX - 1
140.         Case 19712 'right
141.             If CX + 1 <= CW Then CX = CX + 1
142.     End Select
143.  
144.     If _KeyDown(27) Then End
145.     update
146.     _Display
147.     _Limit 60
148. Loop
149.  
150. Sub load (asci)
151.     For i = 1 To 128
152.         y = i \ CW + 1
153.         x = i Mod CW: If x = 0 Then x = 8: y = y - 1
154.         MAP(x, y) = Mid$(CS(asci), i, 1)
155.     Next
156. End Sub
157.  
158. Sub update
159.     Color WHT, _RGB32(100, 110, 100): Cls
160.     drwBtn 500, 50, "Load map with Ascii"
161.     drwBtn 500, 110, "Load map with Chr$"
162.     drwBtn 500, 170, "Save Character Edit"
163.     drwBtn 500, 230, "File Character Set"
164.     Color _RGB32(250, 225, 255), _RGB32(100, 110, 100)
165.     _PrintString (398, 400), "Current Ascii% =" + Str$(AN%) + " or CHR$(" + LTrim$(Str$(AN%)) + ") = " + Chr$(AN%)
166.     If SAVED Then s$ = " Saved." Else s$ = " not Saved yet."
167.     _PrintString (398, 440), "File: " + cFile$ + s$
168.     Line (XOFF - 1, YOFF - 1)-Step((CW + 2) * SQ + 2, (CH + 2) * SQ + 2), _RGB32(255, 255, 0), B
169.     Line (XOFF + 1, YOFF + 1)-Step((CW + 2) * SQ, (CH + 2) * SQ), BLK, B
170.     Line (XOFF, YOFF)-Step((CW + 2) * SQ, (CH + 2) * SQ), _RGB32(255, 80, 0), BF
171.     For y = 1 To CH
172.         For x = 1 To CW
173.             If MAP(x, y) = "1" Then c& = _RGB32(200, 200, 200) Else c& = _RGB32(0, 0, 0)
174.             Line ((x) * SQ + XOFF, (y) * SQ + YOFF)-Step(SQ - 2, SQ - 2), c&, BF
175.         Next
176.     Next
177.     ' let's see actual size!
178.     Color _RGB32(255, 255, 0), _RGB32(100, 110, 100)
179.     For i = 1 To 4
180.         drwChar XOFF + 16 * (i * 2), .5 * YOFF - (16 * i) / 2, AN%, i
181.     Next
182.     'highlight sqr
183.     Line (CX * SQ - 1 + XOFF, CY * SQ - 1 + YOFF)-Step(SQ, SQ), WHT, B
184.  
185. End Sub
186.  
187. Sub drwBtn (x, y, s$)
188.     th = 16: tw = 8 * Len(s$): gray& = _RGB32(190, 190, 190)
189.     Line (x, y)-Step(200, 50), _RGB32(0, 0, 0), BF
190.     Line (x, y)-Step(197, 47), _RGB32(255, 255, 255), BF
191.     Line (x + 1, y + 1)-Step(197, 47), gray&, BF
192.     Color _RGB32(0, 0, 0), gray&
193.     _PrintString (x + 100 - 4 * Len(s$), y + 17), s$
194. End Sub
195.  
196. Sub drwChar (x0, y0, ascn, size) 'what ever the present color is set at
197.     For y = 0 To CH - 1
198.         For x = 0 To CW - 1
199.             i = i + 1
200.             If Mid$(CS(ascn), i, 1) = "1" Then Line (x0 + x * size, y0 + y * size)-Step(size - 1, size - 1), , BF
201.         Next
202.     Next
203. End Sub
204.  

It will use custom charaacter set in this file: "8X16 Character Set.DAT"
if it finds it in the folder of the .exe otherwise it will start that file and when you slect save file it will make your character set with custom changes.

If you want several custom sets just change name of file, and change it back to "8X16 Character Set.DAT" to edit that one again.

Of course, you will need some routines for using these characters in you game file. I think I have a test demo somewhere.

Also looks like 8 x 8 editor is done too.
  [ You are not allowed to view this attachment ]  

Wow over 3 years ago!

[xra7en]

Don't know what DF characters are?

Char Editor is for 8 X16 Font and I was modifying for 8x8 font I think.

dwarf fortress (one of the hardest games ever created - even has an O'Reilly book on how to play - Im like seriously - ofc I bought it LOL)
https://i.pinimg.com/originals/96/3d/4f/963d4f5d54e5d0e90ee6d7b23d140bff.jpg
https://www.amazon.com/Getting-Started-Dwarf-Fortress-complex/dp/1449314945

[xra7en]

Yes! I would be interested in that. It is almost like a modern THEDRAW program!
or more precisely TDFONTS program.

[xra7en]

OK end result it actually accpetable. Obviously clean up the code.
will prob add a routine to add a river, maybe one or two lakes. and a range of hardcore mountains!

add color and poof

Code: QB64: [Select]

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

[bplus]

Oh hey, rndRect!

Code: QB64: [Select]

1. _Title "RndRect - zzz... press any, esc to quit"
2. Randomize Timer
3. Do
4.     For i = 1 To 250
5.         rndRect
6.     Next
7.     Sleep
8. Loop Until _KeyDown(27)
9.  
10. Sub rndRect
11.     c$ = Chr$(Int(Rnd * 200) + 32)
12.     x = Int(Rnd * 80) + 1
13.     y = Int(Rnd * 25) + 1
14.     w = Int(Rnd * 30) + 1
15.     h = Int(Rnd * 8) + 1
16.     For row = y To y + h
17.         For col = x To x + w
18.             If row <= 25 And col <= 80 Then
19.                 Locate row, col: Print c$;
20.             End If
21.         Next
22.     Next
23. End Sub
24.  

[bplus]

Colorized version

Code: QB64: [Select]

1. _Title "RndRect - zzz... press any, esc to quit"
2. Randomize Timer
3. Do
4.     For i = 1 To 250
5.         rndRect
6.     Next
7.     Sleep
8. Loop Until _KeyDown(27)
9.  
10. Sub rndRect
11.     c$ = Chr$(Int(Rnd * 200) + 32)
12.     x = Int(Rnd * 80) + 1
13.     y = Int(Rnd * 25) + 1
14.     w = Int(Rnd * 30) + 1
15.     h = Int(Rnd * 8) + 1
16.     Color Int(Rnd * 15) + 1 '  Int(Rnd * 15) + 1
17.     For row = y To y + h
18.         For col = x To x + w
19.             If row <= 25 And col <= 80 Then
20.                 Locate row, col: Print c$;
21.             End If
22.         Next
23.     Next
24. End Sub
25.  

[bplus]

With limited tile() set:

Code: QB64: [Select]

1. _Title "RndRect - zzz... press any, esc to quit"
2.  
3. Dim Shared tile(5) As String
4. tile(1) = "T"
5. tile(2) = "."
6. tile(3) = "="
7. tile(4) = "~"
8. tile(5) = " "
9.  
10. Randomize Timer
11. Do
12.     For i = 1 To 250
13.         rndRect
14.     Next
15.     Sleep
16. Loop Until _KeyDown(27)
17.  
18. Sub rndRect
19.     c$ = tile(Int(Rnd * 5) + 1)
20.     x = Int(Rnd * 80) + 1
21.     y = Int(Rnd * 25) + 1
22.     w = Int(Rnd * 30) + 1
23.     h = Int(Rnd * 8) + 1
24.     'Color Int(Rnd * 15) + 1 '  Int(Rnd * 15) + 1   ' Color or Not ?
25.     For row = y To y + h
26.         For col = x To x + w
27.             If row <= 25 And col <= 80 Then
28.                 Locate row, col: Print c$;
29.             End If
30.         Next
31.     Next
32. End Sub
33.  

[xra7en]

nice - but grouping is off (something I am still struggling with)

trees should be surrounded by bushes, surrounded by maybe grass, and plains, and clearing near body of water.
so far we have random blocks, but not making sense LOL

cept now its late,,, will tackle tomorrow at work (i have my own hours hahhaaha)

[bplus]

Here is Font 8 so I can add round circles:

Code: QB64: [Select]

1. _Title "RndRect - zzz... press any, esc to quit"
2.  
3. Dim Shared tile(5) As String
4. tile(1) = "T"
5. tile(2) = "."
6. tile(3) = "="
7. tile(4) = "~"
8. tile(5) = "#"
9.  
10. Randomize Timer
11. Width 80, 80
12. _Font 8
13. Do
14.     For i = 1 To 50
15.         rndRect
16.     Next
17.     Sleep
18. Loop Until _KeyDown(27)
19.  
20. Sub rndRect
21.     c$ = tile(Int(Rnd * 5) + 1)
22.     x = Int(Rnd * _Width) + 1
23.     y = Int(Rnd * _Height) + 1
24.     w = Int(Rnd * 15) + 1
25.     h = Int(Rnd * 15) + 1
26.     'Color Int(Rnd * 15) + 1 '  Int(Rnd * 15) + 1   ' Color or Not ?
27.  
28.     If Rnd < .5 Then
29.         For row = y To y + h
30.             For col = x To x + w
31.                 If row <= _Height And col <= _Width Then
32.                     Locate row, col: Print c$;
33.                 End If
34.             Next
35.         Next
36.     Else
37.         For row = y - h To y + h
38.             For col = x - h To x + h
39.                 If row >= 1 And row <= _Height Then
40.                     If col > 1 And col <= _Width Then
41.                         If Sqr(((col - x) ^ 2) + (row - y) ^ 2) <= h Then
42.                             Locate row, col: Print c$;
43.                         End If
44.                     End If
45.                 End If
46.             Next
47.         Next
48.  
49.     End If
50. End Sub

Circles look more natural but what we really need is plasma!

[SMcNeill]

Here's my first shot at this:

Code: QB64: [Select]

1. Const XSize = 200, YSize = 200
2. Dim Shared As Long Grid(XSize, YSize)
3.  
4. DisplayScreen = MaxScreen
5. Screen MaxScreen
6. _ScreenMove 0, 0
7.  
8. Randomize Timer
9. $Color:32
10.  
11. Do
12.     InitializeMap
13.     Rivers Int(Rnd * 10) + 1, Int(Rnd * 100) - 100, -3
14.     GenerateTerrain
15.  
16.     DrawMap
17.     Sleep
18. Loop Until _KeyDown(27)
19.  
20. Sub InitializeMap
21.     For x = 0 To XSize
22.         For y = 0 To YSize
23.             Grid(x, y) = -999 'default blank part of map
24.         Next
25.     Next
26. End Sub
27.  
28.  
29. Sub DrawMap
30.     Dim kolor As _Unsigned Long
31.     xscale = _Width / XSize
32.     yscale = _Height / YSize
33.     For x = 0 To XSize
34.         For y = 0 To YSize
35.             Select Case Grid(x, y)
36.                 Case -3: kolor = DarkBlue 'Deep Water
37.                 Case -2: kolor = Blue 'Water
38.                 Case -1: kolor = SkyBlue 'Shallow Water
39.                 Case 0: kolor = Tann 'beach/sand
40.                 Case 1: kolor = Green 'grassland
41.                 Case 2: kolor = DarkGreen 'forest
42.                 Case 3: kolor = Pink 'hills
43.                 Case 4: kolor = Purple 'mountains
44.                 Case 5 TO 99: kolor = Red
45.                 Case Else: kolor = Black
46.             End Select
47.             Line (x * xscale, y * yscale)-Step(xscale, yscale), kolor, BF
48.     Next y, x
49. End Sub
50.  
51.  
52. Sub GenerateTerrain
53.     Height = -3
54.     Do Until finished
55.         finished = -1
56.         For x = 0 To XSize
57.             For y = 0 To YSize
58.                 If Grid(x, y) = Height Then Fill x, y, Height + 1: finished = 0
59.             Next
60.         Next
61.         Height = Height + 1
62.     Loop
63.  
64. End Sub
65.  
66. Sub Fill (x, y, height)
67.     Select Case height
68.         Case Is < 0: RepeatChance = 33 'water repeat
69.         Case Is = 0: RepeatChance = 25 'beach repeat
70.         Case Is = 1: RepeatChance = 55 'grassland
71.         Case Is = 2: RepeatChance = 55 'forest
72.         Case Is = 3: RepeatChance = 40 ' hills
73.         Case Is = 4: RepeatChance = 33 'mountains
74.         Case Else
75.             RepeatChance = 50 - 3 * height
76.             If RepeatChance < 10 Then RepeatChance = 10
77.     End Select
78.     CurrentX = x
79.     If CurrentX > 0 Then
80.         If Grid(CurrentX - 1, y) = -999 Then
81.             Grid(CurrentX - 1, y) = height
82.             If Int(Rnd * 100) < RepeatChance Then Fill CurrentX - 1, y, height
83.         End If
84.     End If
85.     CurrentX = x
86.     If CurrentX < XSize Then
87.         If Grid(CurrentX + 1, y) = -999 Then
88.             Grid(CurrentX + 1, y) = height
89.             If Int(Rnd * 100) < RepeatChance Then Fill CurrentX + 1, y, height
90.         End If
91.     End If
92.     CurrentY = y
93.     If CurrentY > 0 Then
94.         If Grid(x, CurrentY - 1) = -999 Then
95.             Grid(x, CurrentY - 1) = height
96.             If Int(Rnd * 100) < RepeatChance Then Fill x, CurrentY - 1, height
97.         End If
98.     End If
99.     CurrentY = y
100.     If CurrentY < YSize Then
101.         If Grid(x, CurrentY + 1) = -999 Then
102.             Grid(x, y + 1) = height
103.             If Int(Rnd * 100) < RepeatChance Then Fill x, CurrentY + 1, height
104.         End If
105.     End If
106. End Sub
107.  
108. Sub Rivers (Number, Meander, Deep)
109.     For i = 1 To Number
110.         flip1 = Int(Rnd * 2): flip2 = Int(Rnd * 2)
111.         If flip1 Then 'entry point is on top
112.             x1 = Int(Rnd * XSize): y1 = 0
113.         Else 'entry point is on left
114.             x1 = 0: y1 = Int(Rnd * YSize)
115.         End If
116.         If flip2 Then 'exit point is on bottom
117.             x2 = Int(Rnd * XSize): y2 = YSize
118.         Else 'exit point is on right
119.             x2 = XSize: y2 = Int(Rnd * YSize)
120.         End If
121.  
122.         Grid(x1, y1) = Deep: Grid(x2, y2) = Deep
123.         StartX = x1: StartY = y1: EndX = x2: EndY = y2 'just to preserve our original values, if needed.
124.         Do Until StartX = EndX And StartY = EndY
125.             CoinToss = Int(Rnd * 100) 'Coin toss to move left/right or up/down, to go towards exit, or wander a bit.
126.             Meander = 10
127.             If CoinToss Mod 2 Then 'even or odd, so we only walk vertical or hortizontal and not diagional
128.                 If CoinToss < 100 - Meander Then 'Lower values meander less and go directly to the target.
129.                     XChange = Sgn(EndX - StartX) '-1,0,1, drawn always towards the mouse
130.                     Ychange = 0
131.                 Else
132.                     XChange = Int(Rnd * 3) - 1 '-1, 0, or 1, drawn in a random direction to let the lightning wander
133.                     Ychange = 0
134.                 End If
135.             Else
136.                 If CoinToss < 100 - Meander Then 'Lower values meander less and go directly to the target.
137.                     Ychange = Sgn(EndY - StartY)
138.                     XChange = 0
139.                 Else
140.                     Ychange = Int(Rnd * 3) - 1
141.                     XChange = 0
142.                 End If
143.             End If
144.             StartX = StartX + XChange
145.             StartY = StartY + Ychange
146.             If StartX < 0 Then StartX = 0 'Make certain we move inside the bounds of our map dimensions
147.             If StartY < 0 Then StartY = 0
148.             If StartX > XSize Then StartX = XSize
149.             If StartY > YSize Then StartY = YSize
150.             Grid(StartX, StartY) = Deep 'place a river where we moved to
151.         Loop
152.     Next
153. End Sub
154.  
155.  
156.  
157.  
158.  
159. Function MaxScreen
160.     DH = _DesktopHeight: DW = _DesktopWidth
161.     TBH = TaskbarHeight: TBW = TaskbarWidth
162.     TH = TitleBarHeight: BW = BorderWidth
163.     If TBH = DH Then TBH = 0 'Users taskbar is configured vertical, not hortizonal.
164.     If TBW = DW Then TBW = 0
165.     MaxScreen = _NewImage(DW - TBW - 2 * BW, DH - TBH - TH - BW * 2, 32)
166. End Function
167.  
168. Sub ScreenMove (x, y)
169.     Do Until _Width <> 0 And _ScreenExists = -1: Loop
170.     _ScreenMove x - BorderWidth, y - BorderWidth - TitleBarHeight
171. End Sub
172.  
173. Sub ScreenMove_Middle
174.     Do Until _Width <> 0 And _ScreenExists = -1: Loop
175.     _ScreenMove (_DesktopWidth - _Width - BorderWidth) / 2 + 1, (_DesktopHeight - _Height - BorderWidth) / 2 - TitleBarHeight + 1
176. End Sub
177.  
178. Function TaskbarHeight
179.     Do Until _Width <> 0 And _ScreenExists = -1: Loop
180.  
181.     $If WIN Then
182.         $If TASKBARDEC = UNDEFINED Then
183.             $Let TASKBARDEC = TRUE
184.             Declare Library "taskbar"
185.                 Function taskbar_height& ()
186.                 Function taskbar_width& ()
187.             End Declare
188.         $End If
189.         TaskbarHeight = taskbar_height&
190.     $Else
191.         TaskbarHeight = 0 'no function to get the value for Linux/Mac, so return 0 instead of an error
192.     $End If
193. End Function
194.  
195. Function TaskbarWidth
196.     Do Until _Width <> 0 And _ScreenExists = -1: Loop
197.     $If WIN Then
198.         $If TASKBARDEC = UNDEFINED Then
199.             $Let TASKBARDEC = TRUE
200.  
201.             Declare Library "taskbar"
202.             Function taskbar_height& ()
203.             Function taskbar_width& ()
204.             End Declare
205.         $End If
206.         TaskbarWidth = taskbar_width&
207.     $Else
208.         TaskbarWidth = 0 'no function to get the value for Linux/Mac, so return 0 instead of an error
209.     $End If
210. End Function
211.  
212.  
213. Function TitleBarHeight
214.     Do Until _Width <> 0 And _ScreenExists = -1: Loop
215.     $If BORDERDEC = UNDEFINED Then
216.         $Let BORDERDEC = TRUE
217.         Declare Library
218.             Function glutGet& (ByVal what&)
219.         End Declare
220.     $End If
221.     TitleBarHeight = glutGet(507)
222. End Function
223.  
224. Function BorderWidth
225.     Do Until _Width <> 0 And _ScreenExists = -1: Loop
226.     $If BORDERDEC = UNDEFINED Then
227.         $Let BORDERDEC = TRUE
228.         Declare Library
229.         Function glutGet& (ByVal what&)
230.         End Declare
231.     $End If
232.     BorderWidth = glutGet(506)
233. End Function

We start by building some rivers across the screen, which would be the lowest point on the map, and then we rise up to build terrain from that point outwards...    beach, plain, forest, hill, mountain, impassable mountains!

Some things to play around with here:

Rivers Int(Rnd * 10) + 1, Int(Rnd * 100) - 100, -3   -- First value is the number of rivers, second is how much they meander across the map, and the third is their starting depth.  Note that I haven't set any colors for a depth < -3.

In the fill sub, there's a section which you can play around with to increase density of various features:

    Select Case height
        Case Is < 0: RepeatChance = 33 'water repeat
        Case Is = 0: RepeatChance = 25 'beach repeat
        Case Is = 1: RepeatChance = 55 'grassland
        Case Is = 2: RepeatChance = 55 'forest
        Case Is = 3: RepeatChance = 40 ' hills
        Case Is = 4: RepeatChance = 33 'mountains
        Case Else
            RepeatChance = 50 - 3 * height
            If RepeatChance < 10 Then RepeatChance = 10
    End Select

The higher the numbers here, the more of the feature your map is going to have...

There's no Ocean on these maps, nor is there any lakes (I think lakes would be a nice addition, rather than just forcing multiple rivers to define the low points of the map), but I think this goes to show how I'd work on generating a map like this.   I'd start at the lowest point and then just expand outwards and upwards to my mountains.  ;)

  [ You are not allowed to view this attachment ]  

NOTE: Grab the taskbar header file for proper sizing from here: https://www.qb64.org/forum/index.php?topic=1020.msg138058#msg138058

[bplus]

Here I am building Contours about Random Points:

Code: QB64: [Select]

1. _Title "Build Contours about Rnd Pts - zzz... press any, esc to quit"
2. _ScreenMove 400, 60
3. Dim Shared tile(5) As String
4. tile(1) = "."
5. tile(2) = "~"
6. tile(3) = "="
7. tile(4) = "o"
8. tile(5) = "#"
9.  
10. Randomize Timer
11. Width 80, 80
12. _Font 8
13.  
14. Do
15.     Cls
16.     nP = Rnd * 7 + 3
17.     ReDim pX(1 To nP), pY(1 To nP)
18.     For i = 1 To nP
19.         pX(i) = Rnd * _Width * .9 + .05 * _Width
20.         pY(i) = Rnd * _Height * .9 + .05 * _Height
21.     Next
22.  
23.     For level = 1 To 5
24.         For i = 1 To nP
25.             If Rnd < .5 Then dir = -1 Else dir = 1
26.             x = pX(i) + dir * (Rnd * (6 - level) * 2)
27.             If Rnd < .5 Then dir = -1 Else dir = 1
28.             y = pY(i) + dir * (Rnd * (6 - level) * 2)
29.             r = (Rnd * (6 - level) * 3) + 5 * (6 - level)
30.             For row = y - r To y + r
31.                 For col = x - r To x + r
32.                     If row >= 1 And row <= _Height Then
33.                         If col > 1 And col <= _Width Then
34.                             If Sqr(((col - x) ^ 2) + (row - y) ^ 2) <= r Then
35.                                 Locate row, col: Print tile(level);
36.                             End If
37.                         End If
38.                     End If
39.                 Next
40.             Next
41.  
42.         Next
43.     Next
44.     Sleep
45. Loop Until _KeyDown(27)
46.  
47.  
48.  

  [ You are not allowed to view this attachment ]  

[bplus]

Nice job Steve! but where is the Ascii? ;-))

[bplus]

@SMcNeill

Here's feedback on where your screen ended up in my screen, the left side under my taskbar and the right side showing what's underneath about the width of the taskbar, beautiful image, your farm?

[SMcNeill]

Nice job Steve! but where is the Ascii? ;-))

It's just a grid of a few various heights.  Map it to whatever ASCII colors/characters you want.  I used graphics so I could display it all.  ;)