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 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 (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() 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() 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(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(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() 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() 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)