summaryrefslogtreecommitdiff
path: root/src/LivingVillage.Desktop/ProceduralMap.fs
blob: 8481f0566c91d638286620dfdcb828504c1e23e4 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
namespace LivingVillage.Desktop

module ProceduralMap =

    /// Pure deterministic 512x384 terrain generator:
    ///  - rivers carved by seeded random walks (splitmix64 PRNG),
    ///  - multi-octave value noise for grass/peat variation,
    ///  - poisson-style deterministic scatter for decorative props (min distance),
    ///  - the handcrafted 30-NPC village core rectangle is enforced walkable
    ///    (generator invariant: no water/stone/peat inside the core).
    type TerrainSnapshot =
        { Seed: uint64
          Width: int
          Height: int
          Tiles: int array } // row-major ground code: 0 grass, 1 water, 2 stone, 3 peat

    let width = 512
    let height = 384

    module GroundTile =
        let Grass = 0
        let Water = 1
        let Stone = 2
        let Peat = 3

    let villageCoreMinX = 24
    let villageCoreMaxX = 38
    let villageCoreMinY = 16
    let villageCoreMaxY = 34

    let private inVillageCore (x: int) (y: int) : bool =
        x >= villageCoreMinX && x <= villageCoreMaxX && y >= villageCoreMinY && y <= villageCoreMaxY

    // splitmix64 deterministic stream.
    let private splitmix (state: uint64) : uint64 * uint64 =
        let nextState = state + 0x9E3779B97F4A7C15UL
        let mutable z = nextState
        z <- (z ^^^ (z >>> 30)) * 0xBF58476D1CE4E5B9UL
        z <- z ^^^ (z >>> 27)
        z <- z * 0x94D049BB133111EBUL
        z <- z ^^^ (z >>> 31)
        (nextState, z)

    let private hash2 (x: int) (y: int) (seed: uint64) : uint64 =
        let base_ = seed ^^^ ((uint64 x * 0x4D3B9UL) + (uint64 y * 0x1D5UL))
        let _, a = splitmix base_ in a

    // bilinear value noise one octave, deterministic via lattice hash.
    let private valueNoise (x: float32) (y: float32) (seed: uint64) (scale: float32) : float32 =
        let xf = x / scale
        let yf = y / scale
        let x0 = int (floor xf)
        let y0 = int (floor yf)
        let tx = xf - float32 x0
        let ty = yf - float32 y0
        let smooth (t: float32) = t * t * (3.0f - 2.0f * t)
        let sx = smooth tx
        let sy = smooth ty
        let v00 = float32 (hash2 x0 y0 seed % 1000UL) / 1000.0f
        let v10 = float32 (hash2 (x0 + 1) y0 seed % 1000UL) / 1000.0f
        let v01 = float32 (hash2 x0 (y0 + 1) seed % 1000UL) / 1000.0f
        let v11 = float32 (hash2 (x0 + 1) (y0 + 1) seed % 1000UL) / 1000.0f
        (v00 * (1.0f - sx) + v10 * sx) * (1.0f - sy) + (v01 * (1.0f - sx) + v11 * sx) * sy

    let private multiOctave (x: int) (y: int) (seed: uint64) : float32 =
        let xf = float32 x
        let yf = float32 y
        let a = valueNoise xf yf seed 96.0f
        let b = valueNoise xf yf (seed + 1UL) 38.0f
        let c = valueNoise xf yf (seed + 2UL) 13.0f
        0.55f * a + 0.3f * b + 0.15f * c

    /// Generate the full terrain snapshot. Twice with the same seed = byte-identical.
    let generate (seed: uint64) : TerrainSnapshot =
        let grid = Array.init (width * height) (fun _ -> GroundTile.Grass)

        // --- 1) multi-octave noise: peat patches on low-lying grass.
        for y in 0 .. height - 1 do
            for x in 0 .. width - 1 do
                let noise = multiOctave x y seed
                if noise < 0.18f && not (inVillageCore x y) then
                    grid.[y * width + x] <- GroundTile.Peat

        // --- 2) rivers: three seeded random walks from west to east edges, width 3.
        let mutable rngState = seed ^^^ 0xBEEFUL
        for _ in 0 .. 2 do
            let (nextState, startYRaw) = splitmix rngState
            rngState <- nextState
            let mutable y = 60 + int (startYRaw % uint64 (height - 120))
            let mutable bandWidth = 3
            for x in 4 .. width - 5 do
                let (nextStep, stepRaw) = splitmix rngState
                rngState <- nextStep
                let drift = (int (stepRaw % 3UL)) - 1
                y <- max 20 (min (height - 21) (y + drift))
                for dy in 0 .. bandWidth - 1 do
                    let yy = y + dy
                    if inVillageCore x yy then () else grid.[yy * width + x] <- GroundTile.Water

        // --- 3) poisson-style deterministic scatter: willow props are rendered by the
        // draw pass; here only the min-distance exclusion stamping (prop seeds feed
        // the renderer via the same array as codes).
        let mutable attempts = 0
        let mutable rngLoop = rngState
        let placed: (int * int) list = []
        while attempts < 800 do
            let (nextAttempt, raw) = splitmix rngLoop
            rngLoop <- nextAttempt
            let x = int (raw % uint64 width)
            let y = int ((raw >>> 20) % uint64 height)
            let farFromPlaced =
                placed |> List.forall (fun (px, py) ->
                    let dx = px - x in let dy = py - y in dx * dx + dy * dy > 900)
            if farFromPlaced && not (inVillageCore x y) && grid.[y * width + x] = GroundTile.Grass then
                grid.[y * width + x] <- GroundTile.Stone
            attempts <- attempts + 1

        if Array.length grid <> width * height then failwith "terrain size invariant broken"
        { Seed = seed; Width = width; Height = height; Tiles = grid }


    /// Live terrain of the active big world (set by the game at startup).
    let mutable terrainOption: TerrainSnapshot option = None
    let mutable bigWorldActive = false

    let activate (seed: uint64) : unit =
        terrainOption <- Some(generate seed)
        bigWorldActive <- true

    let deactivate () : unit =
        terrainOption <- None
        bigWorldActive <- false