ISO simple ASCII procedural terrain

[SMcNeill]

@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?

I don't detect which border you have your taskbar snapped to, so just drag the screen right a bit for your display.  At least it seems properly sized right for everything.  ;)

[SMcNeill]

Added Lakes into the mix.

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

  [ You are not allowed to view this attachment ]  

  [ You are not allowed to view this attachment ]  

I've got to admit, I think some of these end up looking rather nice.  (Of course, since almost everything is random here, some of these end up looking like complete garbage to me as well.)

Keep in mind, I'm creating massive 200 x 200 world maps with the settings the way I currently have them.  Also note, the actual game would probably be at a much larger scale with only small portions of it viewable by the player at a time.   I also don't know if I'd bother to use so many colors for water... Probably just shallow water (where you can wade in it) and deep water (where a boat travels) would be good enough.  My thinking behind 3 levels of water here was basically ocean ship, canoe/raft/shallow drag boat, and then wading/shallow water.

Anywho...   I'd call this a decent shot at a random terrain generator.  It doesn't follow any basic rules of logic, but it's decent enough I'm not ashamed to share it.  :P

If I was serious about this thing, I'd probably start at my mountains and then flow down to my oceans and not backwards like I did in this attempt, as that seems like it'd generate a more natural water flow from high to low.  I'd also try to work in things like temperature zones for the polar regions, and deserts for places which are too far away from any major source of water and would normally be plains instead.

Enough to showcase the basic idea behind things here, but it can definitely be expanded on if someone was wanting to.  ;D

[xra7en]

still....

you have something there.

gonna tinker with it, and post a couple of images. I think this might work for what I am looking for. Will have to do a little converting to ASCII (piece o cake :P)

wonder how Nox got MC almost perfect generating land! ??