Here is a simple program to generate some height maps. The maps can be generated to png files or txt files (as a serialized array).

Here’s the main program:

module TerrainGen open System.Drawing open HeightMap open MidpointDisplacement open TestFramework open Tests let heightMapToTxt (heightMap:HeightMap) (filename:string) = let out = Array.init (heightMap.Size * heightMap.Size) (fun e -> heightMap.Map.[e].ToString()) System.IO.File.WriteAllLines(filename, out) let heightMapToPng (heightMap:HeightMap) (filename:string) = let png = new Bitmap(heightMap.Size, heightMap.Size) for x in [0..heightMap.Size-1] do for y in [0..heightMap.Size-1] do let red, green, blue = convertFloatToRgb (heightMap.Get x y) png.SetPixel(x, y, Color.FromArgb(255, red, green, blue)) png.Save(filename, Imaging.ImageFormat.Png) |> ignore [<EntryPoint>] let main argv = consoleTestRunner testsToRun let map = newHeightMap 8 generate map 0.3 0.5 heightMapToPng map "out.png" heightMapToTxt map "out.txt" 0

It uses two other modules. HeightMap which contains the height map type and the functions to work with this type. MidpointDisplacement which contains the algorithm proper.

module HeightMap // contains the height map types and common functions that can be re-used for // different generation algorithms type HeightMap = {Size:int; Map:float array} with member this.Get x y = this.Map.[x * this.Size + y] member this.Set x y value = this.Map.[x * this.Size + y] <- value // returns a square matrix of size 2^n + 1 let newHeightMap n : HeightMap = let size = ( pown 2 n ) + 1 {Size = size; Map = Array.zeroCreate (size * size)} // normalize a single value to constrain it's value between 0.0 and 1.0 let normalizeValue v = match v with | v when v < 0.0 -> 0.0 | v when v > 1.0 -> 1.0 | _ -> v // converts a float point ranging from 0.0 to 1.0 to a rgb value // 0.0 represents black and 1.0 white. The conversion is in greyscale let convertFloatToRgb (pct:float) : int * int * int = let greyscale = int (255.0 * pct) (greyscale, greyscale, greyscale) // returns the average between two values let inline avg (a:^n) (b:^n) : ^n = (a + b) / (LanguagePrimitives.GenericOne + LanguagePrimitives.GenericOne) // returns a floating number which is generated using bounds as a control of the range of possible values let randomize (rnd:System.Random) (bound:float) : float = (rnd.NextDouble() * 2.0 - 1.0) * bound

module MidpointDisplacement open HeightMap // set the four corners to random values let initCorners (hm:HeightMap) (rnd) = let rnd = System.Random() let size = hm.Size hm.Set 0 0 (rnd.NextDouble()) hm.Set 0 (size - 1) (rnd.NextDouble()) hm.Set (size - 1) 0 (rnd.NextDouble()) hm.Set (size - 1) (size - 1) (rnd.NextDouble()) // set the middle values between each corner (c1 c2 c3 c4) // variation is a function that is applied on each pixel to modify it's value let middle (hm:HeightMap) (x1, y1) (x2, y2) (x3, y3) (x4, y4) (variation) = // set left middle if hm.Get x1 (avg y1 y3) = 0.0 then hm.Set x1 (avg y1 y3) (avg (hm.Get x1 y1) (hm.Get x3 y3) |> variation) // set upper middle if hm.Get (avg x1 x2) y1 = 0.0 then hm.Set (avg x1 x2) y1 (avg (hm.Get x1 y1) (hm.Get x2 y2) |> variation) // set right middle if hm.Get x2 (avg y2 y4) = 0.0 then hm.Set x2 (avg y2 y4) (avg (hm.Get x2 y2) (hm.Get x4 y4) |> variation) // set lower middle if hm.Get (avg x3 x4) y3 = 0.0 then hm.Set (avg x3 x4) y3 (avg (hm.Get x3 y3) (hm.Get x4 y4) |> variation) // set the center value of the current matrix to the average of all middle values + variation function let center (hm:HeightMap) (x1, y1) (x2, y2) (x3, y3) (x4, y4) (variation) = // average height of left and right middle points let avgHorizontal = avg (hm.Get x1 (avg y1 y3)) (hm.Get x2 (avg y2 y4)) let avgVertical = avg (hm.Get (avg x1 x2) y1) (hm.Get (avg x3 x4) y3) // set center value hm.Set (avg x1 x4) (avg y1 y4) (avg avgHorizontal avgVertical |> variation) let rec displace (hm) (x1, y1) (x4, y4) (rnd) (spread) (spreadReduction) = let ulCorner = (x1, y1) let urCorner = (x4, y1) let llCorner = (x1, y4) let lrCorner = (x4, y4) let variation = (fun x -> x + (randomize rnd spread)) >> normalizeValue let adjustedSpread = spread * spreadReduction // the lambda passed in as a parameter is temporary until a define a better function middle hm ulCorner urCorner llCorner lrCorner variation center hm ulCorner urCorner llCorner lrCorner variation if x4 - x1 >= 2 then let xAvg = avg x1 x4 let yAvg = avg y1 y4 displace hm (x1, y1) (xAvg, yAvg) rnd adjustedSpread spreadReduction displace hm (xAvg, y1) (x4, yAvg) rnd adjustedSpread spreadReduction displace hm (x1, yAvg) (xAvg, y4) rnd adjustedSpread spreadReduction displace hm (xAvg, yAvg) (x4, y4) rnd adjustedSpread spreadReduction let generate hm startingSpread spreadReduction = let rnd = System.Random() let size = hm.Size - 1 initCorners hm rnd displace hm (0, 0) (size, size) rnd startingSpread spreadReduction

The algorithm is pretty similar to diamond-square, in fact I have seen some people call it so, but it’s subtly different (in how to various sub-sections are divided) from the canon example, which is why I’m referring to it as midpoint displacement rather than diamond-square.

I’m pretty happy with the output of the results. It’s better than any map I have done before. Here is an example :

The code would need some optimization has it’s running out of memory fairly quick when generating larger maps.

You can find it as part of a larger repo on GitHub, that I have sadly abandoned.