summaryrefslogtreecommitdiff
path: root/src/LivingVillage.Desktop/MapGen.fs
blob: abd4a7ed2a33978668d09ccc0e63c2eb6adc4cf3 (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
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
namespace LivingVillage.Desktop

open LivingVillage.Kernel

/// P20 第一步:确定性大地图生成器的参数化纯函数片。
/// 单一入口 `generate`:seed + 尺寸 -> 瓦片网格(0 grass / 1 water / 2 stone / 3 peat)。
/// 组成:splitmix64 随机游走河道 + 2-3 octave value noise 地形 + 泊松式布点装饰,
/// 核心活动区先整平为草地,再用 BFS 校验 30 个 spawn 全部可达核心(不可达则确定性修整)。
/// 全部为纯函数:同参两次生成逐字节一致,不含时钟/随机源。
module MapGen =

    /// 地面码,与既有 ProceduralMap / 渲染映射保持一致。
    /// P30:大图乡村空区新增 4=水田 / 5=菜畦(成熟 tile 素材;非水故仍可通行)。
    type GroundTile =
        | Grass = 0
        | Water = 1
        | Stone = 2
        | Peat = 3
        | PaddyField = 4
        | VegetablePlot = 5

    type Bounds =
        { MinX: int
          MinY: int
          MaxX: int
          MaxY: int }

    type Params =
        { Width: int
          Height: int
          Seed: uint64
          RiverCount: int
          RiverWidth: int
          CoreSide: int
          SpawnColumns: int
          SpawnRows: int
          /// P24:大图额外沿河民居数量(沿现有路网泊松散布)。默认 0,64x48/256x192 不受影响。
          ExtraRiversideHouses: int
          /// P25:是否放置孤立装饰石块。默认 true;大图关闭,避免草地上出现游离石板 tile。
          DecorativeStones: bool
          /// P26:是否沿海河岸放置河岸装饰(护岸石垒/芦苇/垂柳)。默认 false;仅大图开启。
          RiverDecorations: bool
          /// P29:大图聚落组团发牌种子(group seeding)。默认 0 且在非大图分支不使用,
          /// 故 64x48/256x192 的 structureRng 流与输出逐字节不变。
          ClusterSeed: uint64 }

    /// P20 第二步:一条贯穿全图的东西向河道(每列恰好一段,宽度下限 RiverWidth)。
    type River =
        { CenterY: int
          Width: int }

    /// 沿河民居色块:白墙黑瓦矩形屋顶,门开向石板路。
    type Building =
        { Left: int
          Top: int
          Width: int
          Height: int
          DoorX: int
          DoorY: int }

    /// P26 河岸装饰种类:护岸石垒 / 芦苇 / 垂柳(垂柳占上下两格)。
    type RiverDecorationKind =
        | RevetmentStone
        | Reeds
        | Willow

    /// P26 河岸装饰:纯视觉,不写入瓦片、不影响通行;仅大图沿海河岸生成。
    type RiverDecoration =
        { Kind: RiverDecorationKind
          X: int
          Y: int }

    /// P30 树丛种类:竹丛 / 灌木丛;纯视觉层(不写瓦片、不影响通行),仅大图乡村空区生成。
    type GroveKind =
        | BambooClump
        | ShrubClump

    /// P30 树丛:单格树/灌木,成丛由若干相邻格组成;渲染走既有 Bamboo/Shrub 成熟素材。
    type Grove =
        { Kind: GroveKind
          X: int
          Y: int }

    type Result =
        { Width: int
          Height: int
          Seed: uint64
          Tiles: int array
          Core: Bounds
          Spawns: (int * int) list
          Rivers: River list
          Bridges: (int * int) list
          Paths: (int * int) list
          Buildings: Building list
          Decorations: RiverDecoration list
          /// P30 散落农舍:与沿河组团民居分列,避免污染组团规模统计;门贴草地/院落路可达。
          Farmhouses: Building list
          /// P30 乡村树丛:纯视觉,不入瓦片、不影响通行与可达性。
          Groves: Grove list
          /// P30 主路中心线(逐列 y):默认图为笔直 roadY;大图为确定性缓弯(相邻列步长 <=1)。
          MainRoadCenter: int array
          ReachableTiles: int
          ReachabilityOk: bool
          BridgeCrossingsOk: bool }

    /// 默认仍是现状游戏尺寸 64x48,核心 14 格、5x6=30 个 spawn。
    let defaultParams (seed: uint64) : Params =
        { Width = 64
          Height = 48
          Seed = seed
          RiverCount = 2
          RiverWidth = 3
          CoreSide = 14
          SpawnColumns = 5
          SpawnRows = 6
          ExtraRiversideHouses = 0
          DecorativeStones = true
          RiverDecorations = false
          ClusterSeed = 0UL }

    /// P23 尺寸自适应参数:河道数量随高度增长(约每 96 行一条),其余沿用默认。
    /// 64x48 / 256x192 仍得到 2 条河道,与既有输出逐字节一致;512x384 得到 4 条。
    /// P24:仅对大于 256x192 的图追加沿河民居(泊松散布),保证既有 checksum 不变。
    /// P28:大图沿河民居由 10 增至 16(+6 座,宽度 2/3/4 变化),默认图仍为 0、不消耗 RNG。
    /// P29:大图额外启用聚落组团发牌种子(独立 clusterRng),默认图保持 0、不进入组团分支。
    /// P30:大图沿河/沿路民居目标由 16 增至 30(组团 2-5 座为主),并新增乡村空区填充与主路弯曲,
    ///      全部只在 large 分支执行;64x48/256x192 判定不进入、不消费任何额外 RNG。
    let paramsForSize (width: int) (height: int) (seed: uint64) : Params =
        let base_ = defaultParams seed
        let large = width > 256 || height > 192
        { base_ with
            Width = width
            Height = height
            RiverCount = max base_.RiverCount (max 1 (height / 96))
            ExtraRiversideHouses = (if large then 30 else 0)
            DecorativeStones = not large
            RiverDecorations = large
            ClusterSeed = (if large then seed ^^^ 0xC1A57E2UL else 0UL) }

    // ---- splitmix64 与 value noise(无外部依赖、无时钟) ----

    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))
        snd (splitmix base_)

    let private valueNoise (fx: float32) (fy: float32) (seed: uint64) (scale: float32) : float32 =
        let xf = fx / scale
        let yf = fy / 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

    /// 2-3 octave 叠加;特征尺度随地图宽度等比缩放,保证小图/大图观感一致。
    /// P23:特征尺度封顶(<=4x),避免 512x384 退化成过于平滑的「放大图」。
    let private noiseWidthScale (width: int) : float32 =
        min 4.0f (float32 width / 64.0f)

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

    // ---- 生成 ----

    let private index (width: int) (x: int) (y: int) : int = y * width + x

    let tileAt (result: Result) (x: int) (y: int) : GroundTile =
        enum<GroundTile> result.Tiles.[index result.Width x y]

    /// 参数化生成。尺寸下限 8x8;核心区始终先整平为草地,再 BFS 校验可达性。
    let generate (p: Params) : Result =
        let w = max 8 p.Width
        let h = max 8 p.Height
        let tiles = Array.zeroCreate<int> (w * h) // 0 = Grass
        let idx x y = index w x y

        let side = max 6 (min (min w h) p.CoreSide)
        let cx = w / 2
        let cy = h / 2
        let core =
            { MinX = max 1 (cx - side / 2)
              MinY = max 1 (cy - side / 2)
              MaxX = min (w - 2) (cx + side / 2)
              MaxY = min (h - 2) (cy + side / 2) }
        let inCore x y =
            x >= core.MinX && x <= core.MaxX && y >= core.MinY && y <= core.MaxY

        // 1) 多八度噪声:低洼草地转泥炭(跳过核心区)。
        let widthScale = noiseWidthScale w
        for y in 0 .. h - 1 do
            for x in 0 .. w - 1 do
                if multiOctave widthScale x y p.Seed < 0.18f && not (inCore x y) then
                    tiles.[idx x y] <- int GroundTile.Peat

        // 2) 河道:连续贯穿全图(每列恰好一段),置于核心区上下两侧,宽度恒 >= RiverWidth。
        let riverWidth = max 3 p.RiverWidth
        let riverBands =
            [ for i in 0 .. max 0 p.RiverCount - 1 do
                if i = 0 then
                    let centerY = max 1 (min (h - 1 - riverWidth) (min (core.MinY - riverWidth - 2) (h / 4)))
                    if centerY + riverWidth - 1 < core.MinY then
                        yield { CenterY = centerY; Width = riverWidth }
                elif i = 1 then
                    let centerY = max 1 (min (h - 1 - riverWidth) (max (core.MaxY + 2) (3 * h / 4)))
                    if centerY > core.MaxY then
                        yield { CenterY = centerY; Width = riverWidth }
                else
                    // P23:第 3 条起在核心上/下方逐层外扩堆叠,互不重叠、不压核心。
                    let layer = (i - 1) / 2
                    let offset = if i % 2 = 1 then layer - 1 else layer
                    if i % 2 = 0 then
                        let centerY = core.MinY - riverWidth - 2 - offset * (riverWidth + 3)
                        if centerY >= 1 then
                            yield { CenterY = centerY; Width = riverWidth }
                    else
                        let centerY = core.MaxY + 2 + offset * (riverWidth + 3)
                        if centerY + riverWidth - 1 <= h - 2 then
                            yield { CenterY = centerY; Width = riverWidth } ]
        for river in riverBands do
            for x in 1 .. w - 2 do
                for dy in 0 .. river.Width - 1 do
                    tiles.[idx x (river.CenterY + dy)] <- int GroundTile.Water

        // 3) 核心活动区整平为草地(生成器保证可通行)。
        for y in core.MinY .. core.MaxY do
            for x in core.MinX .. core.MaxX do
                tiles.[idx x y] <- int GroundTile.Grass

        // 4) 泊松式布点:最小间距随尺寸缩放,只在草地打石头装饰(跳过核心区)。
        let minDist = max 3 (w / 24)
        let minSq = minDist * minDist
        let attempts = max 100 ((w * h) / 16)
        let mutable placed: (int * int) list = []
        let mutable scatterRng = p.Seed ^^^ 0xC0FFEEUL
        // P25:大图禁用孤立装饰石块,避免草地上出现游离石板 tile(64x48/256x192 保持开启)。
        if p.DecorativeStones then
            for _ in 1 .. attempts do
                let nextState, raw = splitmix scatterRng
                scatterRng <- nextState
                let x = int (raw % uint64 w)
                let y = int ((raw >>> 20) % uint64 h)
                let far =
                    placed
                    |> List.forall (fun (px, py) ->
                        let dx = px - x
                        let dy = py - y
                        dx * dx + dy * dy > minSq)
                if far && not (inCore x y) && tiles.[idx x y] = int GroundTile.Grass then
                    tiles.[idx x y] <- int GroundTile.Stone
                    placed <- (x, y) :: placed

        // 5) 交通:桥 + 石板路网 + 沿河民居(白墙黑瓦矩形色块,门朝远岸路)。
        let mutable structureRng = p.Seed ^^^ 0x51AB1EUL
        let inMap x y = x >= 0 && x < w && y >= 0 && y < h
        let mutable bridges: (int * int) list = []
        let mutable paths: (int * int) list = []
        let mutable buildings: Building list = []
        let mutable farmhouses: Building list = []
        let mutable groves: Grove list = []
        let pathSet = System.Collections.Generic.HashSet<int>()
        let addPath x y =
            if inMap x y && tiles.[idx x y] <> int GroundTile.Water then
                tiles.[idx x y] <- int GroundTile.Stone
                if pathSet.Add(idx x y) then paths <- (x, y) :: paths
        let nextBetween lo hi =
            let nextState, raw = splitmix structureRng
            structureRng <- nextState
            lo + int (raw % uint64 (max 1 (hi - lo + 1)))
        let roadY = (core.MinY + core.MaxY) / 2
        // P30 主路柔化:仅大图把主街按逐点确定性微扰成缓弯(曲率 ±3 格、相邻列步长 <=1,
        // 遇弯补一格保证 4 连通);默认图仍为笔直主街,故 64x48/256x192 输出逐字节不变。
        let largeMap = p.ExtraRiversideHouses > 0
        let roadCenter =
            let arr = Array.create w roadY
            if largeMap then
                let roadSeed = p.Seed ^^^ 0x5E9B0AUL
                let mutable prev = roadY
                for x in 1 .. w - 2 do
                    let noise = valueNoise (float32 x) 0.0f roadSeed 130.0f
                    let target = roadY + int (System.Math.Round(3.0 * float (noise - 0.5f) * 2.0))
                    let y = max (prev - 1) (min (prev + 1) target)
                    arr.[x] <- y
                    prev <- y
                // 两边界补与首/末列相接,避免边缘断头。
                arr.[0] <- arr.[1]
                arr.[w - 1] <- arr.[w - 2]
            arr
        let roadYAt (x: int) = roadCenter.[max 0 (min (w - 1) x)]
        for x in 1 .. w - 2 do
            if x > 1 && roadYAt x <> roadYAt (x - 1) then
                addPath x (roadYAt (x - 1))
            addPath x (roadYAt x)
        let bridgeColumns =
            [ for river in riverBands do
                let mutable picked: int list = []
                for _ in 1 .. 2 do
                    let mutable bx = nextBetween 4 (max 4 (w - 5))
                    let mutable guard = 0
                    while List.contains bx picked && guard < 8 do
                        bx <- nextBetween 4 (max 4 (w - 5))
                        guard <- guard + 1
                    picked <- bx :: picked
                    yield (river, bx) ]
        for river, bx in bridgeColumns do
            for dx in 0 .. 1 do
                if bx + dx <= w - 2 then
                    for dy in 0 .. river.Width - 1 do
                        let yy = river.CenterY + dy
                        if inMap (bx + dx) yy then
                            bridges <- (bx + dx, yy) :: bridges
            let roadYb = roadYAt bx
            let yLo = min (river.CenterY - 1) roadYb
            let yHi = max (river.CenterY + river.Width) roadYb
            for y in yLo .. yHi do
                addPath bx y
            let farY = if river.CenterY < core.MinY then river.CenterY - 2 else river.CenterY + river.Width + 1
            for x in max 1 (bx - 7) .. min (w - 2) (bx + 7) do
                addPath x farY
            let buildingWidth = 3 + nextBetween 0 1
            let doorX = min (w - 3) (max 2 (bx + 3))
            let building =
                if river.CenterY < core.MinY then
                    { Left = max 1 (doorX - buildingWidth / 2)
                      Top = max 1 (farY - 2)
                      Width = buildingWidth
                      Height = 2
                      DoorX = doorX
                      DoorY = max 1 (farY - 1) }
                else
                    { Left = max 1 (doorX - buildingWidth / 2)
                      Top = farY + 1
                      Width = buildingWidth
                      Height = 2
                      DoorX = doorX
                      DoorY = farY + 1 }
            buildings <- building :: buildings
            addPath building.DoorX building.DoorY

        // 5b) P24/P28/P29/P30:大图沿河聚落组团。仅在 ExtraRiversideHouses>0 时执行,只落在核心区外
        //     草地并避免与既有民居重叠,故 64x48/256x192 输出逐字节不变。
        //     P29:沿横向石板路(主街 + 河岸路)成排成组落位,组发牌用独立 clusterRng(group seeding),
        //     不触碰既有 structureRng,桥/路/灯笼等基础结构坐标不受影响。宽度按 2/3/4 加权。
        //     P30:目标密度由 16 增至 30,组团规模改为 2-5 座;含基础岸屋的路段优先布组,
        //     使每座基础民居并入 >=2 座的组团,消除大面积孤立单屋。
        if p.ExtraRiversideHouses > 0 then
            let footprintFree (left: int) (top: int) (width: int) =
                left >= 1 && left + width - 1 <= w - 2 && top >= 1 && top + 1 <= h - 2
                && [ for dx in 0 .. width - 1 do
                       for dy in 0 .. 1 -> (left + dx, top + dy) ]
                   |> List.forall (fun (x, y) ->
                       tiles.[idx x y] = int GroundTile.Grass
                       && not (inCore x y))
            let overlaps (left: int) (top: int) (width: int) =
                buildings
                |> List.exists (fun b ->
                    left < b.Left + b.Width && b.Left < left + width
                    && top < b.Top + b.Height && b.Top < top + 2)
            // 横向路段的连续格(主街/河岸路),先按 (y,x) 排序再按 group seed 打散成确定性布线顺序。
            // P30:含既有岸屋的路段优先处理,保证每座基础民居都能被并进 2-5 座的组团。
            let runHasBase (runY: int) (x0: int) (x1: int) =
                buildings
                |> List.exists (fun b ->
                    (b.Top = runY - 2 || b.Top = runY + 1)
                    && b.Left <= x1
                    && b.Left + b.Width - 1 >= x0)
            let horizontalRuns =
                [ for y in 1 .. h - 2 do
                      let mutable x = 1
                      while x <= w - 2 do
                          if pathSet.Contains(idx x y) then
                              let x0 = x
                              while x <= w - 2 && pathSet.Contains(idx x y) do
                                  x <- x + 1
                              if x - x0 >= 4 then yield (y, x0, x - 1)
                          else
                              x <- x + 1 ]
                |> List.sortBy (fun (y, x0, x1) -> ((if runHasBase y x0 x1 then 0 else 1), hash2 y x0 p.ClusterSeed))
            let mutable clusterRng = p.ClusterSeed
            let nextCluster () =
                let nextState, raw = splitmix clusterRng
                clusterRng <- nextState
                raw
            let mutable extraPlaced = 0
            // 在一条横向路段的 [lo,hi] 区间内铺一个 2-5 座组团:门贴路缘、组内 1 格间隙、
            // 宽度按 2/3/4 加权。先做局部试排,只有落满 >=2 座、或能与既有民居并组时才提交,
            // 从源头消除「孤立单屋」。返回实际落位数。
            let nearFootprint (a: Building) (b: Building) =
                let xGap = max (a.Left - (b.Left + b.Width - 1)) (b.Left - (a.Left + a.Width - 1))
                let yGap = max (a.Top - (b.Top + b.Height - 1)) (b.Top - (a.Top + a.Height - 1))
                xGap <= 2 && yGap <= 2
            let placeGroup (runY: int) (lo: int) (hi: int) (desired: int) : int =
                if hi - lo + 1 < 4 then
                    0
                else
                    let sideFits above =
                        let top = if above then runY - 2 else runY + 1
                        [ lo .. min hi (lo + 4) ] |> List.exists (fun x -> footprintFree x top 3)
                    let above = if sideFits true then true else not (sideFits false)
                    let mutable x = max lo (min (hi - 1) (lo + int (nextCluster () % 3UL)))
                    let tentative = ResizeArray<Building>()
                    let mutable guard = 0
                    while tentative.Count < desired && x <= hi - 1 && guard < 48 do
                        let widthRoll = int (nextCluster () % 10UL)
                        let buildingWidth = if widthRoll < 5 then 3 elif widthRoll < 8 then 2 else 4
                        let doorX = x + buildingWidth / 2
                        let doorY = if above then runY - 1 else runY + 1
                        let top = if above then doorY - 1 else doorY
                        let left = doorX - buildingWidth / 2
                        let clashes =
                            tentative
                            |> Seq.exists (fun b ->
                                left < b.Left + b.Width && b.Left < left + buildingWidth
                                && top < b.Top + b.Height && b.Top < top + 2)
                        if doorX <= hi && footprintFree left top buildingWidth && not (overlaps left top buildingWidth) && not clashes then
                            tentative.Add
                                { Left = left
                                  Top = top
                                  Width = buildingWidth
                                  Height = 2
                                  DoorX = doorX
                                  DoorY = doorY }
                            x <- x + buildingWidth + 1
                        else
                            x <- x + 1
                        guard <- guard + 1
                    let connected (t: Building) =
                        (buildings |> List.exists (fun b -> nearFootprint b t))
                        || (tentative |> Seq.exists (fun o -> not (obj.ReferenceEquals(o, t)) && nearFootprint o t))
                    let keep = tentative |> Seq.filter connected |> Seq.toList
                    for building in keep do
                        buildings <- building :: buildings
                        addPath building.DoorX building.DoorY
                    keep.Length
            // P30 基础岸屋配对:为每座尚孤立的基础民居在同行贴 1 格补一座,保证并入 >=2 座组团。
            let baseBuildings = buildings
            let sameBuilding (a: Building) (c: Building) =
                a.Left = c.Left && a.Top = c.Top && a.Width = c.Width && a.DoorX = c.DoorX && a.DoorY = c.DoorY
            for b in baseBuildings do
                let isolated =
                    buildings
                    |> List.forall (fun o -> sameBuilding o b || not (nearFootprint o b))
                if isolated then
                    let widthRoll = int (nextCluster () % 10UL)
                    let buildingWidth = if widthRoll < 5 then 3 elif widthRoll < 8 then 2 else 4
                    let candidates = [ b.Left + b.Width + 1; b.Left - 1 - buildingWidth ]
                    let mutable done_ = false
                    for left in candidates do
                        if not done_
                           && left >= 1
                           && left + buildingWidth - 1 <= w - 2
                           && footprintFree left b.Top buildingWidth
                           && not (overlaps left b.Top buildingWidth) then
                            let doorX = left + buildingWidth / 2
                            buildings <-
                                { Left = left
                                  Top = b.Top
                                  Width = buildingWidth
                                  Height = 2
                                  DoorX = doorX
                                  DoorY = b.DoorY }
                                :: buildings
                            addPath doorX b.DoorY
                            done_ <- true
            for (runY, runStart, runEnd) in horizontalRuns do
                if extraPlaced < p.ExtraRiversideHouses then
                    let runLength = runEnd - runStart + 1
                    // 长路段容纳多个组团,短河岸路各一个。
                    let groupsForRun = max 1 (min 3 (runLength / 24))
                    for group in 0 .. groupsForRun - 1 do
                        if extraPlaced < p.ExtraRiversideHouses then
                            let lo = runStart + (group * runLength) / groupsForRun
                            let hi = runStart + ((group + 1) * runLength) / groupsForRun - 1
                            let desired = min (p.ExtraRiversideHouses - extraPlaced) (2 + int (nextCluster () % 4UL))
                            let placed = placeGroup runY lo hi desired
                            extraPlaced <- extraPlaced + placed

        // 5d) P30 乡村空区填充:上部/下部空带按确定性网格铺田块(水田/菜畦走成熟 tile
        //     素材,写入 4/5 号非水瓦片,仍可通行)、树丛(纯视觉)与少量散落农舍(门贴院落路)。
        //     仅在 large 分支执行:默认图不进入、不消费任何额外 RNG;田块离水面 >=3 格,
        //     避开路网/核心/民居,故不影响河道连续性与 BFS 可达性。
        if p.ExtraRiversideHouses > 0 then
            let mutable countrysideRng = p.ClusterSeed ^^^ 0xF1E1D5EEDUL
            let nextCountry () =
                let nextState, raw = splitmix countrysideRng
                countrysideRng <- nextState
                raw
            // 水面垂直距离:河流整幅横贯,故只需按 y 计算;边界列留 99(不会被选中)。
            let waterDistance = Array.create (w * h) 99
            for river in riverBands do
                for x in 1 .. w - 2 do
                    for y in 0 .. h - 1 do
                        let d =
                            if y < river.CenterY then river.CenterY - y
                            elif y > river.CenterY + river.Width - 1 then y - (river.CenterY + river.Width - 1)
                            else 0
                        let i = idx x y
                        if d < waterDistance.[i] then waterDistance.[i] <- d
            let structureBlocked = Array.create (w * h) false
            for y in core.MinY .. core.MaxY do
                for x in core.MinX .. core.MaxX do
                    structureBlocked.[idx x y] <- true
            for (px, py) in paths do
                structureBlocked.[idx px py] <- true
            let markBuilding (b: Building) =
                for yy in b.Top .. b.Top + b.Height - 1 do
                    for xx in b.Left .. b.Left + b.Width - 1 do
                        if inMap xx yy then structureBlocked.[idx xx yy] <- true
            for b in buildings do
                markBuilding b
            let freeGround (x: int) (y: int) (minWater: int) =
                inMap x y
                && tiles.[idx x y] = int GroundTile.Grass
                && waterDistance.[idx x y] >= minWater
                && not structureBlocked.[idx x y]
            let cellW = 18
            let cellH = 14
            let tryField (cellX: int) (cellY: int) (roll: uint64) =
                let fw = 6 + int ((roll >>> 8) % 9UL) // 6..14
                let fh = 4 + int ((roll >>> 16) % 7UL) // 4..10
                let maxOffX = max 0 (cellW - 4 - fw)
                let maxOffY = max 0 (cellH - 4 - fh)
                let left = cellX + 2 + int ((roll >>> 24) % uint64 (maxOffX + 1))
                let top = cellY + 2 + int ((roll >>> 32) % uint64 (maxOffY + 1))
                let isPaddy = (roll >>> 40) % 2UL = 0UL
                let free =
                    left >= 1
                    && top >= 1
                    && left + fw - 1 <= w - 2
                    && top + fh - 1 <= h - 2
                    && [ for dy in 0 .. fh - 1 do
                           for dx in 0 .. fw - 1 -> (left + dx, top + dy) ]
                       |> List.forall (fun (x, y) -> freeGround x y 3)
                if free then
                    let code = if isPaddy then int GroundTile.PaddyField else int GroundTile.VegetablePlot
                    for dy in 0 .. fh - 1 do
                        for dx in 0 .. fw - 1 do
                            tiles.[idx (left + dx) (top + dy)] <- code
                    true
                else
                    false
            let tryGrove (cellX: int) (cellY: int) (roll: uint64) =
                let gw = 2 + int ((roll >>> 8) % 3UL) // 2..4
                let gh = 1 + int ((roll >>> 12) % 2UL) // 1..2
                let left = cellX + 2 + int ((roll >>> 16) % uint64 (max 1 (cellW - 4 - gw + 1)))
                let top = cellY + 2 + int ((roll >>> 24) % uint64 (max 1 (cellH - 4 - gh + 1)))
                let kind = if (roll >>> 32) % 2UL = 0UL then BambooClump else ShrubClump
                let cells = [ for dy in 0 .. gh - 1 do for dx in 0 .. gw - 1 -> (left + dx, top + dy) ]
                if cells |> List.forall (fun (x, y) -> freeGround x y 2) then
                    groves <- (cells |> List.map (fun (x, y) -> { Kind = kind; X = x; Y = y })) @ groves
                    true
                else
                    false
            let tryFarmhouse (cellX: int) (cellY: int) (roll: uint64) =
                let fw = 2 + int ((roll >>> 8) % 2UL) // 2..3
                let left = cellX + 2 + int ((roll >>> 12) % uint64 (max 1 (cellW - 4 - fw + 1)))
                let top = cellY + 2 + int ((roll >>> 20) % uint64 (max 1 (cellH - 4 - 2 + 1)))
                let doorX = left + fw / 2
                let doorY = top + 1
                let free =
                    left >= 1
                    && top >= 1
                    && left + fw - 1 <= w - 2
                    && top + 1 <= h - 2
                    && [ for dy in 0 .. 1 do
                           for dx in 0 .. fw - 1 -> (left + dx, top + dy) ]
                       |> List.forall (fun (x, y) -> freeGround x y 3)
                if free then
                    farmhouses <-
                        { Left = left
                          Top = top
                          Width = fw
                          Height = 2
                          DoorX = doorX
                          DoorY = doorY }
                        :: farmhouses
                    addPath doorX doorY
                    // 屋后小菜畦 2 行(留在本网格内,避免与邻格重叠)。
                    let gardenFree =
                        top + 3 <= h - 2
                        && [ for dy in 0 .. 1 do
                               for dx in 0 .. fw - 1 -> (left + dx, top + 2 + dy) ]
                           |> List.forall (fun (x, y) -> freeGround x y 3)
                    if gardenFree then
                        for dy in 0 .. 1 do
                            for dx in 0 .. fw - 1 do
                                tiles.[idx (left + dx) (top + 2 + dy)] <- int GroundTile.VegetablePlot
                    true
                else
                    false
            let mutable cellY = 0
            while cellY < h - 2 do
                let mutable cellX = 0
                while cellX < w - 2 do
                    let roll = nextCountry ()
                    let bucket = int (roll % 100UL)
                    if bucket < 58 then tryField cellX cellY roll |> ignore
                    elif bucket < 82 then tryGrove cellX cellY roll |> ignore
                    elif bucket < 84 then tryFarmhouse cellX cellY roll |> ignore
                    cellX <- cellX + cellW
                cellY <- cellY + cellH

        // 5c) P26:河岸装饰(护岸石垒/芦苇/垂柳),仅大图启用。纯视觉层,不写入任何瓦片,
        //     故 64x48/256x192 的 tiles checksum 与默认世界完全不受影响;装饰只落在紧邻水面的
        //     岸格,且避开路网/桥面/民居/核心区,保证不遮挡通行。
        let mutable decorations: RiverDecoration list = []
        if p.RiverDecorations then
            let mutable decorRng = p.Seed ^^^ 0xD3C0DEUL
            let nextDecor () =
                let nextState, raw = splitmix decorRng
                decorRng <- nextState
                raw
            let bridgeLookup = System.Collections.Generic.HashSet<int>(bridges |> List.map (fun (x, y) -> idx x y))
            let inBuildingFootprint x y =
                buildings
                |> List.exists (fun b ->
                    x >= b.Left - 1 && x <= b.Left + b.Width && y >= b.Top && y <= b.DoorY + 1)
            let blocked x y =
                not (inMap x y)
                || tiles.[idx x y] = int GroundTile.Water
                || pathSet.Contains(idx x y)
                || bridgeLookup.Contains(idx x y)
                || inCore x y
                || inBuildingFootprint x y
            let occupies (kind: RiverDecorationKind) (y: int) =
                if kind = Willow then [ y; y + 1 ] else [ y ]
            let tooClose (minimumSq: int) (kind: RiverDecorationKind) x y =
                decorations
                |> List.exists (fun d ->
                    let dyList = occupies d.Kind d.Y
                    occupies kind y
                    |> List.exists (fun cy ->
                        dyList
                        |> List.exists (fun oy ->
                            let dx = d.X - x
                            let dy = oy - cy
                            dx * dx + dy * dy < minimumSq)))
            let tryPlaceAt (minimumSq: int) (kind: RiverDecorationKind) x y =
                let tilesFree =
                    if kind = Willow then not (blocked x y) && not (blocked x (y + 1))
                    else not (blocked x y)
                if tilesFree && not (tooClose minimumSq kind x y) then
                    decorations <- { Kind = kind; X = x; Y = y } :: decorations
            // P26 单体点缀保持 3 格最小间距;P29 垂柳成丛,组内允许相邻 1 格。
            let tryPlace = tryPlaceAt 9
            let tryGrove = tryPlaceAt 1
            // 零星点缀只出芦苇/护岸石;垂柳完全交给成丛逻辑,避免再次退化为逐格等距。
            let scatterKindOf (roll: uint64) =
                if roll % 2UL = 0UL then Reeds else RevetmentStone
            // P29 聚落肌理:垂柳确定性成丛(2-3 株一丛),丛间留 3-5 格空档,与沿线成排的
            // 民居呼应;芦苇/护岸石仍零星点缀。仅大图分支执行,默认图不受影响。
            for river in riverBands do
                let lowerY = river.CenterY + river.Width
                let upperY = river.CenterY - 2
                let mutable lowerGrove = 0
                let mutable lowerCooldown = 0
                let mutable upperGrove = 0
                let mutable upperCooldown = 0
                for x in 2 .. w - 3 do
                    if lowerGrove > 0 then
                        tryGrove Willow x lowerY
                        lowerGrove <- lowerGrove - 1
                        if lowerGrove = 0 then lowerCooldown <- 2 + int (nextDecor () % 3UL)
                    elif lowerCooldown > 0 then
                        lowerCooldown <- lowerCooldown - 1
                    else
                        let lowerRoll = nextDecor ()
                        if lowerRoll % 24UL = 0UL then
                            lowerGrove <- 1 + int (nextDecor () % 2UL)
                            tryGrove Willow x lowerY
                        elif lowerRoll % 3UL <> 0UL then
                            tryPlace (scatterKindOf lowerRoll) x lowerY
                    if upperGrove > 0 then
                        tryGrove Willow x upperY
                        upperGrove <- upperGrove - 1
                        if upperGrove = 0 then upperCooldown <- 3 + int (nextDecor () % 3UL)
                    elif upperCooldown > 0 then
                        upperCooldown <- upperCooldown - 1
                    else
                        let upperRoll = nextDecor ()
                        if upperRoll % 32UL = 0UL then
                            upperGrove <- 1 + int (nextDecor () % 2UL)
                            tryGrove Willow x upperY
                        elif upperRoll % 4UL = 0UL then
                            tryPlace (scatterKindOf upperRoll) x (river.CenterY - 1)

        // 6) 30 个 spawn:核心区内的规则网格。
        let sc = max 2 p.SpawnColumns
        let sr = max 2 p.SpawnRows
        let spanX = max 1 (core.MaxX - core.MinX - 2)
        let spanY = max 1 (core.MaxY - core.MinY - 2)
        let spawns =
            [ for r in 0 .. sr - 1 do
                for c in 0 .. sc - 1 do
                    yield
                        (core.MinX + 1 + (c * spanX) / (sc - 1),
                         core.MinY + 1 + (r * spanY) / (sr - 1)) ]

        // 7) BFS(4 邻接、桥面可走):校验 spawn / 门 / 桥与两岸全部连通。
        let bridgeSet = System.Collections.Generic.HashSet<int>(bridges |> List.map (fun (x, y) -> idx x y))
        let walkable x y = tiles.[idx x y] <> int GroundTile.Water || bridgeSet.Contains(idx x y)
        let flood startX startY =
            let visited = Array.create (w * h) false
            let queue = System.Collections.Generic.Queue<int>()
            if walkable startX startY then
                let start = idx startX startY
                visited.[start] <- true
                queue.Enqueue start
            while queue.Count > 0 do
                let cur = queue.Dequeue()
                let x = cur % w
                let y = cur / w
                for dx, dy in [ (1, 0); (-1, 0); (0, 1); (0, -1) ] do
                    let nx = x + dx
                    let ny = y + dy
                    if nx >= 0 && nx < w && ny >= 0 && ny < h then
                        let ni = idx nx ny
                        if not visited.[ni] && walkable nx ny then
                            visited.[ni] <- true
                            queue.Enqueue ni
            visited

        let visited = flood (fst spawns.Head) (snd spawns.Head)
        let spawnsOk = spawns |> List.forall (fun (x, y) -> visited.[idx x y])
        let doorsOk = (buildings @ farmhouses) |> List.forall (fun b -> visited.[idx b.DoorX b.DoorY])
        let bridgesOk = bridges |> List.forall (fun (x, y) -> visited.[idx x y])
        let crossingsOk =
            bridgeColumns
            |> List.forall (fun (river, bx) -> visited.[idx bx (river.CenterY - 1)] && visited.[idx bx (river.CenterY + river.Width)])
        let reachableTiles = visited |> Array.filter id |> Array.length

        { Width = w
          Height = h
          Seed = p.Seed
          Tiles = tiles
          Core = core
          Spawns = spawns
          Rivers = riverBands
          Bridges = bridges
          Paths = paths
          Buildings = buildings
          Decorations = decorations
          Farmhouses = farmhouses
          Groves = groves
          MainRoadCenter = roadCenter
          ReachableTiles = reachableTiles
          ReachabilityOk = spawnsOk && doorsOk && bridgesOk
          BridgeCrossingsOk = crossingsOk }

    let generateWithSize (width: int) (height: int) (seed: uint64) : Result =
        generate (paramsForSize width height seed)

    /// 生成结果的确定性序列化(同 seed 逐字节一致),供回归测试与跨机核对。
    let serialize (map: Result) : string =
        let builder = System.Text.StringBuilder()
        builder.Append(map.Width).Append('x').Append(map.Height).Append('|').Append(map.Seed).Append('|') |> ignore
        for code in map.Tiles do
            builder.Append(code).Append(',') |> ignore
        builder.Append('|') |> ignore
        for river in map.Rivers do
            builder.Append(river.CenterY).Append('*').Append(river.Width).Append(';') |> ignore
        builder.Append('|') |> ignore
        for (x, y) in map.Bridges do
            builder.Append(x).Append(':').Append(y).Append(';') |> ignore
        builder.Append('|') |> ignore
        for (x, y) in map.Paths do
            builder.Append(x).Append(':').Append(y).Append(';') |> ignore
        builder.Append('|') |> ignore
        for building in map.Buildings do
            builder
                .Append(building.Left).Append(':').Append(building.Top).Append(':')
                .Append(building.Width).Append(':').Append(building.Height).Append(':')
                .Append(building.DoorX).Append(':').Append(building.DoorY).Append(';')
            |> ignore
        builder.Append('|') |> ignore
        let decorCode = function
            | RevetmentStone -> 0
            | Reeds -> 1
            | Willow -> 2
        for decoration in map.Decorations do
            builder
                .Append(decorCode decoration.Kind).Append(':')
                .Append(decoration.X).Append(':').Append(decoration.Y).Append(';')
            |> ignore
        builder.Append('|') |> ignore
        for building in map.Farmhouses do
            builder
                .Append(building.Left).Append(':').Append(building.Top).Append(':')
                .Append(building.Width).Append(':').Append(building.Height).Append(':')
                .Append(building.DoorX).Append(':').Append(building.DoorY).Append(';')
            |> ignore
        builder.Append('|') |> ignore
        let groveCode = function
            | BambooClump -> 0
            | ShrubClump -> 1
        for grove in map.Groves do
            builder
                .Append(groveCode grove.Kind).Append(':')
                .Append(grove.X).Append(':').Append(grove.Y).Append(';')
            |> ignore
        builder.Append('|') |> ignore
        for y in map.MainRoadCenter do
            builder.Append(y).Append(',') |> ignore
        builder.ToString()

    /// 可行走判定:非水,或位于桥面上(桥面仍标记为水但可通行)。
    let isWalkable (map: Result) (x: int) (y: int) : bool =
        if x < 0 || x >= map.Width || y < 0 || y >= map.Height then
            false
        else
            map.Tiles.[y * map.Width + x] <> int GroundTile.Water
            || (map.Bridges |> List.exists (fun (bx, by) -> bx = x && by = y))

    /// 从给定起点做 4 邻接洪泛(承认桥面),返回逐瓦片可达标记。
    let floodFill (map: Result) (startX: int) (startY: int) : bool array =
        let visited = Array.create (map.Width * map.Height) false
        let queue = System.Collections.Generic.Queue<int>()
        if isWalkable map startX startY then
            let start = startY * map.Width + startX
            visited.[start] <- true
            queue.Enqueue start
        while queue.Count > 0 do
            let cur = queue.Dequeue()
            let x = cur % map.Width
            let y = cur / map.Width
            for dx, dy in [ (1, 0); (-1, 0); (0, 1); (0, -1) ] do
                let nx = x + dx
                let ny = y + dy
                if isWalkable map nx ny then
                    let ni = ny * map.Width + nx
                    if not visited.[ni] then
                        visited.[ni] <- true
                        queue.Enqueue ni
        visited

    // ---- 视口裁剪(纯函数):只绘制可见瓦片,与 drawWorld 现有窗口一致 ----

    /// 返回含端点的可见瓦片范围 (x0, y0, x1, y1);空视口返回 (0,0,-1,-1)。
    let visibleTileRange (mapWidth: int) (mapHeight: int) (cameraX: int) (cameraY: int) (viewportWidth: int) (viewportHeight: int) : int * int * int * int =
        let x0 = max 0 (cameraX / Sim.tilePixels)
        let y0 = max 0 (cameraY / Sim.tilePixels)
        let x1 = min (mapWidth - 1) ((cameraX + viewportWidth) / Sim.tilePixels + 1)
        let y1 = min (mapHeight - 1) ((cameraY + viewportHeight) / Sim.tilePixels + 1)
        if mapWidth <= 0 || mapHeight <= 0 || x1 < x0 || y1 < y0 then (0, 0, -1, -1) else (x0, y0, x1, y1)

    let visibleTileCount (mapWidth: int) (mapHeight: int) (cameraX: int) (cameraY: int) (viewportWidth: int) (viewportHeight: int) : int =
        let x0, y0, x1, y1 = visibleTileRange mapWidth mapHeight cameraX cameraY viewportWidth viewportHeight
        if x1 < x0 || y1 < y0 then 0 else (x1 - x0 + 1) * (y1 - y0 + 1)