path: root/src/LivingVillage.Desktop/MapGen.fs

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 }

    type Result =
        { Width: int
          Height: int
          Seed: uint64
          Tiles: int array
          Core: Bounds
          Spawns: (int * int) list
          ReachableTiles: int
          ReachabilityOk: 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<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 = 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) 河道：RiverCount 条自西向东随机游走，宽度 RiverWidth。
        let mutable rng = p.Seed ^^^ 0xBEEFUL
        for _ in 1 .. max 0 p.RiverCount do
            let nextState, rawStartY = splitmix rng
            rng <- nextState
            let mutable y = 2 + int (rawStartY % uint64 (max 1 (h - 4)))
            for x in 2 .. w - 3 do
                let nextStep, rawStep = splitmix rng
                rng <- nextStep
                let drift = int (rawStep % 3UL) - 1
                y <- max 2 (min (h - 3) (y + drift))
                for dy in 0 .. p.RiverWidth - 1 do
                    let yy = y + dy
                    if yy <= h - 2 && not (inCore x yy) then
                        tiles.[idx x yy] <- 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 = rng
        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) 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)) ]

        // 6) BFS（4 邻接、非水可走）：从核心中心洪泛，校验全部 spawn 可达。
        let walkable x y = tiles.[idx x y] <> int GroundTile.Water
        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 carve (sx: int) (sy: int) =
            let mutable x = sx
            while x <> cx do
                x <- x + sign (cx - x)
                if tiles.[idx x sy] = int GroundTile.Water then tiles.[idx x sy] <- int GroundTile.Grass
            let mutable y = sy
            while y <> cy do
                y <- y + sign (cy - y)
                if tiles.[idx x y] = int GroundTile.Water then tiles.[idx x y] <- int GroundTile.Grass

        let mutable visited = flood cx cy
        let unreachable = spawns |> List.filter (fun (x, y) -> not visited.[idx x y])
        for spawn in unreachable do
            carve (fst spawn) (snd spawn)
        if not unreachable.IsEmpty then
            visited <- flood cx cy

        let reachableTiles = visited |> Array.filter id |> Array.length
        let reachabilityOk = spawns |> List.forall (fun (x, y) -> visited.[idx x y])

        { Width = w
          Height = h
          Seed = p.Seed
          Tiles = tiles
          Core = core
          Spawns = spawns
          ReachableTiles = reachableTiles
          ReachabilityOk = reachabilityOk }

    let generateWithSize (width: int) (height: int) (seed: uint64) : Result =
        generate { defaultParams seed with Width = width; Height = height }

    // ---- 视口裁剪（纯函数）：只绘制可见瓦片，与 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)