Height map generation in F# using midpoint displacement

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 :

out

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.

Making your own simple test framework in F#

I’m currently programming in F# under Linux. This means no Visual Studio and no MSTest GUI test runner. My first reaction was to start looking at using NUnit or xUnit for my project.

I then had a thought. Why not write my own simple test “framework”. It sounded like something easy to do and pretty fun. In retrospect, it was.

Of course this is nothing like a full featured test framework but it’s enough for my purposes.

Here is the test framework:

module TestFramework

// assert functions
let assertAreEqual expected actual =
    if expected <> actual then
        sprintf "Test failed, expected %A, actual %A" expected actual
    else
        "Test passed"

let assertIsGreaterThan target actual =
     if target >= actual then
        sprintf "Test failed, expected %A to be greater than %A" target actual
     else
        "Test passed" 

// test runner
let runSingleTest (testName, testFunction) =
    sprintf "%s... %s" testName (testFunction())       

let runTests testList =
    testList |> List.map (runSingleTest)

let consoleTestRunner testList =
    runTests testList |> List.iter (printfn "%s")
    printfn "%s" "Ran all tests."

F#’s automatic generalization cuts down on explicit generics or function overloads in the assert functions.

This makes the code more succinct and development less tedious.

Right now there is only a consoleTestRunner but more types of test runners could be implemented to accommodate other interfaces like a GUI.

And here are some sample tests:

module Tests

open TestFramework

// modules under test
open HeightMap
open MidpointDisplacement

// tests included in run
let testsToRun =
    [
        "newHeightMap will return a 0 initialized height map",
        fun() ->
            let hm = newHeightMap 5
            let result = hm.Map |> Array.sum
            assertAreEqual 0.0 result;

        "set will update height map",
        fun() ->
            let hm = newHeightMap 5
            hm.Set 1 1 0.5
            assertAreEqual 0.5 (hm.Get 1 1);

        "convertFloatToRgb will convert 0.0 to r:0, g:0, b:0",
        fun() ->
            let red, green, blue = convertFloatToRgb 0.0
            assertAreEqual (0, 0, 0) (red, green, blue);

        "convertFloatToRgb will convert 1.0 to r:255, g:255, b:255",
        fun() ->
            let red, green, blue = convertFloatToRgb 1.0
            assertAreEqual (255, 255, 255) (red, green, blue);                                               

        "convertFloatToRgb will convert 0.5 to r:127, g:127, b:127",
        fun() ->
            let red, green, blue = convertFloatToRgb 0.5
            assertAreEqual (127, 127, 127) (red, green, blue);

        "middle will set the midpoint value between each corner to the average of the corners plus the result of a function",
        fun() ->
            let variationFunction x = x + 0.1
            let hm = newHeightMap 2
            hm.Set 0 0 0.5
            hm.Set 0 4 0.5
            hm.Set 4 0 1.0
            hm.Set 4 4 0.25
            middle hm (0, 0) (4, 0) (0, 4) (4, 4) variationFunction
            let middleValues = [hm.Get 0 2; hm.Get 2 0; hm.Get 2 4; hm.Get 4 2]
            assertAreEqual [0.6; 0.85; 0.475; 0.725] middleValues;
    ]

The tests themselves are represented as data, which is a common concept in functional programming. Each test is a tuple with the first argument being the name of the test as it will appear in the console during a test run.

Here is how to call the framework along with a sample test run output :

open TestFramework
open Tests

consoleTestRunner testsToRun

newHeightMap will return a 0 initialized height map… Test passed
set will update height map… Test passed
init corners will assign values to the height map corners… Test passed
convertFloatToRgb will convert 0.0 to r:0, g:0, b:0… Test passed
convertFloatToRgb will convert 1.0 to r:255, g:255, b:255… Test passed
convertFloatToRgb will convert 0.5 to r:127, g:127, b:127… Test passed
set will correctly change the values of an heightmap… Test passed
middle will set the midpoint value between each corner to the average of the corners plus the result of a function… Test passed
Ran all tests.

Since I’m just beginning with F#, I had my code reviewed on codereview.stackexchange.com and had some great answers. I can’t recommend this site enough for when you are starting out with a new language.