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
|