diff options
Diffstat (limited to 'src/LivingVillage.Desktop/MapGen.fs')
| -rw-r--r-- | src/LivingVillage.Desktop/MapGen.fs | 165 |
1 files changed, 114 insertions, 51 deletions
diff --git a/src/LivingVillage.Desktop/MapGen.fs b/src/LivingVillage.Desktop/MapGen.fs index 3705635..a9d6c9f 100644 --- a/src/LivingVillage.Desktop/MapGen.fs +++ b/src/LivingVillage.Desktop/MapGen.fs @@ -36,7 +36,10 @@ module MapGen = /// P25：是否放置孤立装饰石块。默认 true；大图关闭，避免草地上出现游离石板 tile。 DecorativeStones: bool /// P26：是否沿海河岸放置河岸装饰（护岸石垒/芦苇/垂柳）。默认 false；仅大图开启。 - RiverDecorations: bool } + RiverDecorations: bool + /// P29：大图聚落组团发牌种子（group seeding）。默认 0 且在非大图分支不使用， + /// 故 64x48/256x192 的 structureRng 流与输出逐字节不变。 + ClusterSeed: uint64 } /// P20 第二步：一条贯穿全图的东西向河道（每列恰好一段，宽度下限 RiverWidth）。 type River = @@ -92,12 +95,14 @@ module MapGen = SpawnRows = 6 ExtraRiversideHouses = 0 DecorativeStones = true - RiverDecorations = false } + 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 @@ -107,7 +112,8 @@ module MapGen = RiverCount = max base_.RiverCount (max 1 (height / 96)) ExtraRiversideHouses = (if large then 16 else 0) DecorativeStones = not large - RiverDecorations = large } + RiverDecorations = large + ClusterSeed = (if large then seed ^^^ 0xC1A57E2UL else 0UL) } // ---- splitmix64 与 value noise（无外部依赖、无时钟） ---- @@ -305,11 +311,12 @@ module MapGen = buildings <- building :: buildings addPath building.DoorX building.DoorY - // 5b) P24：大图沿河民居加密。从既有路网瓦片出发，向四邻定向落位 3x2 白墙黛瓦民居， - // 门开向相邻路格并接入路网（BFS 可达）；仅在 ExtraRiversideHouses>0 时执行， - // 且只在核心区外的草地落位，故 64x48/256x192 输出逐字节不变。 - // P28：宽度按 2/3/4 加权变化（2=附属小筑、4=大宅），形成聚落层次而非等距重复； - // 数量 10 -> 16（沿河再增 6 座）。仍只在大图分支执行，默认图 RNG 不消耗，checksum 不变。 + // 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 @@ -323,34 +330,63 @@ module MapGen = |> List.exists (fun b -> left < b.Left + b.Width && b.Left < left + width && top < b.Top + b.Height && b.Top < top + 2) - let directions = [ (0, -1); (0, 1); (-1, 0); (1, 0) ] + // 横向路段的连续格（主街/河岸路），先按 (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 - let mutable extraAttempts = 0 - let maxAttempts = p.ExtraRiversideHouses * 400 - while extraPlaced < p.ExtraRiversideHouses && extraAttempts < maxAttempts && paths.Length > 0 do - extraAttempts <- extraAttempts + 1 - let nextState, raw = splitmix structureRng - structureRng <- nextState - if paths.Length > 0 then - let pathX, pathY = List.item (int (raw % uint64 paths.Length)) paths - let dirX, dirY = directions.[int ((raw >>> 32) % 4UL)] - let widthRoll = int ((raw >>> 40) % 10UL) - let buildingWidth = if widthRoll < 5 then 3 elif widthRoll < 8 then 2 else 4 - let doorX = pathX + dirX - let doorY = pathY + dirY - let left = doorX - buildingWidth / 2 - let top = doorY - 1 - 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 + 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 与默认世界完全不受影响；装饰只落在紧邻水面的 @@ -376,7 +412,7 @@ module MapGen = || inBuildingFootprint x y let occupies (kind: RiverDecorationKind) (y: int) = if kind = Willow then [ y; y + 1 ] else [ y ] - let tooClose (kind: RiverDecorationKind) x y = + let tooClose (minimumSq: int) (kind: RiverDecorationKind) x y = decorations |> List.exists (fun d -> let dyList = occupies d.Kind d.Y @@ -386,28 +422,55 @@ module MapGen = |> List.exists (fun oy -> let dx = d.X - x let dy = oy - cy - dx * dx + dy * dy < 9))) - let tryPlace (kind: RiverDecorationKind) x y = + 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 kind x y) then + if tilesFree && not (tooClose minimumSq kind x y) then decorations <- { Kind = kind; X = x; Y = y } :: decorations - let kindOf (roll: uint64) = - match int (roll % 3UL) with - | 1 -> Reeds - | 2 -> Willow - | _ -> RevetmentStone + // 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 - let lowerRoll = nextDecor () - if lowerRoll % 3UL <> 0UL then - tryPlace (kindOf lowerRoll) x (river.CenterY + river.Width) - if nextDecor () % 4UL = 0UL then + 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 () - let kind = kindOf upperRoll - let anchorY = if kind = Willow then river.CenterY - 2 else river.CenterY - 1 - tryPlace kind x anchorY + 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 |