diff options
| author | Somhairle H. Marisol <[email protected]> | 2026-09-28 23:06:20 +0800 |
|---|---|---|
| committer | Somhairle H. Marisol <[email protected]> | 2026-09-28 23:06:20 +0800 |
| commit | 07f2e072a14cc74133b187bb8715758790cdfe67 (patch) | |
| tree | 715efbba87d3be156e927ed5c3ed857a274ea1ae /src | |
| parent | a26ba18e9710dcdac57d942d2d7ac1ce1e47ca1a (diff) | |
| download | living-village-07f2e072a14cc74133b187bb8715758790cdfe67.tar.gz | |
p52: 玩家交易通道——买/卖经 Sim.quotePrice→Occupation.biasedQuote,背包侧车/钱财增减 + v3 round-trip + HUD 短反馈(design §2.4-2)
Diffstat (limited to 'src')
| -rw-r--r-- | src/LivingVillage.Desktop.Tests/LivingVillage.Desktop.Tests.fsproj | 1 | ||||
| -rw-r--r-- | src/LivingVillage.Desktop.Tests/P52ProfessionTradeTests.fs | 125 | ||||
| -rw-r--r-- | src/LivingVillage.Desktop/Game.fs | 103 | ||||
| -rw-r--r-- | src/LivingVillage.Desktop/Interaction.fs | 40 | ||||
| -rw-r--r-- | src/LivingVillage.Desktop/LivingVillage.Desktop.fsproj | 1 | ||||
| -rw-r--r-- | src/LivingVillage.Desktop/PlayerTrade.fs | 230 |
6 files changed, 494 insertions, 6 deletions
diff --git a/src/LivingVillage.Desktop.Tests/LivingVillage.Desktop.Tests.fsproj b/src/LivingVillage.Desktop.Tests/LivingVillage.Desktop.Tests.fsproj index 0e81630..85381fc 100644 --- a/src/LivingVillage.Desktop.Tests/LivingVillage.Desktop.Tests.fsproj +++ b/src/LivingVillage.Desktop.Tests/LivingVillage.Desktop.Tests.fsproj @@ -29,6 +29,7 @@ <Compile Include="P47SceneDetailTests.fs" /> <Compile Include="P48MapDigestTests.fs" /> <Compile Include="P51ProfessionSliceTests.fs" /> + <Compile Include="P52ProfessionTradeTests.fs" /> <Compile Include="SampleTests.fs" /> </ItemGroup> diff --git a/src/LivingVillage.Desktop.Tests/P52ProfessionTradeTests.fs b/src/LivingVillage.Desktop.Tests/P52ProfessionTradeTests.fs new file mode 100644 index 0000000..acae483 --- /dev/null +++ b/src/LivingVillage.Desktop.Tests/P52ProfessionTradeTests.fs @@ -0,0 +1,125 @@ +namespace LivingVillage.Desktop.Tests + +open System +open System.IO +open Microsoft.VisualStudio.TestTools.UnitTesting +open LivingVillage.Kernel +open LivingVillage.Kernel.Sim +open LivingVillage.Headless +open LivingVillage.Desktop + +/// P52 职业切片二:物品侧车 → 玩家可用(docs/design-professions.md §2.4-2)。 +/// (a) 玩家买/卖 = `Sim.quotePrice` → `Occupation.biasedQuote`,四职业偏置生效,背包/钱随之增减; +/// (b) 交易后 v3 存档 round-trip 读回背包与钱一致; +/// (c) 交易不进 `Sim.step` 数值路径,基线 digest 钉值 953775FA… 不变。 +[<TestClass>] +type P52ProfessionTradeTests () = + + let seed = 42UL + + let buildWorld (kind: Occupation.Kind) : World * Occupation.State = + let state = WorldBootstrap.occupationStateFor seed kind 0L + let world = WorldBootstrap.initialWorldWithOccupation false seed 4 (Some state) + { world with Tick = 0L; Time = 0.0 }, state + + let npcId (world: World) = world.Npcs.[0].Id + let money (world: World) = world.Avatar.Mind.Needs.Money + let bag (state: Occupation.State) (item: ItemKind) = Occupation.backpackQuantity item state + + let allKinds = [ Occupation.Farmer; Occupation.Fisher; Occupation.Peddler; Occupation.Scholar ] + + [<TestMethod>] + member _.QuoteAppliesProfessionBiasOverSimQuotePrice () = + for kind in allKinds do + let world, state = buildWorld kind + let npc = npcId world + let baseBuy = PlayerTrade.quoteBase (Some state) true npc Sim.Food 1 world + let baseSell = PlayerTrade.quoteBase (Some state) false npc Sim.Food 1 world + Assert.IsTrue(baseBuy.IsSome, "base buy quote expected") + Assert.IsTrue(baseSell.IsSome, "base sell quote expected") + Assert.AreEqual<float32>( + baseBuy.Value * Occupation.quoteBiasOf (Some kind) true, + (PlayerTrade.quote (Some state) true npc Sim.Food 1 world).Value) + Assert.AreEqual<float32>( + baseSell.Value * Occupation.quoteBiasOf (Some kind) false, + (PlayerTrade.quote (Some state) false npc Sim.Food 1 world).Value) + // 无职业 = 恒等 1.0(与 TradeBiasTests 锁定的口径一致) + let worldNone = WorldBootstrap.initialWorldWithOccupation false seed 4 None + let npcNone = worldNone.Npcs.[0].Id + Assert.AreEqual<float32 option>( + PlayerTrade.quoteBase None true npcNone Sim.Food 1 worldNone, + PlayerTrade.quote None true npcNone Sim.Food 1 worldNone) + + [<TestMethod>] + member _.PeddlerAndScholarBiasDirectionsMatchDesign () = + let check kind expectedBuy expectedSell = + let world, state = buildWorld kind + let npc = npcId world + let baseBuy = (PlayerTrade.quoteBase (Some state) true npc Sim.Food 1 world).Value + let baseSell = (PlayerTrade.quoteBase (Some state) false npc Sim.Food 1 world).Value + Assert.AreEqual<float32>(baseBuy * expectedBuy, (PlayerTrade.quote (Some state) true npc Sim.Food 1 world).Value) + Assert.AreEqual<float32>(baseSell * expectedSell, (PlayerTrade.quote (Some state) false npc Sim.Food 1 world).Value) + check Occupation.Peddler 0.97f 1.03f + check Occupation.Scholar 0.99f 1.01f + check Occupation.Farmer 1.0f 1.0f + check Occupation.Fisher 1.0f 1.0f + + [<TestMethod>] + member _.BuyAndSellUpdateBackpackAndMoney () = + for kind in allKinds do + let world, state = buildWorld kind + let npc = npcId world + let unitBuy = (PlayerTrade.quote (Some state) true npc Sim.Food 1 world).Value + let money0 = money world + let food0 = bag state Sim.Food + let buy = PlayerTrade.buy (Some state) npc Sim.Food 1 world + Assert.IsTrue(buy.Succeeded, sprintf "%A buy should succeed" kind) + let stateAfterBuy = buy.Occupation.Value + Assert.AreEqual<int>(food0 + 1, bag stateAfterBuy Sim.Food) + Assert.AreEqual<float32>(money0 - unitBuy, money buy.World) + let unitSell = (PlayerTrade.quote (Some stateAfterBuy) false npc Sim.Food 1 buy.World).Value + let moneyAfterBuy = money buy.World + let sell = PlayerTrade.sell (Some stateAfterBuy) npc Sim.Food 1 buy.World + Assert.IsTrue(sell.Succeeded, sprintf "%A sell should succeed" kind) + let stateAfterSell = sell.Occupation.Value + Assert.AreEqual<int>(food0, bag stateAfterSell Sim.Food) + Assert.AreEqual<float32>(moneyAfterBuy + unitSell, money sell.World) + + [<TestMethod>] + member _.TradeRejectsWithoutProfessionOrFunds () = + let worldNone = WorldBootstrap.initialWorldWithOccupation false seed 4 None + let noProfession = PlayerTrade.buy None (worldNone.Npcs.[0].Id) Sim.Food 1 worldNone + Assert.IsFalse(noProfession.Succeeded) + let world, state = buildWorld Occupation.Farmer + let npc = npcId world + let tooMuch = PlayerTrade.buy (Some state) npc Sim.Food 999 world + Assert.IsFalse(tooMuch.Succeeded) + // Farmer 背包有食物,卖首件成功;空背包卖首件失败 + Assert.IsTrue((PlayerTrade.sellFirst (Some state) npc world).Succeeded) + let emptied = { Occupation.stateOf Occupation.Farmer with Backpack = [] } + Assert.IsFalse((PlayerTrade.sellFirst (Some emptied) npc world).Succeeded) + + [<TestMethod>] + member _.TradeSurvivesSaveRoundTrip () = + let world, state = buildWorld Occupation.Peddler + let npc = npcId world + let buy = PlayerTrade.buy (Some state) npc Sim.Food 2 world + Assert.IsTrue(buy.Succeeded) + let path = Path.Combine(Path.GetTempPath(), "living-village-p52-" + Guid.NewGuid().ToString("N") + ".save") + try + WorldSave.saveToFileWith buy.Occupation path buy.World + match WorldSave.loadFromFileWith path with + | Ok (restored, Some restoredState) -> + Assert.AreEqual<(ItemKind * int) list>(buy.Occupation.Value.Backpack, restoredState.Backpack) + Assert.AreEqual<float32>(money buy.World, money restored) + | Ok (_, None) -> Assert.Fail("occupation sidecar must round-trip") + | Error message -> Assert.Fail(message) + finally + if File.Exists path then File.Delete path + + [<TestMethod>] + member _.SimBaselineDigestStaysPinned () = + let world = PerformanceProbe.runSteps PerformanceProbe.defaultConfiguration + Assert.AreEqual<string>( + "953775FAEB2FDDE97289491AA260BD8D390C571E48A7A13AD2CB6FB7124F7F6C", + PerformanceProbe.worldDigest world) diff --git a/src/LivingVillage.Desktop/Game.fs b/src/LivingVillage.Desktop/Game.fs index db39566..0dce3a9 100644 --- a/src/LivingVillage.Desktop/Game.fs +++ b/src/LivingVillage.Desktop/Game.fs @@ -336,6 +336,20 @@ type LivingVillageGame() as this = let mutable p47Step = 0 let mutable p47PendingName = "" let mutable p47Pending = false + // P52 证据钩子:LV_P52_SHOT=1 时选职业开局 → 走到 NPC 旁用真实 Interact 开对话 → + // 真实 BuyFromTarget / SellToTarget 各一次,拍「对话入口 / 买入后 / 卖出后」三帧; + // 每笔交易打印钱与背包数量前后值,供 analyze 脚本算 delta。 + // LV_P52_OCCUPATION=farmer|fisher|peddler|scholar(默认 peddler)。 + let p52ShotMode = Environment.GetEnvironmentVariable("LV_P52_SHOT") = "1" + let p52Occupation = + match Environment.GetEnvironmentVariable("LV_P52_OCCUPATION") with + | "farmer" -> Occupation.Farmer + | "fisher" -> Occupation.Fisher + | "scholar" -> Occupation.Scholar + | _ -> Occupation.Peddler + let mutable p52Step = 0 + let mutable p52PendingName = "" + let mutable p52Pending = false let mutable autoplayFrames = 0 let mutable flowStep = 0 let mutable flowHold = 0 @@ -1106,6 +1120,77 @@ type LivingVillageGame() as this = p47PendingName world.Tick world.Avatar.Pos.X world.Avatar.Pos.Y camera.X camera.Y p47Step <- p47Step + 1 + /// P52 证据:选职业开局 → 真实 Interact 开对话 → 真实 BuyFromTarget / SellToTarget 各一次。 + member private this.PrepareP52Shot () = + let setHour (hour: float) = + let tick = M6Presentation.resolveStartTick (Some hour) false + world <- { world with Tick = tick; Time = float tick * Sim.dtSeconds } + let bagText () = + match m5View.Task with + | None -> "-" + | Some state -> + state.Backpack + |> List.map (fun (item, quantity) -> sprintf "%A=%d" item quantity) + |> String.concat ";" + if not p52Pending then + match p52Step with + | 0 -> + setHour 12.0 + let npc = world.Npcs.[0] + world <- { world with Avatar = { world.Avatar with Pos = npc.Pos } } + let nextWorld, nextView = M5Interaction.apply M5Command.Interact world m5View + world <- nextWorld + m5View <- nextView + this.CenterCamera() + p52PendingName <- "p52-dialog" + p52Pending <- true + | 1 -> + let moneyBefore = world.Avatar.Mind.Needs.Money + let bagBefore = bagText () + let nextWorld, nextView = M5Interaction.apply M5Command.BuyFromTarget world m5View + world <- nextWorld + m5View <- nextView + printfn "p52-trade buy npc=%A money_before=%.2f money_after=%.2f bag_before=[%s] bag_after=[%s] status=%s" + world.Npcs.[0].Id moneyBefore world.Avatar.Mind.Needs.Money bagBefore (bagText ()) m5View.Status + p52PendingName <- "p52-buy" + p52Pending <- true + | 2 -> + let reopenedWorld, reopenedView = M5Interaction.apply M5Command.Interact world m5View + world <- reopenedWorld + m5View <- reopenedView + let moneyBefore = world.Avatar.Mind.Needs.Money + let bagBefore = bagText () + let nextWorld, nextView = M5Interaction.apply M5Command.SellToTarget world m5View + world <- nextWorld + m5View <- nextView + printfn "p52-trade sell npc=%A money_before=%.2f money_after=%.2f bag_before=[%s] bag_after=[%s] status=%s" + world.Npcs.[0].Id moneyBefore world.Avatar.Mind.Needs.Money bagBefore (bagText ()) m5View.Status + p52PendingName <- "p52-sell" + p52Pending <- true + | _ -> + printfn "p52-shot=done" + this.Exit() + + /// P52 证据:在 `Draw` 末尾落盘每帧,并打印面板/反馈/背包快照。 + member private this.CaptureP52Shot () = + if p52Pending then + p52Pending <- false + System.IO.Directory.CreateDirectory recordDirectory |> ignore + this.SaveBackBuffer(sprintf "%s/%s.png" recordDirectory p52PendingName) + let bag = + match m5View.Task with + | None -> "-" + | Some state -> + state.Backpack + |> List.map (fun (item, quantity) -> sprintf "%A=%d" item quantity) + |> String.concat ";" + printfn "p52-shot=%s panel=%s status=%s bag=[%s]" + p52PendingName + (M5Interaction.panelName m5View) + m5View.Status + bag + p52Step <- p52Step + 1 + /// P46 证据:菜单阶段按帧表把 menuEntranceFrame 钉到灯笼呼吸的波峰/波谷,拍两相位。 member private this.PrepareP46Shot () = if p46MenuADone && p46MenuBDone then @@ -1249,13 +1334,15 @@ type LivingVillageGame() as this = | None -> () let m5Command = if overlayOpen then - // P44:弹层开启只允许对话选项 1-6;E/Q/Tab/C/T 等世界交互键全部屏蔽,不穿透。 + // P44:弹层开启只允许对话选项 1-6 + P52 买卖键;E/Q/Tab/C/T 等世界交互键全部屏蔽,不穿透。 if m5View.Panel = DialoguePanel && pressedAny [ Keys.D1; Keys.NumPad1 ] then Some Intent1 elif m5View.Panel = DialoguePanel && pressedAny [ Keys.D2; Keys.NumPad2 ] then Some Intent2 elif m5View.Panel = DialoguePanel && pressedAny [ Keys.D3; Keys.NumPad3 ] then Some Intent3 elif m5View.Panel = DialoguePanel && pressedAny [ Keys.D4; Keys.NumPad4 ] then Some Intent4 elif m5View.Panel = DialoguePanel && pressedAny [ Keys.D5; Keys.NumPad5 ] then Some Intent5 elif m5View.Panel = DialoguePanel && pressedAny [ Keys.D6; Keys.NumPad6 ] then Some Intent6 + elif m5View.Panel = DialoguePanel && pressed Keys.B then Some BuyFromTarget + elif m5View.Panel = DialoguePanel && pressed Keys.V then Some SellToTarget else None else if M5Interaction.worldInputAllowed m5View && pressed Keys.E then Some Interact @@ -1265,6 +1352,8 @@ type LivingVillageGame() as this = elif m5View.Panel = DialoguePanel && pressedAny [ Keys.D4; Keys.NumPad4 ] then Some Intent4 elif m5View.Panel = DialoguePanel && pressedAny [ Keys.D5; Keys.NumPad5 ] then Some Intent5 elif m5View.Panel = DialoguePanel && pressedAny [ Keys.D6; Keys.NumPad6 ] then Some Intent6 + elif m5View.Panel = DialoguePanel && pressed Keys.B then Some BuyFromTarget + elif m5View.Panel = DialoguePanel && pressed Keys.V then Some SellToTarget elif pressed Keys.Q then Some Observe elif pressed Keys.Tab then Some ToggleNeeds elif pressed Keys.C then Some ShowChronicle @@ -1513,6 +1602,16 @@ type LivingVillageGame() as this = else this.DispatchMenuInput Confirm elif menu.Page = Playing then this.PrepareP47Shot() + elif p52ShotMode then + if menu.Page = MainMenu then + this.DispatchMenuInput Confirm + elif menu.Page = OccupationSelect then + let targetIndex = + MenuState.occupationOptions |> List.findIndex (fun option -> option = Some p52Occupation) + if menu.Selected <> targetIndex then this.DispatchMenuInput Down + else this.DispatchMenuInput Confirm + elif menu.Page = Playing then + this.PrepareP52Shot() elif menu.Page = Playing then this.UpdatePlaying gameTime kb pressed pressedAny elif menuShotMode then @@ -1926,6 +2025,8 @@ type LivingVillageGame() as this = this.CaptureP46Shot() if p47ShotMode && menu.Page = Playing then this.CaptureP47Shot() + if p52ShotMode && menu.Page = Playing then + this.CaptureP52Shot() /// 启动画面:分层天色 + 屋脊/水面剪影 + 标题淡入上浮 + 跳过提示,全部为帧计数纯函数。 member private this.DrawSplash() = diff --git a/src/LivingVillage.Desktop/Interaction.fs b/src/LivingVillage.Desktop/Interaction.fs index 9aceff6..6a34b40 100644 --- a/src/LivingVillage.Desktop/Interaction.fs +++ b/src/LivingVillage.Desktop/Interaction.fs @@ -32,6 +32,8 @@ type M5Command = | Intent4 | Intent5 | Intent6 + | BuyFromTarget + | SellToTarget | Observe | ToggleNeeds | ShowChronicle @@ -352,7 +354,9 @@ module M5Interaction = | Intent3 | Intent4 | Intent5 - | Intent6 -> view.Panel = DialoguePanel + | Intent6 + | BuyFromTarget + | SellToTarget -> view.Panel = DialoguePanel | Observe | ToggleNeeds | ShowChronicle @@ -406,6 +410,25 @@ module M5Interaction = | Intent4 -> chooseIntent 3 world view | Intent5 -> chooseIntent 4 world view | Intent6 -> chooseIntent 5 world view + | BuyFromTarget + | SellToTarget -> + match view.Menu with + | None -> world, { view with Status = "no dialogue menu; press E near an NPC" } + | Some menu -> + // P52:玩家买/卖走既有 Trade 路径(Sim.quotePrice → Occupation.biasedQuote), + // 成交后回到世界面板,让短暂反馈通道显示结果。 + let outcome = + if command = BuyFromTarget then PlayerTrade.buyFood view.Task menu.Target world + else PlayerTrade.sellFirst view.Task menu.Target world + outcome.World, + { view with + Panel = WorldPanel + Menu = None + Prompt = None + PromptTargetPos = None + Task = outcome.Occupation + Status = (if outcome.Succeeded then "trade ok|" else "trade fail|") + outcome.Message + StatusTick = Some outcome.World.Tick } | Observe -> let observations = Sim.observeVisible (observationBounds world) world world, @@ -514,6 +537,8 @@ module M5Interaction = | value when value.StartsWith("observation") -> "观察完成" | value when value.StartsWith("chronicle") -> "年鉴已打开" | "task panel open" -> "任务面板已打开" + | value when value.StartsWith("trade ok|") -> value.Substring("trade ok|".Length) + | value when value.StartsWith("trade fail|") -> "交易失败:" + value.Substring("trade fail|".Length) | value when value.StartsWith("no dialogue") -> "当前没有可用对话" | value when value.StartsWith("invalid dialogue") -> "对话选项无效" | value when value.StartsWith("no nearby") -> "附近没有可互动目标" @@ -552,9 +577,12 @@ module M5Interaction = | TradeAnnal event -> match event.Kind with | TradeEvent(buyer, seller, item, quantity, unitPrice) -> - sprintf "交易:村民 %d 从村民 %d 获得%s ×%d,单价 %.2f" - (npcNumber buyer) - (npcNumber seller) + // P52:玩家交易以 playerId 记事件,年鉴里显示为「玩家」而非「村民 -1」。 + let participant (id: NpcId) = + if id = playerId then "玩家" else sprintf "村民 %d" (npcNumber id) + sprintf "交易:%s 从 %s 获得%s ×%d,单价 %.2f" + (participant buyer) + (participant seller) (itemName item) quantity unitPrice @@ -613,7 +641,9 @@ module M5Interaction = let options = menu.Options |> List.mapi (fun index intent -> sprintf "%d %s" (index + 1) (intentName intent)) - [ sprintf "互动:村民 %d" (npcNumber menu.Target) ] @ options @ [ "ESC 关闭"; status ] + [ sprintf "互动:村民 %d" (npcNumber menu.Target) ] + @ options + @ [ "B 买入 食物×1"; "V 卖出 背包物品×1"; "ESC 关闭"; status ] | ChroniclePanel -> let entries = chronicleLines world "年鉴" :: (if entries.IsEmpty then [ "暂无记录" ] else entries) @ [ status ] diff --git a/src/LivingVillage.Desktop/LivingVillage.Desktop.fsproj b/src/LivingVillage.Desktop/LivingVillage.Desktop.fsproj index 9aa3f94..b3243e2 100644 --- a/src/LivingVillage.Desktop/LivingVillage.Desktop.fsproj +++ b/src/LivingVillage.Desktop/LivingVillage.Desktop.fsproj @@ -10,6 +10,7 @@ <Compile Include="ProceduralMap.fs" /> <Compile Include="MapGen.fs" /> <Compile Include="WorldBootstrap.fs" /> + <Compile Include="PlayerTrade.fs" /> <Compile Include="CharacterArt.fs" /> <Compile Include="FloaterArt.fs" /> <Compile Include="VillageArt.fs" /> diff --git a/src/LivingVillage.Desktop/PlayerTrade.fs b/src/LivingVillage.Desktop/PlayerTrade.fs new file mode 100644 index 0000000..e1ea53e --- /dev/null +++ b/src/LivingVillage.Desktop/PlayerTrade.fs @@ -0,0 +1,230 @@ +namespace LivingVillage.Desktop + +open LivingVillage.Kernel +open LivingVillage.Kernel.Sim + +/// P52 职业切片二:把 P51 落盘的职业背包侧车变成玩家在世界里可用的物品 +/// (docs/design-professions.md §2.4-2)。 +/// +/// 口径: +/// - 定价仍走既有 `Sim.quotePrice`,再经 `Occupation.biasedQuote`;无职业恒等 1.0。 +/// - 钱写 `world.Avatar.Mind.Needs.Money`,物品写 `Occupation.State.Backpack`(侧车)。 +/// - 交易像 `Sim.trade` 一样追加 `TradeEvent` + `TradeAnnal` 并写双方记忆, +/// 但**不动** `Sim.step` / 地图 / seed,也不给 Avatar 加 Inventory 字段。 +/// +/// 玩家不是 `world.Npcs` 成员(`playerId = NpcId -1`),而 `Sim.quotePrice` 只认 +/// `Npcs`。这里把玩家侧(Avatar 需求/人格 + 背包)镜像成一个临时 `Npc` 追加进 +/// 「报价世界副本」再调用 `Sim.quotePrice`;副本只用于报价,不写回真实世界。 +module PlayerTrade = + + type Outcome = + { World: World + Occupation: Occupation.State option + Succeeded: bool + /// 成交时的职业偏置后单位价(失败为 None)。 + UnitPrice: float32 option + /// 面向 HUD 的短中文反馈。 + Message: string } + + let private itemName (item: ItemKind) : string = + match item with + | Food -> "食物" + | Fish -> "鱼" + | Spice -> "香料" + | Scroll -> "卷轴" + + let private quantityOf (item: ItemKind) (inventory: Map<ItemKind, int>) : int = + inventory |> Map.tryFind item |> Option.defaultValue 0 + + let private changeItem (item: ItemKind) (delta: int) (inventory: Map<ItemKind, int>) : Map<ItemKind, int> = + let next = quantityOf item inventory + delta + if next <= 0 then Map.remove item inventory else Map.add item next inventory + + let private backpackMap (backpack: (ItemKind * int) list) : Map<ItemKind, int> = + backpack + |> List.fold (fun acc (item, quantity) -> Map.add item (quantityOf item acc + quantity) acc) Map.empty + + /// 背包增减,保持声明顺序;归零移除,新物品追加到尾部。 + let private changeBackpack (item: ItemKind) (delta: int) (backpack: (ItemKind * int) list) : (ItemKind * int) list = + let mutable found = false + let updated = + backpack + |> List.choose (fun (kind, quantity) -> + if kind = item then + found <- true + let next = quantity + delta + if next <= 0 then None else Some(kind, next) + else + Some(kind, quantity)) + if not found && delta > 0 then updated @ [ item, delta ] else updated + + let private quoteWorld (world: World) (state: Occupation.State option) : World = + let backpack = state |> Option.map (fun s -> s.Backpack) |> Option.defaultValue [] + let playerNpc = + { Id = playerId + Pos = world.Avatar.Pos + Inventory = backpackMap backpack + Mind = world.Avatar.Mind } + { world with Npcs = Array.append world.Npcs [| playerNpc |] } + + let private requestFor (playerIsBuyer: bool) (counterparty: NpcId) (item: ItemKind) (quantity: int) : TradeRequest = + if playerIsBuyer then + { Buyer = playerId; Seller = counterparty; Item = item; Quantity = quantity } + else + { Buyer = counterparty; Seller = playerId; Item = item; Quantity = quantity } + + /// 未偏置的 `Sim.quotePrice` 结果(玩家侧镜像为临时参与者)。 + let quoteBase + (state: Occupation.State option) + (playerIsBuyer: bool) + (counterparty: NpcId) + (item: ItemKind) + (quantity: int) + (world: World) + : float32 option = + Sim.quotePrice (requestFor playerIsBuyer counterparty item quantity) (quoteWorld world state) + + /// 最终成交单价 = `Sim.quotePrice` → `Occupation.biasedQuote`。 + let quote + (state: Occupation.State option) + (playerIsBuyer: bool) + (counterparty: NpcId) + (item: ItemKind) + (quantity: int) + (world: World) + : float32 option = + let kind = state |> Option.map (fun s -> s.Profile.Kind) + quoteBase state playerIsBuyer counterparty item quantity world + |> Occupation.biasedQuote kind playerIsBuyer + + let private replaceNpc (npc: Npc) (world: World) : World = + { world with Npcs = world.Npcs |> Array.map (fun current -> if current.Id = npc.Id then npc else current) } + + let private recordTrade + (buyer: NpcId) + (seller: NpcId) + (item: ItemKind) + (quantity: int) + (unitPrice: float32) + (world: World) + : World = + let event = + { Tick = world.Tick + Kind = TradeEvent(buyer, seller, item, quantity, unitPrice) } + let entry = + { Tick = world.Tick + Kind = TradeAnnal event + Summary = + sprintf "trade tick=%d buyer=%A seller=%A item=%A quantity=%d price=%.2f" + world.Tick buyer seller item quantity unitPrice } + Sim.appendAnnal entry { world with Events = world.Events @ [ event ] } + + let private failure (state: Occupation.State option) (world: World) (message: string) : Outcome = + { World = world; Occupation = state; Succeeded = false; UnitPrice = None; Message = message } + + /// 玩家向 `counterparty` 买入 `quantity` 件 `item`。 + let buy + (state: Occupation.State option) + (counterparty: NpcId) + (item: ItemKind) + (quantity: int) + (world: World) + : Outcome = + match state with + | None -> failure state world "未选择职业" + | Some occupation -> + match world.Npcs |> Array.tryFind (fun npc -> npc.Id = counterparty) with + | None -> failure state world "找不到对方" + | Some seller when quantity <= 0 -> failure state world "数量必须大于零" + | Some seller -> + if quantityOf item seller.Inventory < quantity then + failure state world "库存不足" + else + match quote (Some occupation) true counterparty item quantity world with + | None -> failure state world "无法报价" + | Some unitPrice -> + let total = unitPrice * float32 quantity + if world.Avatar.Mind.Needs.Money < total then + failure state world "资金不足" + else + let avatarMind = + { world.Avatar.Mind with + Needs = { world.Avatar.Mind.Needs with Money = world.Avatar.Mind.Needs.Money - total } + Memory = recordMemory world.Tick (Bought(counterparty, item, quantity, unitPrice)) world.Avatar.Mind.Memory } + let updatedSeller = + { seller with + Inventory = changeItem item -quantity seller.Inventory + Mind = + { seller.Mind with + Needs = { seller.Mind.Needs with Money = seller.Mind.Needs.Money + total } + Memory = recordMemory world.Tick (Sold(playerId, item, quantity, unitPrice)) seller.Mind.Memory } } + let nextWorld = + world + |> (fun w -> { w with Avatar = { w.Avatar with Mind = avatarMind } }) + |> replaceNpc updatedSeller + |> recordTrade playerId counterparty item quantity unitPrice + { World = nextWorld + Occupation = Some { occupation with Backpack = changeBackpack item quantity occupation.Backpack } + Succeeded = true + UnitPrice = Some unitPrice + Message = sprintf "买入%s ×%d,单价 %.2f" (itemName item) quantity unitPrice } + + /// 玩家向 `counterparty` 卖出 `quantity` 件 `item`(须在背包内)。 + let sell + (state: Occupation.State option) + (counterparty: NpcId) + (item: ItemKind) + (quantity: int) + (world: World) + : Outcome = + match state with + | None -> failure state world "未选择职业" + | Some occupation -> + match world.Npcs |> Array.tryFind (fun npc -> npc.Id = counterparty) with + | None -> failure state world "找不到对方" + | Some buyer when quantity <= 0 -> failure state world "数量必须大于零" + | Some buyer -> + if Occupation.backpackQuantity item occupation < quantity then + failure state world "背包不足" + else + match quote (Some occupation) false counterparty item quantity world with + | None -> failure state world "无法报价" + | Some unitPrice -> + let total = unitPrice * float32 quantity + if buyer.Mind.Needs.Money < total then + failure state world "对方资金不足" + else + let avatarMind = + { world.Avatar.Mind with + Needs = { world.Avatar.Mind.Needs with Money = world.Avatar.Mind.Needs.Money + total } + Memory = recordMemory world.Tick (Sold(counterparty, item, quantity, unitPrice)) world.Avatar.Mind.Memory } + let updatedBuyer = + { buyer with + Inventory = changeItem item quantity buyer.Inventory + Mind = + { buyer.Mind with + Needs = { buyer.Mind.Needs with Money = buyer.Mind.Needs.Money - total } + Memory = recordMemory world.Tick (Bought(playerId, item, quantity, unitPrice)) buyer.Mind.Memory } } + let nextWorld = + world + |> (fun w -> { w with Avatar = { w.Avatar with Mind = avatarMind } }) + |> replaceNpc updatedBuyer + |> recordTrade counterparty playerId item quantity unitPrice + { World = nextWorld + Occupation = Some { occupation with Backpack = changeBackpack item -quantity occupation.Backpack } + Succeeded = true + UnitPrice = Some unitPrice + Message = sprintf "卖出%s ×%d,单价 %.2f" (itemName item) quantity unitPrice } + + /// HUD 入口:向 `counterparty` 买 1 件食物。 + let buyFood (state: Occupation.State option) (counterparty: NpcId) (world: World) : Outcome = + buy state counterparty Food 1 world + + /// HUD 入口:卖出背包里第一件有货的物品 1 件;背包为空则失败。 + let sellFirst (state: Occupation.State option) (counterparty: NpcId) (world: World) : Outcome = + match state with + | None -> failure state world "未选择职业" + | Some occupation -> + match occupation.Backpack |> List.tryFind (fun (_, quantity) -> quantity > 0) with + | None -> failure state world "背包里没有可卖物品" + | Some(item, quantity) -> sell state counterparty item (min 1 quantity) world |
