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
|
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 / 渲染映射保持一致。
type GroundTile =
| Grass = 0
| Water = 1
| Stone = 2
| Peat = 3
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 }
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
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、不进入组团分支。
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 16 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 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
for x in 1 .. w - 2 do
addPath x roadY
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 yLo = min (river.CenterY - 1) roadY
let yHi = max (river.CenterY + river.Width) roadY
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:大图沿河聚落组团。仅在 ExtraRiversideHouses>0 时执行,只落在核心区外
// 草地并避免与既有民居重叠,故 64x48/256x192 输出逐字节不变。
// P29:不改「沿路随机散点」,而是沿横向石板路(主街 + 河岸路)成排成组落位:
// 每组 2-4 座、组内 1 格间隙、组间留 4-6 格空档,形成「沿河成排 / 桥头小广场」的
// 聚落肌理;组发牌使用独立 clusterRng(group seeding),不触碰既有 structureRng,
// 桥/路/灯笼等基础结构坐标不受影响。宽度仍按 2/3/4 加权(附属小筑/民居/大宅)。
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 打散成确定性布线顺序。
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, _) -> (hash2 y x0 p.ClusterSeed))
let mutable clusterRng = p.ClusterSeed
let nextCluster () =
let nextState, raw = splitmix clusterRng
clusterRng <- nextState
raw
let mutable extraPlaced = 0
for (runY, runStart, runEnd) in horizontalRuns do
if extraPlaced < p.ExtraRiversideHouses then
let runLength = runEnd - runStart + 1
// 主街长路段多放,河岸短路各放一小簇。
let quota = min (p.ExtraRiversideHouses - extraPlaced) (if runLength >= 64 then 6 else 3)
// 默认屋在路北(门贴路南缘);北侧容不下时改南侧(沿用既有岸屋「门在顶排」口径)。
let sideFits above =
let top = if above then runY - 2 else runY + 1
[ runStart .. min runEnd (runStart + 4) ]
|> List.exists (fun x -> footprintFree x top 3)
let above = if sideFits true then true else not (sideFits false)
let mutable x = runStart + int (nextCluster () % 2UL)
let mutable placedHere = 0
while placedHere < quota && x + 1 <= runEnd do
let groupSize = 2 + int (nextCluster () % 3UL)
for _ in 1 .. groupSize do
if placedHere < quota && x + 1 <= runEnd then
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
if footprintFree left top buildingWidth && not (overlaps left top buildingWidth) then
let building =
{ Left = left
Top = top
Width = buildingWidth
Height = 2
DoorX = doorX
DoorY = doorY }
buildings <- building :: buildings
addPath building.DoorX building.DoorY
extraPlaced <- extraPlaced + 1
placedHere <- placedHere + 1
x <- x + buildingWidth + 1
// 组间空档:保持可控行距与组团边界。
x <- x + 4 + int (nextCluster () % 3UL)
// 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 |> 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
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.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)
|