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 } /// P20 第二步:一条贯穿全图的东西向河道(每列恰好一段,宽度下限 RiverWidth)。 type River = { CenterY: int Width: int } /// 沿河民居色块:白墙黑瓦矩形屋顶,门开向石板路。 type Building = { Left: int Top: int Width: int Height: int DoorX: int DoorY: 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 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 } // ---- 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 叠加;特征尺度随地图宽度等比缩放,保证小图/大图观感一致。 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 = float32 w / 64.0f 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 % 2 = 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 } else 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 } ] 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 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() 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 // 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 |> 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 ReachableTiles = reachableTiles ReachabilityOk = spawnsOk && doorsOk && bridgesOk BridgeCrossingsOk = crossingsOk } let generateWithSize (width: int) (height: int) (seed: uint64) : Result = generate { defaultParams seed with Width = width; Height = height } /// 可行走判定:非水,或位于桥面上(桥面仍标记为水但可通行)。 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)