summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--LivingVillage.sln7
-rw-r--r--src/LivingVillage.Desktop.Tests/DesktopTests.fs63
-rw-r--r--src/LivingVillage.Desktop.Tests/LivingVillage.Desktop.Tests.fsproj23
-rw-r--r--src/LivingVillage.Desktop/Game.fs133
-rw-r--r--src/LivingVillage.Desktop/Interaction.fs211
-rw-r--r--src/LivingVillage.Desktop/LivingVillage.Desktop.fsproj1
-rw-r--r--src/LivingVillage.Headless/Program.fs146
-rw-r--r--src/LivingVillage.Kernel.Tests/DeterminismTests.fs19
-rw-r--r--src/LivingVillage.Kernel.Tests/LivingVillage.Kernel.Tests.fsproj1
-rw-r--r--src/LivingVillage.Kernel.Tests/M5Tests.fs141
-rw-r--r--src/LivingVillage.Kernel.Tests/RelationTests.fs30
-rw-r--r--src/LivingVillage.Kernel.Tests/RumorTests.fs15
-rw-r--r--src/LivingVillage.Kernel.Tests/TradeTests.fs19
-rw-r--r--src/LivingVillage.Kernel/Sim.fs449
14 files changed, 1141 insertions, 117 deletions
diff --git a/LivingVillage.sln b/LivingVillage.sln
index 5792693..2163e8f 100644
--- a/LivingVillage.sln
+++ b/LivingVillage.sln
@@ -13,6 +13,8 @@ Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "LivingVillage.Headless", "s
EndProject
Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "LivingVillage.Kernel.Tests", "src\LivingVillage.Kernel.Tests\LivingVillage.Kernel.Tests.fsproj", "{524DF44B-ECF6-4537-8F42-2C6CA357372F}"
EndProject
+Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "LivingVillage.Desktop.Tests", "src\LivingVillage.Desktop.Tests\LivingVillage.Desktop.Tests.fsproj", "{A0F5D7C6-3B39-4D54-9B0F-72C14B7A0A51}"
+EndProject
Global
GlobalSection(SolutionConfigurationPlatforms) = preSolution
Debug|Any CPU = Debug|Any CPU
@@ -38,11 +40,16 @@ Global
{524DF44B-ECF6-4537-8F42-2C6CA357372F}.Debug|Any CPU.Build.0 = Debug|Any CPU
{524DF44B-ECF6-4537-8F42-2C6CA357372F}.Release|Any CPU.ActiveCfg = Release|Any CPU
{524DF44B-ECF6-4537-8F42-2C6CA357372F}.Release|Any CPU.Build.0 = Release|Any CPU
+ {A0F5D7C6-3B39-4D54-9B0F-72C14B7A0A51}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
+ {A0F5D7C6-3B39-4D54-9B0F-72C14B7A0A51}.Debug|Any CPU.Build.0 = Debug|Any CPU
+ {A0F5D7C6-3B39-4D54-9B0F-72C14B7A0A51}.Release|Any CPU.ActiveCfg = Release|Any CPU
+ {A0F5D7C6-3B39-4D54-9B0F-72C14B7A0A51}.Release|Any CPU.Build.0 = Release|Any CPU
EndGlobalSection
GlobalSection(NestedProjects) = preSolution
{504BBDD4-106D-4423-A3BE-9A82848D1656} = {DFF4B1C6-CF0A-45CB-912B-5BFD446A76FF}
{CC15DA38-E36A-45A2-A031-5392C8A6BF0D} = {DFF4B1C6-CF0A-45CB-912B-5BFD446A76FF}
{0CC4C137-0002-4A62-A743-BBCF022DF8E3} = {DFF4B1C6-CF0A-45CB-912B-5BFD446A76FF}
{524DF44B-ECF6-4537-8F42-2C6CA357372F} = {DFF4B1C6-CF0A-45CB-912B-5BFD446A76FF}
+ {A0F5D7C6-3B39-4D54-9B0F-72C14B7A0A51} = {DFF4B1C6-CF0A-45CB-912B-5BFD446A76FF}
EndGlobalSection
EndGlobal
diff --git a/src/LivingVillage.Desktop.Tests/DesktopTests.fs b/src/LivingVillage.Desktop.Tests/DesktopTests.fs
new file mode 100644
index 0000000..ffcc6c0
--- /dev/null
+++ b/src/LivingVillage.Desktop.Tests/DesktopTests.fs
@@ -0,0 +1,63 @@
+namespace LivingVillage.Desktop.Tests
+
+open Microsoft.VisualStudio.TestTools.UnitTesting
+open LivingVillage.Kernel
+open LivingVillage.Kernel.Sim
+open LivingVillage.Desktop
+
+module private Harness =
+
+ let atNpc (id: int) (world: World) : World =
+ let npc = world.Npcs.[id]
+ { world with Avatar = { world.Avatar with Pos = npc.Pos } }
+
+[<TestClass>]
+type DesktopTests () =
+
+ [<TestMethod>]
+ member _.InteractOpensTheSixIntentMenu () =
+ let world = Sim.initialWorldN 42UL 4 |> Harness.atNpc 0
+ let next, view = M5Interaction.apply Interact world M5Interaction.initial
+
+ Assert.AreEqual<World>(world, next)
+ Assert.AreEqual<M5Panel>(DialoguePanel, view.Panel)
+ Assert.AreEqual<int>(6, view.Menu.Value.Options.Length)
+ Assert.IsTrue(M5Interaction.titleText view |> fun text -> text.Contains("SMALLTALK"))
+
+ [<TestMethod>]
+ member _.SelectingAnIntentUpdatesWorldAndChronicle () =
+ let world = Sim.initialWorldN 42UL 4 |> Harness.atNpc 0
+ let openedWorld, opened = M5Interaction.apply Interact world M5Interaction.initial
+ let next, view = M5Interaction.apply Intent1 openedWorld opened
+
+ Assert.IsTrue(next.Events |> List.exists (fun event ->
+ match event.Kind with
+ | DialogueEvent _ -> true
+ | _ -> false))
+ Assert.IsTrue(next.Annals |> List.exists (fun entry ->
+ match entry.Kind with
+ | DialogueAnnal _ -> true
+ | _ -> false))
+ Assert.IsTrue(view.Chronicle.Contains("dialogue"))
+ Assert.IsTrue(view.Status.Contains("dialogue"))
+
+ [<TestMethod>]
+ member _.NeedsAndObservationPanelsUseKernelViews () =
+ let world = Sim.initialWorldN 42UL 4 |> Harness.atNpc 0
+ let afterStep = Sim.step { Input = { MoveX = 0.0f; MoveY = 0.0f } } world
+ let _, needsView = M5Interaction.apply ToggleNeeds afterStep M5Interaction.initial
+ let _, observationView = M5Interaction.apply Observe world M5Interaction.initial
+
+ Assert.AreEqual<Needs>(afterStep.Avatar.Mind.Needs, needsView.Needs.Value.Needs)
+ Assert.IsTrue(observationView.Observations |> List.exists (fun observation -> observation.Id = NpcId 0))
+
+ [<TestMethod>]
+ member _.HeadlessSmokeProvesTheThreeHopCausalChain () =
+ let result = Program.M5Smoke.run ()
+
+ Assert.IsTrue(result.Passed, result.Failure)
+ Assert.AreEqual<int>(6, result.MenuOptions)
+ Assert.AreEqual<int>(4, result.RumorPathLength)
+ Assert.IsTrue(result.Chronicle.Contains("dialogue"))
+ Assert.IsTrue(result.RumorTrace.Contains("receiver=-1"))
+ Assert.IsTrue(result.RumorTrace.Contains("depth=3"))
diff --git a/src/LivingVillage.Desktop.Tests/LivingVillage.Desktop.Tests.fsproj b/src/LivingVillage.Desktop.Tests/LivingVillage.Desktop.Tests.fsproj
new file mode 100644
index 0000000..a1cbe33
--- /dev/null
+++ b/src/LivingVillage.Desktop.Tests/LivingVillage.Desktop.Tests.fsproj
@@ -0,0 +1,23 @@
+<Project Sdk="Microsoft.NET.Sdk">
+
+ <PropertyGroup>
+ <TargetFramework>net8.0</TargetFramework>
+ <IsPackable>false</IsPackable>
+ </PropertyGroup>
+
+ <ItemGroup>
+ <Compile Include="DesktopTests.fs" />
+ </ItemGroup>
+
+ <ItemGroup>
+ <PackageReference Include="Microsoft.NET.Test.Sdk" Version="17.11.1" />
+ <PackageReference Include="MSTest.TestAdapter" Version="3.6.3" />
+ <PackageReference Include="MSTest.TestFramework" Version="3.6.3" />
+ </ItemGroup>
+
+ <ItemGroup>
+ <ProjectReference Include="..\LivingVillage.Desktop\LivingVillage.Desktop.fsproj" />
+ <ProjectReference Include="..\LivingVillage.Headless\LivingVillage.Headless.fsproj" />
+ </ItemGroup>
+
+</Project>
diff --git a/src/LivingVillage.Desktop/Game.fs b/src/LivingVillage.Desktop/Game.fs
index 62fccb9..09d3364 100644
--- a/src/LivingVillage.Desktop/Game.fs
+++ b/src/LivingVillage.Desktop/Game.fs
@@ -71,7 +71,67 @@ module NpcView =
| Wander -> "wander"
| Work -> "work"
| Chat -> "chat"
- | Work -> "work"
+
+module PixelText =
+ let private glyphs =
+ [ 'A', [| "01110"; "10001"; "10001"; "11111"; "10001"; "10001"; "10001" |]
+ 'B', [| "11110"; "10001"; "10001"; "11110"; "10001"; "10001"; "11110" |]
+ 'C', [| "01111"; "10000"; "10000"; "10000"; "10000"; "10000"; "01111" |]
+ 'D', [| "11110"; "10001"; "10001"; "10001"; "10001"; "10001"; "11110" |]
+ 'E', [| "11111"; "10000"; "10000"; "11110"; "10000"; "10000"; "11111" |]
+ 'F', [| "11111"; "10000"; "10000"; "11110"; "10000"; "10000"; "10000" |]
+ 'G', [| "01111"; "10000"; "10000"; "10111"; "10001"; "10001"; "01111" |]
+ 'H', [| "10001"; "10001"; "10001"; "11111"; "10001"; "10001"; "10001" |]
+ 'I', [| "11111"; "00100"; "00100"; "00100"; "00100"; "00100"; "11111" |]
+ 'J', [| "00111"; "00010"; "00010"; "00010"; "00010"; "10010"; "01100" |]
+ 'K', [| "10001"; "10010"; "10100"; "11000"; "10100"; "10010"; "10001" |]
+ 'L', [| "10000"; "10000"; "10000"; "10000"; "10000"; "10000"; "11111" |]
+ 'M', [| "10001"; "11011"; "10101"; "10101"; "10001"; "10001"; "10001" |]
+ 'N', [| "10001"; "11001"; "10101"; "10011"; "10001"; "10001"; "10001" |]
+ 'O', [| "01110"; "10001"; "10001"; "10001"; "10001"; "10001"; "01110" |]
+ 'P', [| "11110"; "10001"; "10001"; "11110"; "10000"; "10000"; "10000" |]
+ 'Q', [| "01110"; "10001"; "10001"; "10001"; "10101"; "10010"; "01101" |]
+ 'R', [| "11110"; "10001"; "10001"; "11110"; "10100"; "10010"; "10001" |]
+ 'S', [| "01111"; "10000"; "10000"; "01110"; "00001"; "00001"; "11110" |]
+ 'T', [| "11111"; "00100"; "00100"; "00100"; "00100"; "00100"; "00100" |]
+ 'U', [| "10001"; "10001"; "10001"; "10001"; "10001"; "10001"; "01110" |]
+ 'V', [| "10001"; "10001"; "10001"; "10001"; "10001"; "01010"; "00100" |]
+ 'W', [| "10001"; "10001"; "10001"; "10101"; "10101"; "11011"; "10001" |]
+ 'X', [| "10001"; "10001"; "01010"; "00100"; "01010"; "10001"; "10001" |]
+ 'Y', [| "10001"; "10001"; "01010"; "00100"; "00100"; "00100"; "00100" |]
+ 'Z', [| "11111"; "00001"; "00010"; "00100"; "01000"; "10000"; "11111" |]
+ '0', [| "01110"; "10001"; "10011"; "10101"; "11001"; "10001"; "01110" |]
+ '1', [| "00100"; "01100"; "00100"; "00100"; "00100"; "00100"; "01110" |]
+ '2', [| "01110"; "10001"; "00001"; "00010"; "00100"; "01000"; "11111" |]
+ '3', [| "11110"; "00001"; "00001"; "01110"; "00001"; "00001"; "11110" |]
+ '4', [| "00010"; "00110"; "01010"; "10010"; "11111"; "00010"; "00010" |]
+ '5', [| "11111"; "10000"; "10000"; "11110"; "00001"; "00001"; "11110" |]
+ '6', [| "01110"; "10000"; "10000"; "11110"; "10001"; "10001"; "01110" |]
+ '7', [| "11111"; "00001"; "00010"; "00100"; "01000"; "01000"; "01000" |]
+ '8', [| "01110"; "10001"; "10001"; "01110"; "10001"; "10001"; "01110" |]
+ '9', [| "01110"; "10001"; "10001"; "01111"; "00001"; "00001"; "01110" |]
+ '-', [| "00000"; "00000"; "00000"; "11111"; "00000"; "00000"; "00000" |]
+ '.', [| "00000"; "00000"; "00000"; "00000"; "00000"; "00110"; "00110" |]
+ '=', [| "00000"; "11111"; "00000"; "00000"; "11111"; "00000"; "00000" |]
+ ':', [| "00000"; "00110"; "00110"; "00000"; "00110"; "00110"; "00000" |]
+ ';', [| "00000"; "00110"; "00110"; "00000"; "00110"; "00100"; "01000" |]
+ '/', [| "00001"; "00010"; "00010"; "00100"; "01000"; "01000"; "10000" |]
+ '?', [| "01110"; "10001"; "00001"; "00010"; "00100"; "00000"; "00100" |] ]
+ |> Map.ofList
+
+ let draw (spriteBatch: SpriteBatch) (pixel: Texture2D) (x: int) (y: int) (scale: int) (color: Color) (text: string) =
+ let fallback = glyphs.['?']
+ let mutable cursor = x
+ for character in text.ToUpperInvariant() do
+ if character = ' ' then
+ cursor <- cursor + (4 * scale)
+ else
+ let rows = glyphs |> Map.tryFind character |> Option.defaultValue fallback
+ for row in 0 .. rows.Length - 1 do
+ for column in 0 .. rows.[row].Length - 1 do
+ if rows.[row].[column] = '1' then
+ spriteBatch.Draw(pixel, Rectangle(cursor + column * scale, y + row * scale, scale, scale), color)
+ cursor <- cursor + (6 * scale)
type LivingVillageGame() as this =
inherit Game()
@@ -98,6 +158,7 @@ type LivingVillageGame() as this =
let mutable prevKb = Unchecked.defaultof<KeyboardState>
let mutable relationView = false
let mutable relationSnapshot: float32[,] option = None
+ let mutable m5View = M5Interaction.initial
do
graphics.PreferredBackBufferWidth <- 1280
@@ -105,8 +166,9 @@ type LivingVillageGame() as this =
graphics.SynchronizeWithVerticalRetrace <- true
this.IsFixedTimeStep <- true
this.TargetElapsedTime <- TimeSpan.FromTicks(TimeSpan.TicksPerSecond / 60L)
- this.Window.Title <- if autoplay then "Living Village M1 [AUTOPLAY]" else "Living Village M1"
+ this.Window.Title <- if autoplay then "Living Village M5 [AUTOPLAY]" else "Living Village M5"
printfn $"mode={modeName} seed=42"
+ printfn "controls=WASD move E interact 1-6 choose Q observe Tab needs C chronicle L relations Esc close/exit"
member private this.CenterCamera() =
let viewport = this.GraphicsDevice.Viewport
let vw = float32 viewport.Width
@@ -130,15 +192,44 @@ type LivingVillageGame() as this =
override this.Update(gameTime: GameTime) =
let kb = Keyboard.GetState()
- if kb.IsKeyDown(Keys.Escape) then this.Exit()
- let lPressed = kb.IsKeyDown(Keys.L) && not (prevKb.IsKeyDown(Keys.L))
- prevKb <- kb
+ let pressed (key: Keys) = kb.IsKeyDown(key) && not (prevKb.IsKeyDown(key))
+ let pressedAny (keys: Keys list) = keys |> List.exists pressed
+ let lPressed = pressed Keys.L
+ let escapePressed = pressed Keys.Escape
+ if escapePressed then
+ if m5View.Panel <> WorldPanel then
+ let nextWorld, nextView = M5Interaction.apply ClosePanel world m5View
+ world <- nextWorld
+ m5View <- nextView
+ printfn $"m5 panel={M5Interaction.panelName m5View} status={m5View.Status} tick={world.Tick}"
+ else
+ this.Exit()
if lPressed then
relationView <- not relationView
if relationView then relationSnapshot <- Some(Sim.relationMatrix world)
let state = if relationView then "on" else "off"
printfn $"relation view={state} tick={world.Tick}"
- if not relationView then
+ let m5Command =
+ if pressed Keys.E then Some Interact
+ elif pressedAny [ Keys.D1; Keys.NumPad1 ] then Some Intent1
+ elif pressedAny [ Keys.D2; Keys.NumPad2 ] then Some Intent2
+ elif pressedAny [ Keys.D3; Keys.NumPad3 ] then Some Intent3
+ elif pressedAny [ Keys.D4; Keys.NumPad4 ] then Some Intent4
+ elif pressedAny [ Keys.D5; Keys.NumPad5 ] then Some Intent5
+ elif pressedAny [ Keys.D6; Keys.NumPad6 ] then Some Intent6
+ elif pressed Keys.Q then Some Observe
+ elif pressed Keys.Tab then Some ToggleNeeds
+ elif pressed Keys.C then Some ShowChronicle
+ else None
+ match m5Command with
+ | Some command ->
+ let nextWorld, nextView = M5Interaction.apply command world m5View
+ world <- nextWorld
+ m5View <- nextView
+ printfn $"m5 panel={M5Interaction.panelName m5View} status={m5View.Status} tick={world.Tick}"
+ | None -> ()
+ let panelOpen = m5View.Panel <> WorldPanel
+ if not relationView && not panelOpen then
let input =
if autoplay then
let t = float32 world.Tick
@@ -168,8 +259,10 @@ type LivingVillageGame() as this =
NpcView.actionName world.Npcs.[0].Mind.Action
else "none"
let viewTag = if relationView then " | [RELATIONS]" else ""
- this.Window.Title <- $"Living Village M3b{titleSuffix} | fps {fps:F1} | tick {world.Tick} | npc {npcAction}{viewTag}"
+ this.Window.Title <-
+ $"Living Village M5{titleSuffix} | fps {fps:F1} | tick {world.Tick} | npc {npcAction}{viewTag} | panel {M5Interaction.panelName m5View} | {M5Interaction.titleText m5View}"
printfn $"fps={fps:F1} tick={world.Tick} pos=({world.Avatar.Pos.X:F0},{world.Avatar.Pos.Y:F0})"
+ prevKb <- kb
member private this.DrawLine (a: Vector2) (b: Vector2) (thickness: float32) (color: Color) =
let d = b - a
@@ -212,6 +305,7 @@ type LivingVillageGame() as this =
override this.Draw(gameTime: GameTime) =
if relationView then
this.DrawRelationView()
+ this.DrawM5Overlay()
else
this.DrawWorldView()
@@ -242,3 +336,28 @@ type LivingVillageGame() as this =
let (NpcId idx) = npc.Id
spriteBatch.Draw(pixel, npcDst, npcShades.[idx % npcShades.Length])
spriteBatch.End()
+ this.DrawM5Overlay()
+
+ member private this.DrawM5Overlay() =
+ let viewport = this.GraphicsDevice.Viewport
+ let panelWidth = min 460 (max 1 (viewport.Width - 32))
+ let panelHeight = min 520 (max 1 (viewport.Height - 32))
+ let panelX = max 16 (viewport.Width - panelWidth - 16)
+ let panelY = 16
+ let panel = Rectangle(panelX, panelY, panelWidth, panelHeight)
+ let innerX = panelX + 16
+ let innerWidth = panelWidth - 32
+ let textScale = 2
+ let lineHeight = 18
+ let maxChars = max 1 (innerWidth / (6 * textScale))
+ let maxLines = max 1 ((panelHeight - 32) / lineHeight)
+ let lines = M5Interaction.panelLines world m5View |> List.truncate maxLines
+ spriteBatch.Begin()
+ spriteBatch.Draw(pixel, panel, Color(15, 19, 25, 220))
+ spriteBatch.Draw(pixel, Rectangle(panelX, panelY, panelWidth, 4), Color(92, 180, 190))
+ lines
+ |> List.iteri (fun index line ->
+ let visible = if line.Length > maxChars then line.Substring(0, maxChars) else line
+ let color = if index = 0 then Color(220, 235, 220) else Color(190, 205, 210)
+ PixelText.draw spriteBatch pixel innerX (panelY + 12 + index * lineHeight) textScale color visible)
+ spriteBatch.End()
diff --git a/src/LivingVillage.Desktop/Interaction.fs b/src/LivingVillage.Desktop/Interaction.fs
new file mode 100644
index 0000000..6f175d6
--- /dev/null
+++ b/src/LivingVillage.Desktop/Interaction.fs
@@ -0,0 +1,211 @@
+namespace LivingVillage.Desktop
+
+open System
+open LivingVillage.Kernel
+open LivingVillage.Kernel.Sim
+
+type M5Panel =
+ | WorldPanel
+ | NeedsPanel
+ | ObservationPanel
+ | DialoguePanel
+ | ChroniclePanel
+
+type M5Command =
+ | Interact
+ | Intent1
+ | Intent2
+ | Intent3
+ | Intent4
+ | Intent5
+ | Intent6
+ | Observe
+ | ToggleNeeds
+ | ShowChronicle
+ | ClosePanel
+
+type M5View =
+ { Panel: M5Panel
+ Menu: DialogueMenu option
+ Needs: NeedsPanel option
+ Observations: Observation list
+ Chronicle: string
+ Status: string }
+
+module M5Interaction =
+
+ let initial : M5View =
+ { Panel = WorldPanel
+ Menu = None
+ Needs = None
+ Observations = []
+ Chronicle = ""
+ Status = "ready" }
+
+ let private observationBounds (world: World) : VisibleBounds =
+ let radius = Sim.chatRangePx
+ { Min = { X = world.Avatar.Pos.X - radius; Y = world.Avatar.Pos.Y - radius }
+ Max = { X = world.Avatar.Pos.X + radius; Y = world.Avatar.Pos.Y + radius } }
+
+ let private menuStatus (menu: DialogueMenu) : string =
+ sprintf "dialogue target=%A options=%d; press 1-6" menu.Target menu.Options.Length
+
+ let private intentName (intent: DialogueIntent) : string =
+ match intent with
+ | SmallTalk -> "SMALLTALK"
+ | AskHelp -> "ASK HELP"
+ | OfferTrade -> "OFFER TRADE"
+ | Joke -> "JOKE"
+ | Apologize -> "APOLOGIZE"
+ | Provoke -> "PROVOKE"
+
+ let private needName (kind: NeedKind) : string =
+ match kind with
+ | HungerNeed -> "HUNGER"
+ | EnergyNeed -> "ENERGY"
+ | SocialNeed -> "SOCIAL"
+ | MoneyNeed -> "MONEY"
+
+ let private npcNumber (NpcId id) = id
+
+ let private chooseIntent (index: int) (world: World) (view: M5View) : World * M5View =
+ match view.Menu with
+ | None -> world, { view with Status = "no dialogue menu; press E near an NPC" }
+ | Some menu ->
+ match List.tryItem index menu.Options with
+ | None -> world, { view with Status = "invalid dialogue option" }
+ | Some intent ->
+ match Sim.chooseDialogue menu.Target intent world with
+ | DialogueSucceeded(outcome, next) ->
+ next,
+ { view with
+ Panel = DialoguePanel
+ Menu = None
+ Chronicle = Sim.annalText next
+ Status = sprintf "dialogue intent=%A response=%A" outcome.Intent outcome.Response }
+ | DialogueRejected(failure, next) ->
+ next, { view with Status = sprintf "dialogue rejected: %A" failure }
+
+ let apply (command: M5Command) (world: World) (view: M5View) : World * M5View =
+ match command with
+ | Interact ->
+ match Sim.openDialogueMenu world with
+ | Some menu ->
+ world,
+ { view with
+ Panel = DialoguePanel
+ Menu = Some menu
+ Status = menuStatus menu }
+ | None -> world, { view with Panel = WorldPanel; Menu = None; Status = "no nearby NPC available" }
+ | Intent1 -> chooseIntent 0 world view
+ | Intent2 -> chooseIntent 1 world view
+ | Intent3 -> chooseIntent 2 world view
+ | Intent4 -> chooseIntent 3 world view
+ | Intent5 -> chooseIntent 4 world view
+ | Intent6 -> chooseIntent 5 world view
+ | Observe ->
+ let observations = Sim.observeVisible (observationBounds world) world
+ world,
+ { view with
+ Panel = ObservationPanel
+ Observations = observations
+ Status = sprintf "observation visible_npcs=%d" observations.Length }
+ | ToggleNeeds ->
+ if view.Panel = NeedsPanel then
+ world, { view with Panel = WorldPanel; Needs = None; Status = "needs panel closed" }
+ else
+ world,
+ { view with
+ Panel = NeedsPanel
+ Needs = Some(Sim.needsPanel world)
+ Status = "needs panel open" }
+ | ShowChronicle ->
+ world,
+ { view with
+ Panel = ChroniclePanel
+ Chronicle = Sim.annalText world
+ Status = sprintf "chronicle entries=%d" world.Annals.Length }
+ | ClosePanel -> world, { view with Panel = WorldPanel; Menu = None; Status = "panel closed" }
+
+ let panelName (view: M5View) : string =
+ match view.Panel with
+ | WorldPanel -> "world"
+ | NeedsPanel -> "needs"
+ | ObservationPanel -> "observation"
+ | DialoguePanel -> "dialogue"
+ | ChroniclePanel -> "chronicle"
+
+ let titleText (view: M5View) : string =
+ match view.Panel with
+ | WorldPanel -> "E INTERACT | Q OBSERVE | TAB NEEDS | C CHRONICLE | L RELATIONS"
+ | NeedsPanel -> "NEEDS | TAB CLOSE | Q OBSERVE | C CHRONICLE"
+ | ObservationPanel -> "OBSERVATION | TAB NEEDS | C CHRONICLE | ESC CLOSE"
+ | DialoguePanel ->
+ match view.Menu with
+ | Some menu ->
+ let options =
+ menu.Options
+ |> List.mapi (fun index intent -> sprintf "%d %s" (index + 1) (intentName intent))
+ |> String.concat " | "
+ sprintf "DIALOGUE TARGET=%A | %s | ESC CLOSE" menu.Target options
+ | None -> "DIALOGUE RECORDED | E INTERACT | ESC CLOSE"
+ | ChroniclePanel -> "CHRONICLE | TAB NEEDS | Q OBSERVE | ESC CLOSE"
+
+ let private chronicleLines (text: string) : string list =
+ text.Split([| '\n' |], System.StringSplitOptions.RemoveEmptyEntries) |> Array.toList
+
+ let panelLines (world: World) (view: M5View) : string list =
+ let status = if String.IsNullOrWhiteSpace view.Status then "READY" else view.Status.ToUpperInvariant()
+ match view.Panel with
+ | WorldPanel ->
+ [ "M5 VILLAGE"
+ "E INTERACT"
+ "Q OBSERVE"
+ "TAB NEEDS"
+ "C CHRONICLE"
+ "L RELATIONS"
+ status ]
+ | NeedsPanel ->
+ match view.Needs with
+ | None -> [ "NEEDS"; "NO DATA"; status ]
+ | Some panel ->
+ let topNeed =
+ panel.Ranked
+ |> List.tryHead
+ |> Option.map (fun score -> sprintf "TOP %s" (needName score.Kind))
+ |> Option.defaultValue "TOP NONE"
+ [ "NEEDS"
+ sprintf "HUNGER %.0f" panel.Needs.Hunger
+ sprintf "ENERGY %.0f" panel.Needs.Energy
+ sprintf "SOCIAL %.0f" panel.Needs.Social
+ sprintf "MONEY %.0f" panel.Needs.Money
+ topNeed
+ status ]
+ | ObservationPanel ->
+ let rows =
+ view.Observations
+ |> List.truncate 8
+ |> List.collect (fun observation ->
+ let urgency =
+ observation.Ranked
+ |> List.tryHead
+ |> Option.map (fun score -> score.Urgency)
+ |> Option.defaultValue 0.0f
+ [ sprintf "NPC %d U %.0f" (npcNumber observation.Id) urgency
+ sprintf "H %.0f E %.0f S %.0f M %.0f"
+ observation.Needs.Hunger
+ observation.Needs.Energy
+ observation.Needs.Social
+ observation.Needs.Money ])
+ "OBSERVATION" :: (if rows.IsEmpty then [ "NO NPC IN RANGE" ] else rows) @ [ status ]
+ | DialoguePanel ->
+ match view.Menu with
+ | None -> [ "DIALOGUE RECORDED"; status ]
+ | Some menu ->
+ let options =
+ menu.Options
+ |> List.mapi (fun index intent -> sprintf "%d %s" (index + 1) (intentName intent))
+ [ sprintf "DIALOGUE NPC %d" (npcNumber menu.Target) ] @ options @ [ "ESC CLOSE"; status ]
+ | ChroniclePanel ->
+ let entries = chronicleLines view.Chronicle |> List.truncate 10
+ "CHRONICLE" :: (if entries.IsEmpty then [ "NO ENTRIES" ] else entries) @ [ status ]
diff --git a/src/LivingVillage.Desktop/LivingVillage.Desktop.fsproj b/src/LivingVillage.Desktop/LivingVillage.Desktop.fsproj
index 9af59ac..cd8ccab 100644
--- a/src/LivingVillage.Desktop/LivingVillage.Desktop.fsproj
+++ b/src/LivingVillage.Desktop/LivingVillage.Desktop.fsproj
@@ -6,6 +6,7 @@
</PropertyGroup>
<ItemGroup>
+ <Compile Include="Interaction.fs" />
<Compile Include="Game.fs" />
<Compile Include="Program.fs" />
</ItemGroup>
diff --git a/src/LivingVillage.Headless/Program.fs b/src/LivingVillage.Headless/Program.fs
index 6ba0f5f..e34ecc0 100644
--- a/src/LivingVillage.Headless/Program.fs
+++ b/src/LivingVillage.Headless/Program.fs
@@ -167,6 +167,105 @@ let dumpRelations (world: World) : unit =
let dumpRumors (world: World) : unit =
printfn "%s" (Sim.rumorTraceText world)
+type M5SmokeResult =
+ { Passed: bool
+ Failure: string
+ MenuOptions: int
+ ObservationCount: int
+ RumorPathLength: int
+ Chronicle: string
+ RumorTrace: string }
+
+module M5Smoke =
+
+ let private atNpc (id: int) (world: World) : World =
+ let npc = world.Npcs.[id]
+ { world with Avatar = { world.Avatar with Pos = npc.Pos } }
+
+ let private readyForChat (world: World) : World =
+ { world with
+ Npcs =
+ world.Npcs
+ |> Array.map (fun npc ->
+ { npc with
+ Mind =
+ { npc.Mind with
+ Action = Wander
+ Target = actionTarget Wander
+ ActionAge = minActionTicks
+ EffectDone = true } }) }
+
+ let private atTick (tick: int64) (world: World) : World =
+ { world with
+ Tick = tick
+ Time = float tick * dtSeconds }
+
+ let private chat (narrator: int) (receiver: int) (world: World) : World =
+ match Sim.chat { Narrator = NpcId narrator; Receiver = NpcId receiver } world with
+ | ChatSucceeded (_, next) -> next
+ | ChatRejected (failure, _) -> failwithf "M5 smoke chat rejected: %A" failure
+
+ let run () : M5SmokeResult =
+ let initial = Sim.initialWorldN 7UL 4 |> readyForChat |> atNpc 0
+ let afterStep = Sim.step { Input = zeroInput } initial
+ let needsChanged = afterStep.Avatar.Mind.Needs <> initial.Avatar.Mind.Needs
+ let needs = Sim.needsPanel afterStep
+ let bounds =
+ { Min = { X = initial.Avatar.Pos.X - Sim.chatRangePx; Y = initial.Avatar.Pos.Y - Sim.chatRangePx }
+ Max = { X = initial.Avatar.Pos.X + Sim.chatRangePx; Y = initial.Avatar.Pos.Y + Sim.chatRangePx } }
+ let observations = Sim.observeVisible bounds initial
+ let menu = Sim.openDialogueMenu initial
+ let menuOptions = menu |> Option.map (fun item -> item.Options.Length) |> Option.defaultValue 0
+ let afterDialogue, dialogueRecorded =
+ match Sim.chooseDialogue (NpcId 0) SmallTalk initial with
+ | DialogueSucceeded (_, next) -> next, true
+ | DialogueRejected (_, next) -> next, false
+ let first = afterDialogue |> atTick ticksPerDay |> readyForChat |> chat 0 1
+ let second = first |> atTick (2L * ticksPerDay) |> readyForChat |> chat 1 2
+ let finalWorld = second |> atTick (3L * ticksPerDay) |> readyForChat |> chat 2 -1
+ let finalRumor = finalWorld.Rumors |> List.sortBy (fun rumor -> rumor.Id) |> List.last
+ let path = Sim.rumorPath finalWorld finalRumor.Id
+ let expectedChain =
+ [ (playerId, NpcId 0)
+ (playerId, NpcId 1)
+ (playerId, NpcId 2)
+ (playerId, playerId) ]
+ let actualChain = path |> List.map (fun rumor -> rumor.Source, rumor.Receiver)
+ let chronicle = Sim.annalText finalWorld
+ let rumorTrace = Sim.rumorTraceText finalWorld
+ let checks =
+ [ menuOptions = 6
+ needs.Needs = afterStep.Avatar.Mind.Needs
+ needsChanged
+ observations |> List.exists (fun observation -> observation.Id = NpcId 0)
+ dialogueRecorded
+ finalRumor.Source = playerId
+ finalRumor.Receiver = playerId
+ finalRumor.Narrator = NpcId 2
+ finalRumor.Depth = 3
+ actualChain = expectedChain
+ chronicle.Contains("dialogue") ]
+ let failure =
+ checks
+ |> List.mapi (fun index passed -> if passed then None else Some(sprintf "check_%d" (index + 1)))
+ |> List.choose id
+ |> String.concat ","
+ { Passed = failure = ""
+ Failure = failure
+ MenuOptions = menuOptions
+ ObservationCount = observations.Length
+ RumorPathLength = path.Length
+ Chronicle = chronicle
+ RumorTrace = rumorTrace }
+
+let runM5Smoke () : int =
+ let result = M5Smoke.run ()
+ printfn "m5_smoke menu_options=%d observations=%d rumor_path=%d" result.MenuOptions result.ObservationCount result.RumorPathLength
+ printfn "m5_chronicle=%s" (result.Chronicle.Replace('\n', '|'))
+ printfn "m5_rumor_trace=%s" (result.RumorTrace.Replace('\n', '|'))
+ printfn "M5_ACCEPTANCE=%s" (if result.Passed then "PASS" else "FAIL")
+ if result.Passed then 0 else 1
+
let replayRumors (days: int64) (seed: uint64) (npcCount: int) (world: World) : bool =
let expected = Sim.rumorTraceText world
let replayed = runSimulation false days seed npcCount |> fun stats -> Sim.rumorTraceText stats.World
@@ -278,46 +377,53 @@ let main argv =
(dump: bool)
(rumorTrace: bool)
(rumorReplay: bool)
+ (m5Smoke: bool)
(batch: (int * int64) option)
- : Result<int64 * uint64 * int * bool * bool * bool * (int * int64) option, string> =
+ : Result<int64 * uint64 * int * bool * bool * bool * bool * (int * int64) option, string> =
if i >= argv.Length then
match batch with
- | Some(k, d) -> Ok(defaultArg days 1L, defaultArg seed 42UL, defaultArg npc 30, dump, rumorTrace, rumorReplay, Some(k, d))
+ | Some(k, d) -> Ok(defaultArg days 1L, defaultArg seed 42UL, defaultArg npc 30, dump, rumorTrace, rumorReplay, m5Smoke, Some(k, d))
| None ->
match days, seed, npc with
- | Some d, Some s, Some n -> Ok(d, s, n, dump, rumorTrace, rumorReplay, None)
+ | Some d, Some s, Some n -> Ok(d, s, n, dump, rumorTrace, rumorReplay, m5Smoke, None)
+ | _ when m5Smoke -> Ok(defaultArg days 1L, defaultArg seed 42UL, defaultArg npc 30, dump, rumorTrace, rumorReplay, true, None)
| _ -> Error "missing --days/--seed"
else
match argv.[i] with
| "--days" when i + 1 < argv.Length ->
(match Int64.TryParse argv.[i + 1] with
- | true, d when d > 0L -> parse (i + 2) (Some d) seed npc dump rumorTrace rumorReplay batch
+ | true, d when d > 0L -> parse (i + 2) (Some d) seed npc dump rumorTrace rumorReplay m5Smoke batch
| _ -> Error $"invalid --days '{argv.[i + 1]}'")
| "--seed" when i + 1 < argv.Length ->
(match UInt64.TryParse argv.[i + 1] with
- | true, s -> parse (i + 2) days (Some s) npc dump rumorTrace rumorReplay batch
+ | true, s -> parse (i + 2) days (Some s) npc dump rumorTrace rumorReplay m5Smoke batch
| _ -> Error $"invalid --seed '{argv.[i + 1]}'")
| "--npc" when i + 1 < argv.Length ->
(match Int32.TryParse argv.[i + 1] with
- | true, n when n > 0 && n <= 1000 -> parse (i + 2) days seed (Some n) dump rumorTrace rumorReplay batch
+ | true, n when n > 0 && n <= 1000 -> parse (i + 2) days seed (Some n) dump rumorTrace rumorReplay m5Smoke batch
| _ -> Error $"invalid --npc '{argv.[i + 1]}'")
- | "--dump-relations" -> parse (i + 1) days seed npc true rumorTrace rumorReplay batch
- | "--dump-rumors" -> parse (i + 1) days seed npc dump true rumorReplay batch
- | "--replay-rumors" -> parse (i + 1) days seed npc dump rumorTrace true batch
- | "--batch" when i + 2 < argv.Length ->
- (match Int32.TryParse argv.[i + 1], Int64.TryParse argv.[i + 2] with
- | (true, k), (true, d) when k > 0 && d > 0L -> parse (i + 3) days seed npc dump rumorTrace rumorReplay (Some(k, d))
- | _ -> Error $"invalid --batch '{argv.[i + 1]} {argv.[i + 2]}'")
+ | "--dump-relations" -> parse (i + 1) days seed npc true rumorTrace rumorReplay m5Smoke batch
+ | "--dump-rumors" -> parse (i + 1) days seed npc dump true rumorReplay m5Smoke batch
+ | "--replay-rumors" -> parse (i + 1) days seed npc dump rumorTrace true m5Smoke batch
+ | "--m5-smoke" -> parse (i + 1) days seed npc dump rumorTrace rumorReplay true batch
+ | "--batch" when i + 2 < argv.Length ->
+ match Int32.TryParse argv.[i + 1], Int64.TryParse argv.[i + 2] with
+ | (true, k), (true, d) when k > 0 && d > 0L -> parse (i + 3) days seed npc dump rumorTrace rumorReplay m5Smoke (Some(k, d))
+ | _ -> Error $"invalid --batch '{argv.[i + 1]} {argv.[i + 2]}'"
| other -> Error $"unknown argument '{other}'"
- match parse 0 None None (Some 30) false false false None with
- | Ok(days, seed, npc, dump, rumorTrace, rumorReplay, batch) ->
- match batch with
- | Some(k, d) when rumorTrace || rumorReplay ->
+ match parse 0 None None (Some 30) false false false false None with
+ | Ok(days, seed, npc, dump, rumorTrace, rumorReplay, m5Smoke, batch) ->
+ match m5Smoke, batch with
+ | true, Some _ ->
+ eprintfn "headless: --m5-smoke cannot be combined with --batch"
+ 2
+ | true, None -> runM5Smoke ()
+ | false, Some(k, d) when rumorTrace || rumorReplay ->
eprintfn "headless: rumor trace/replay cannot be combined with --batch"
2
- | Some(k, d) -> runBatch k d
- | None ->
+ | false, Some(k, d) -> runBatch k d
+ | false, None ->
let stats = runSimulation true days seed npc
if dump then dumpRelations stats.World
if rumorTrace then dumpRumors stats.World
@@ -325,5 +431,5 @@ let main argv =
if stats.NonFinite > 0L || stats.OutOfBounds > 0L || not replayOk then 1 else 0
| Error msg ->
eprintfn $"headless: {msg}"
- eprintfn "usage: dotnet run -c Release --project src/LivingVillage.Headless -- --days N --seed S [--npc N] [--dump-relations] [--dump-rumors] [--replay-rumors] | --batch K D"
+ eprintfn "usage: dotnet run -c Release --project src/LivingVillage.Headless -- --days N --seed S [--npc N] [--dump-relations] [--dump-rumors] [--replay-rumors] | --m5-smoke | --batch K D"
2
diff --git a/src/LivingVillage.Kernel.Tests/DeterminismTests.fs b/src/LivingVillage.Kernel.Tests/DeterminismTests.fs
index cc1944f..52cae89 100644
--- a/src/LivingVillage.Kernel.Tests/DeterminismTests.fs
+++ b/src/LivingVillage.Kernel.Tests/DeterminismTests.fs
@@ -233,10 +233,21 @@ type DeterminismTests () =
| Rest -> 0.4f
| Pay -> 0.2f
| Hungry -> -0.4f
- | Chatted _ -> Sim.chatValence
- | Rumor _ -> 0.1f
- | Bought _ -> 0.3f
- | Sold _ -> 0.3f
+ | Chatted _ -> Sim.chatValence
+ | Rumor _ -> 0.1f
+ | Bought _ -> 0.3f
+ | Sold _ -> 0.3f
+ | Dialogue (_, _, response) ->
+ match response with
+ | Friendly -> 0.4f
+ | Helpful -> 0.5f
+ | Bargaining -> 0.2f
+ | Amused -> 0.35f
+ | Forgiving -> 0.45f
+ | Hostile -> -0.5f
+ | Reserved -> 0.0f
+ | Refused -> -0.1f
+ | Offended -> -0.4f
if e.Valence <> expected then
Assert.Fail($"valence/kind mismatch: {e.Kind} -> {e.Valence}")
if e.Valence < -1.0f || e.Valence > 1.0f then
diff --git a/src/LivingVillage.Kernel.Tests/LivingVillage.Kernel.Tests.fsproj b/src/LivingVillage.Kernel.Tests/LivingVillage.Kernel.Tests.fsproj
index f65200b..2a3ba3c 100644
--- a/src/LivingVillage.Kernel.Tests/LivingVillage.Kernel.Tests.fsproj
+++ b/src/LivingVillage.Kernel.Tests/LivingVillage.Kernel.Tests.fsproj
@@ -10,6 +10,7 @@
<Compile Include="RelationTests.fs" />
<Compile Include="RumorTests.fs" />
<Compile Include="TradeTests.fs" />
+ <Compile Include="M5Tests.fs" />
</ItemGroup>
<ItemGroup>
diff --git a/src/LivingVillage.Kernel.Tests/M5Tests.fs b/src/LivingVillage.Kernel.Tests/M5Tests.fs
new file mode 100644
index 0000000..5eb1501
--- /dev/null
+++ b/src/LivingVillage.Kernel.Tests/M5Tests.fs
@@ -0,0 +1,141 @@
+namespace LivingVillage.Kernel.Tests
+
+open Microsoft.VisualStudio.TestTools.UnitTesting
+open LivingVillage.Kernel
+open LivingVillage.Kernel.Sim
+
+module private M5Harness =
+
+ let zeroInput = { Input = { MoveX = 0.0f; MoveY = 0.0f } }
+
+ let atNpc (id: int) (world: World) : World =
+ let npc = world.Npcs.[id]
+ { world with Avatar = { world.Avatar with Pos = npc.Pos } }
+
+ let readyForChat (world: World) : World =
+ { world with
+ Npcs =
+ world.Npcs
+ |> Array.map (fun npc ->
+ { npc with
+ Mind =
+ { npc.Mind with
+ Action = Wander
+ Target = actionTarget Wander
+ ActionAge = minActionTicks
+ EffectDone = true } }) }
+
+ let atTick (tick: int64) (world: World) : World =
+ { world with
+ Tick = tick
+ Time = float tick * dtSeconds }
+
+ let chat (narrator: int) (receiver: int) (world: World) : World =
+ match Sim.chat { Narrator = NpcId narrator; Receiver = NpcId receiver } world with
+ | ChatSucceeded (_, next) -> next
+ | ChatRejected (failure, _) -> Assert.Fail($"chat rejected: {failure}"); Unchecked.defaultof<World>
+
+[<TestClass>]
+type M5Tests () =
+
+ [<TestMethod>]
+ member _.AvatarNeedsDecayAndNeedsPanelUsesTheSameValues () =
+ let before = Sim.initialWorld 42UL
+ let after = Sim.step M5Harness.zeroInput before
+ Assert.IsTrue(after.Avatar.Mind.Needs.Hunger < before.Avatar.Mind.Needs.Hunger)
+ Assert.IsTrue(after.Avatar.Mind.Needs.Energy < before.Avatar.Mind.Needs.Energy)
+ Assert.IsTrue(after.Avatar.Mind.Needs.Social < before.Avatar.Mind.Needs.Social)
+ Assert.IsTrue(after.Avatar.Mind.Needs.Money < before.Avatar.Mind.Needs.Money)
+ let panel = Sim.needsPanel after
+ Assert.AreEqual<Needs>(after.Avatar.Mind.Needs, panel.Needs)
+ Assert.IsFalse(panel.Ranked.IsEmpty)
+
+ [<TestMethod>]
+ member _.NearbyNpcOpensSixIntentDialogueMenu () =
+ let world = Sim.initialWorldN 42UL 4 |> M5Harness.atNpc 0
+ match Sim.openDialogueMenu world with
+ | Some menu ->
+ Assert.AreEqual<NpcId>(NpcId 0, menu.Target)
+ Assert.AreEqual<int>(6, menu.Options.Length)
+ Assert.IsTrue(menu.Options |> List.contains SmallTalk)
+ Assert.IsTrue(menu.Options |> List.contains AskHelp)
+ Assert.IsTrue(menu.Options |> List.contains OfferTrade)
+ | None -> Assert.Fail("nearby NPC should open a dialogue menu")
+
+ [<TestMethod>]
+ member _.SelectedIntentCreatesBilateralMemoryEventAndAnnal () =
+ let world = Sim.initialWorldN 42UL 4 |> M5Harness.atNpc 0
+ match Sim.chooseDialogue (NpcId 0) SmallTalk world with
+ | DialogueSucceeded (outcome, next) ->
+ Assert.AreEqual<NpcId>(playerId, outcome.Actor)
+ Assert.AreEqual<NpcId>(NpcId 0, outcome.Target)
+ Assert.IsTrue(next.Avatar.Mind.Memory |> List.exists (fun e ->
+ match e.Kind with
+ | Dialogue (NpcId target, SmallTalk, response) -> target = 0 && response = outcome.Response
+ | _ -> false))
+ Assert.IsTrue(next.Npcs.[0].Mind.Memory |> List.exists (fun e ->
+ match e.Kind with
+ | Dialogue (NpcId actor, SmallTalk, response) -> actor = -1 && response = outcome.Response
+ | _ -> false))
+ Assert.IsTrue(next.Events |> List.exists (fun event ->
+ match event.Kind with
+ | DialogueEvent recorded -> recorded = outcome
+ | _ -> false))
+ Assert.IsTrue(next.Annals |> List.exists (fun entry ->
+ match entry.Kind with
+ | DialogueAnnal recorded -> recorded = outcome
+ | _ -> false))
+ Assert.IsTrue(Sim.annalText next |> fun text -> text.Contains("dialogue"))
+ | DialogueRejected (failure, _) -> Assert.Fail($"dialogue rejected: {failure}")
+
+ [<TestMethod>]
+ member _.PlayerSmallTalkPassesThroughThreeIntermediariesAndReturnsToPlayer () =
+ let initial = Sim.initialWorldN 7UL 4 |> M5Harness.atNpc 0 |> M5Harness.readyForChat
+ let afterPlayer =
+ match Sim.chooseDialogue (NpcId 0) SmallTalk initial with
+ | DialogueSucceeded (_, next) -> next
+ | DialogueRejected (failure, _) -> Assert.Fail($"dialogue rejected: {failure}"); Unchecked.defaultof<World>
+ let first =
+ afterPlayer
+ |> M5Harness.atTick Sim.ticksPerDay
+ |> M5Harness.readyForChat
+ |> M5Harness.chat 0 1
+ let second =
+ first
+ |> M5Harness.atTick (2L * Sim.ticksPerDay)
+ |> M5Harness.readyForChat
+ |> M5Harness.chat 1 2
+ let third =
+ second
+ |> M5Harness.atTick (3L * Sim.ticksPerDay)
+ |> M5Harness.readyForChat
+ |> M5Harness.chat 2 -1
+ let finalRumor = third.Rumors |> List.sortBy (fun rumor -> rumor.Id) |> List.last
+ let path = Sim.rumorPath third finalRumor.Id
+ Assert.AreEqual<NpcId>(playerId, finalRumor.Source)
+ Assert.AreEqual<NpcId>(playerId, finalRumor.Receiver)
+ Assert.AreEqual<NpcId>(NpcId 2, finalRumor.Narrator)
+ Assert.AreEqual<int>(3, finalRumor.Depth)
+ Assert.AreEqual<int>(4, path.Length)
+ Assert.AreEqual<NpcId>(playerId, path.Head.Source)
+ Assert.AreEqual<NpcId>(playerId, path |> List.last |> fun rumor -> rumor.Receiver)
+
+ [<TestMethod>]
+ member _.ObservationOnlyIncludesVisibleNpcsAndRanksUrgentNeeds () =
+ let baseWorld = Sim.initialWorldN 42UL 2
+ let visibleNpc =
+ { baseWorld.Npcs.[0] with
+ Pos = { X = 10.0f; Y = 10.0f }
+ Mind =
+ { baseWorld.Npcs.[0].Mind with
+ Needs = { baseWorld.Npcs.[0].Mind.Needs with Hunger = 5.0f; Money = 90.0f } } }
+ let hiddenNpc = { baseWorld.Npcs.[1] with Pos = { X = 200.0f; Y = 200.0f } }
+ let world = { baseWorld with Npcs = [| visibleNpc; hiddenNpc |] }
+ let observations =
+ Sim.observeVisible
+ { Min = { X = 0.0f; Y = 0.0f }
+ Max = { X = 100.0f; Y = 100.0f } }
+ world
+ Assert.AreEqual<int>(1, observations.Length)
+ Assert.AreEqual<NpcId>(NpcId 0, observations.Head.Id)
+ Assert.AreEqual<NeedKind>(HungerNeed, observations.Head.Ranked.Head.Kind)
diff --git a/src/LivingVillage.Kernel.Tests/RelationTests.fs b/src/LivingVillage.Kernel.Tests/RelationTests.fs
index 20331ce..b98252d 100644
--- a/src/LivingVillage.Kernel.Tests/RelationTests.fs
+++ b/src/LivingVillage.Kernel.Tests/RelationTests.fs
@@ -32,11 +32,22 @@ module RelationHarness =
{ Tick = tick
Time = 0.0
Rng = Rng.ofSeed 1UL
- Avatar = { Pos = { X = 0.0f; Y = 0.0f } }
+ Avatar =
+ { Pos = { X = 0.0f; Y = 0.0f }
+ Mind =
+ { Needs = needs
+ Personality = personalityOfSeed 1UL
+ Action = Wander
+ Target = actionTarget Wander
+ ActionAge = 0L
+ EffectDone = false
+ HungerFlagged = false
+ Memory = [] } }
NoHost = { Reserved = 0UL }
Npcs = [| mkNpc 0 mem0; mkNpc 1 mem1 |]
Events = []
- Rumors = [] }
+ Rumors = []
+ Annals = [] }
let chatted (tick: int64) (partner: int) : MemoryEvent =
{ Tick = tick; Kind = Chatted(NpcId partner); Valence = Sim.chatValence }
@@ -182,11 +193,22 @@ type RelationTests () =
{ Tick = 1L
Time = 0.0
Rng = Rng.ofSeed 55UL
- Avatar = { Pos = plaza }
+ Avatar =
+ { Pos = plaza
+ Mind =
+ { Needs = needs
+ Personality = personality
+ Action = Wander
+ Target = actionTarget Wander
+ ActionAge = 0L
+ EffectDone = false
+ HungerFlagged = false
+ Memory = [] } }
NoHost = { Reserved = 0UL }
Npcs = [| self; nearest; alternate |]
Events = []
- Rumors = [] }
+ Rumors = []
+ Annals = [] }
let next = Sim.step RelationHarness.zeroInput world
match List.tryHead next.Npcs.[0].Mind.Memory with
| Some entry ->
diff --git a/src/LivingVillage.Kernel.Tests/RumorTests.fs b/src/LivingVillage.Kernel.Tests/RumorTests.fs
index 3c9b267..f52fca9 100644
--- a/src/LivingVillage.Kernel.Tests/RumorTests.fs
+++ b/src/LivingVillage.Kernel.Tests/RumorTests.fs
@@ -37,11 +37,22 @@ module private RumorHarness =
{ Tick = tick
Time = float tick * dtSeconds
Rng = Rng.ofSeed 11UL
- Avatar = { Pos = { X = 0.0f; Y = 0.0f } }
+ Avatar =
+ { Pos = { X = 0.0f; Y = 0.0f }
+ Mind =
+ { Needs = needs
+ Personality = personality
+ Action = Wander
+ Target = actionTarget Wander
+ ActionAge = 0L
+ EffectDone = false
+ HungerFlagged = false
+ Memory = [] } }
NoHost = { Reserved = 0UL }
Npcs = Array.init count npc
Events = []
- Rumors = [] }
+ Rumors = []
+ Annals = [] }
let readyForChat (world: World) : World =
{ world with
diff --git a/src/LivingVillage.Kernel.Tests/TradeTests.fs b/src/LivingVillage.Kernel.Tests/TradeTests.fs
index 5a0e724..77e5658 100644
--- a/src/LivingVillage.Kernel.Tests/TradeTests.fs
+++ b/src/LivingVillage.Kernel.Tests/TradeTests.fs
@@ -39,13 +39,24 @@ module private TradeHarness =
{ Tick = 10L
Time = 0.0
Rng = Rng.ofSeed 7UL
- Avatar = { Pos = { X = 0.0f; Y = 0.0f } }
+ Avatar =
+ { Pos = { X = 0.0f; Y = 0.0f }
+ Mind =
+ { Needs = needs 50.0f 100.0f
+ Personality = personality
+ Action = Wander
+ Target = actionTarget Wander
+ ActionAge = 0L
+ EffectDone = false
+ HungerFlagged = false
+ Memory = [] } }
NoHost = { Reserved = 0UL }
Npcs =
- [| npc 0 buyerMoney buyerHunger buyerFood [] None
- npc 1 sellerMoney sellerHunger sellerFood sellerMemory None |]
+ [| npc 0 buyerMoney buyerHunger buyerFood [] None
+ npc 1 sellerMoney sellerHunger sellerFood sellerMemory None |]
Events = []
- Rumors = [] }
+ Rumors = []
+ Annals = [] }
let request quantity =
{ Buyer = NpcId 0
diff --git a/src/LivingVillage.Kernel/Sim.fs b/src/LivingVillage.Kernel/Sim.fs
index 5fb56fd..0845abd 100644
--- a/src/LivingVillage.Kernel/Sim.fs
+++ b/src/LivingVillage.Kernel/Sim.fs
@@ -7,10 +7,6 @@ module Sim =
{ X: float32
Y: float32 }
- [<Struct>]
- type Avatar =
- { Pos: Vec2 }
-
type Input =
{ MoveX: float32
MoveY: float32 }
@@ -55,6 +51,33 @@ module Sim =
type RumorId =
| RumorId of int64
+ type DialogueIntent =
+ | SmallTalk
+ | AskHelp
+ | OfferTrade
+ | Joke
+ | Apologize
+ | Provoke
+
+ type DialogueResponse =
+ | Friendly
+ | Helpful
+ | Bargaining
+ | Amused
+ | Forgiving
+ | Hostile
+ | Reserved
+ | Refused
+ | Offended
+
+ type DialogueOutcome =
+ { Tick: int64
+ Actor: NpcId
+ Target: NpcId
+ Intent: DialogueIntent
+ Response: DialogueResponse
+ Valence: float32 }
+
type MemoryKind =
| Meal
| Rest
@@ -64,6 +87,7 @@ module Sim =
| Rumor of RumorId
| Bought of NpcId * ItemKind * int * float32
| Sold of NpcId * ItemKind * int * float32
+ | Dialogue of NpcId * DialogueIntent * DialogueResponse
type RumorEvent =
{ Id: RumorId
@@ -84,11 +108,51 @@ module Sim =
type InteractionKind =
| ChatInit of NpcId * NpcId
| TradeEvent of NpcId * NpcId * ItemKind * int * float32
+ | DialogueEvent of DialogueOutcome
type InteractionEvent =
{ Tick: int64
Kind: InteractionKind }
+ type NeedKind =
+ | HungerNeed
+ | EnergyNeed
+ | SocialNeed
+ | MoneyNeed
+
+ type NeedScore =
+ { Kind: NeedKind
+ Urgency: float32 }
+
+ type NeedsPanel =
+ { Needs: Needs
+ Ranked: NeedScore list }
+
+ type VisibleBounds =
+ { Min: Vec2
+ Max: Vec2 }
+
+ type Observation =
+ { Id: NpcId
+ Pos: Vec2
+ Needs: Needs
+ Ranked: NeedScore list
+ RecentMemory: MemoryEvent list }
+
+ type DialogueMenu =
+ { Target: NpcId
+ Options: DialogueIntent list }
+
+ type AnnalKind =
+ | DialogueAnnal of DialogueOutcome
+ | RumorAnnal of RumorEvent
+ | TradeAnnal of InteractionEvent
+
+ type AnnalEntry =
+ { Tick: int64
+ Kind: AnnalKind
+ Summary: string }
+
[<Struct>]
type Mind =
{ Needs: Needs
@@ -101,6 +165,11 @@ module Sim =
Memory: MemoryEvent list }
[<Struct>]
+ type Avatar =
+ { Pos: Vec2
+ Mind: Mind }
+
+ [<Struct>]
type Npc =
{ Id: NpcId
Pos: Vec2
@@ -116,7 +185,17 @@ module Sim =
NoHost: NoHost
Npcs: Npc[]
Events: InteractionEvent list
- Rumors: RumorEvent list }
+ Rumors: RumorEvent list
+ Annals: AnnalEntry list }
+
+ type DialogueFailure =
+ | DialogueTargetNotFound
+ | DialogueTargetOutOfRange
+ | DialogueTargetUnavailable
+
+ type DialogueResult =
+ | DialogueSucceeded of DialogueOutcome * World
+ | DialogueRejected of DialogueFailure * World
type ChatRequest =
{ Narrator: NpcId
@@ -182,8 +261,15 @@ module Sim =
let relationHalfLifeTicks = ticksPerDay // HALF_LIFE = 1 模拟日（修复单位错误：原 86400L 实为 24 模拟分钟；1 模拟日 = ticksPerDay = 5,184,000 tick）
let relationThreshold = 0.5f // |rel| > 0.5 视为有关系
+ let playerId = NpcId -1
+ let dialogueOptions = [ SmallTalk; AskHelp; OfferTrade; Joke; Apologize; Provoke ]
+ let maxAnnalEntries = 128
+
let clamp (v: float32) (lo: float32) (hi: float32) : float32 = if v < lo then lo elif v > hi then hi else v
+ let private appendAnnal (entry: AnnalEntry) (world: World) : World =
+ { world with Annals = (entry :: world.Annals) |> List.truncate maxAnnalEntries }
+
let hungerDecayPerTick = 0.0012f
let energyDecayPerTick = 0.0010f
let socialDecayPerTick = 0.0008f
@@ -221,12 +307,24 @@ module Sim =
| Rumor _ -> 0.1f
| Bought _ -> 0.3f
| Sold _ -> 0.3f
+ | Dialogue (_, _, response) ->
+ match response with
+ | Friendly -> 0.4f
+ | Helpful -> 0.5f
+ | Bargaining -> 0.2f
+ | Amused -> 0.35f
+ | Forgiving -> 0.45f
+ | Hostile -> -0.5f
+ | Reserved -> 0.0f
+ | Refused -> -0.1f
+ | Offended -> -0.4f
let recordMemory (tick: int64) (kind: MemoryKind) (mem: MemoryEvent list) : MemoryEvent list =
let updated = { Tick = tick; Kind = kind; Valence = valenceOfKind kind } :: mem
let isRelational (event: MemoryEvent) =
match event.Kind with
- | Chatted _ -> true
+ | Chatted _
+ | Dialogue _ -> true
| _ -> false
let relationalCount = updated |> List.sumBy (fun event -> if isRelational event then 1 else 0)
let relationalCapacity = min memoryCapacity relationalCount
@@ -288,6 +386,18 @@ module Sim =
|| n.Social < urgentThreshold
|| n.Money < urgentThreshold
+ let private rankNeeds (n: Needs) : NeedScore list =
+ [ { Kind = HungerNeed; Urgency = clamp (100.0f - n.Hunger) 0.0f 100.0f }
+ { Kind = EnergyNeed; Urgency = clamp (100.0f - n.Energy) 0.0f 100.0f }
+ { Kind = SocialNeed; Urgency = clamp (100.0f - n.Social) 0.0f 100.0f }
+ { Kind = MoneyNeed; Urgency = clamp (100.0f - n.Money) 0.0f 100.0f } ]
+ |> List.sortByDescending (fun score -> score.Urgency)
+
+ let needsPanel (world: World) : NeedsPanel =
+ let needs = world.Avatar.Mind.Needs
+ { Needs = needs
+ Ranked = rankNeeds needs }
+
let applyActionEffect (kind: NpcActionKind) (n: Needs) : Needs =
match kind with
| Eat -> { n with Hunger = n.Hunger + 40.0f; Money = n.Money - 5.0f }
@@ -326,14 +436,26 @@ module Sim =
EffectDone = false
HungerFlagged = false
Memory = [] } }
+ let avatar =
+ { Pos = { X = centerX; Y = centerY }
+ Mind =
+ { Needs = needs
+ Personality = personality
+ Action = Wander
+ Target = { X = centerX; Y = centerY }
+ ActionAge = 0L
+ EffectDone = false
+ HungerFlagged = false
+ Memory = [] } }
{ Tick = 0L
Time = 0.0
Rng = Rng.ofSeed seed
- Avatar = { Pos = { X = centerX; Y = centerY } }
+ Avatar = avatar
NoHost = { Reserved = 0UL }
Npcs = [| npc |]
Events = []
- Rumors = [] }
+ Rumors = []
+ Annals = [] }
let initialWorldN (seed: uint64) (count: int) : World =
let base_ = initialWorld seed
@@ -465,7 +587,13 @@ module Sim =
let event =
{ Tick = world.Tick
Kind = TradeEvent(request.Buyer, request.Seller, request.Item, request.Quantity, unitPrice) }
- TradeSucceeded { world with Npcs = newNpcs; Events = world.Events @ [ event ] }
+ let updated = { world with Npcs = newNpcs; Events = world.Events @ [ event ] }
+ 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 request.Buyer request.Seller request.Item request.Quantity unitPrice }
+ TradeSucceeded(appendAnnal entry updated)
let chatableForChat (n: Npc) : bool =
n.Mind.Action <> Sleep && n.Mind.Action <> Chat
@@ -520,6 +648,123 @@ module Sim =
max current id) -1L
RumorId(maxId + 1L)
+ let private dialogueAvailable (npc: Npc) : bool =
+ npc.Mind.Action <> Sleep && npc.Mind.Action <> Chat
+
+ let openDialogueMenu (world: World) : DialogueMenu option =
+ let nearby =
+ world.Npcs
+ |> Array.choose (fun npc ->
+ let dx = npc.Pos.X - world.Avatar.Pos.X
+ let dy = npc.Pos.Y - world.Avatar.Pos.Y
+ let distanceSq = dx * dx + dy * dy
+ if distanceSq <= chatRangeSq && dialogueAvailable npc then
+ Some(distanceSq, npc.Id)
+ else None)
+ |> Array.sortBy fst
+ nearby
+ |> Array.tryHead
+ |> Option.map (fun (_, target) ->
+ { Target = target
+ Options = dialogueOptions })
+
+ let private responseFor (intent: DialogueIntent) (personality: Personality) : DialogueResponse =
+ match intent with
+ | SmallTalk -> if personality.Extraversion >= 0.5f then Friendly else Reserved
+ | AskHelp -> if personality.Honesty >= 0.4f then Helpful else Refused
+ | OfferTrade -> Bargaining
+ | Joke -> if personality.Extraversion >= 0.5f then Amused else Reserved
+ | Apologize -> if personality.Aggression < 0.7f then Forgiving else Offended
+ | Provoke -> if personality.Aggression >= 0.5f then Hostile else Offended
+
+ let private dialogueSummary (outcome: DialogueOutcome) : string =
+ sprintf "dialogue tick=%d actor=%A target=%A intent=%A response=%A valence=%.2f"
+ outcome.Tick outcome.Actor outcome.Target outcome.Intent outcome.Response outcome.Valence
+
+ let private rumorSummary (rumor: RumorEvent) : string =
+ sprintf "rumor tick=%d source=%A narrator=%A receiver=%A depth=%d"
+ rumor.Tick rumor.Source rumor.Narrator rumor.Receiver rumor.Depth
+
+ let chooseDialogue (target: NpcId) (intent: DialogueIntent) (world: World) : DialogueResult =
+ match findNpcIndex target world.Npcs with
+ | None -> DialogueRejected(DialogueTargetNotFound, world)
+ | Some targetIndex ->
+ let targetNpc = world.Npcs.[targetIndex]
+ let dx = targetNpc.Pos.X - world.Avatar.Pos.X
+ let dy = targetNpc.Pos.Y - world.Avatar.Pos.Y
+ if dx * dx + dy * dy > chatRangeSq then
+ DialogueRejected(DialogueTargetOutOfRange, world)
+ elif not (dialogueAvailable targetNpc) then
+ DialogueRejected(DialogueTargetUnavailable, world)
+ else
+ let response = responseFor intent targetNpc.Mind.Personality
+ let outcome =
+ { Tick = world.Tick
+ Actor = playerId
+ Target = target
+ Intent = intent
+ Response = response
+ Valence = valenceOfKind (Dialogue(target, intent, response)) }
+ let rumor =
+ { Id = nextRumorId world
+ Tick = world.Tick
+ OriginTick = world.Tick
+ Source = playerId
+ Narrator = playerId
+ Receiver = target
+ Parent = None
+ Depth = 0
+ Strength = 1.0f }
+ let newNpcs = Array.copy world.Npcs
+ let targetMemory =
+ recordMemory world.Tick (Dialogue(playerId, intent, response)) targetNpc.Mind.Memory
+ |> recordMemory world.Tick (Rumor rumor.Id)
+ newNpcs.[targetIndex] <- { targetNpc with Mind = { targetNpc.Mind with Memory = targetMemory } }
+ let avatarMemory = recordMemory world.Tick (Dialogue(target, intent, response)) world.Avatar.Mind.Memory
+ let event = { Tick = world.Tick; Kind = DialogueEvent outcome }
+ let updated =
+ { world with
+ Avatar = { world.Avatar with Mind = { world.Avatar.Mind with Memory = avatarMemory } }
+ Npcs = newNpcs
+ Events = world.Events @ [ event ]
+ Rumors = rumor :: world.Rumors }
+ let withRumorAnnal =
+ appendAnnal
+ { Tick = world.Tick
+ Kind = RumorAnnal rumor
+ Summary = rumorSummary rumor }
+ updated
+ let withDialogueAnnal =
+ appendAnnal
+ { Tick = world.Tick
+ Kind = DialogueAnnal outcome
+ Summary = dialogueSummary outcome }
+ withRumorAnnal
+ DialogueSucceeded(outcome, withDialogueAnnal)
+
+ let annalText (world: World) : string =
+ let rows =
+ world.Annals
+ |> List.rev
+ |> List.map (fun entry -> sprintf "tick=%d %s" entry.Tick entry.Summary)
+ String.concat "\n" (sprintf "chronicle count=%d" world.Annals.Length :: rows)
+
+ let observeVisible (bounds: VisibleBounds) (world: World) : Observation list =
+ let inside (pos: Vec2) =
+ pos.X >= bounds.Min.X
+ && pos.X <= bounds.Max.X
+ && pos.Y >= bounds.Min.Y
+ && pos.Y <= bounds.Max.Y
+ world.Npcs
+ |> Array.toList
+ |> List.filter (fun npc -> inside npc.Pos)
+ |> List.map (fun npc ->
+ { Id = npc.Id
+ Pos = npc.Pos
+ Needs = npc.Mind.Needs
+ Ranked = rankNeeds npc.Mind.Needs
+ RecentMemory = List.truncate 8 npc.Mind.Memory })
+
let private rumorIsDuplicate (request: ChatRequest) (parent: RumorEvent option) (world: World) : bool =
let parentId = parent |> Option.map (fun rumor -> rumor.Id)
world.Rumors
@@ -531,74 +776,107 @@ module Sim =
&& world.Tick - rumor.Tick <= rumorFreshnessTicks
&& rumorStrengthAt world.Tick rumor >= rumorMinimumStrength)
+ type private ChatParticipant =
+ | AvatarParticipant
+ | NpcParticipant of int
+
+ let private findChatParticipant (id: NpcId) (world: World) : ChatParticipant option =
+ if id = playerId then
+ Some AvatarParticipant
+ else
+ findNpcIndex id world.Npcs |> Option.map NpcParticipant
+
+ let private participantPosition (participant: ChatParticipant) (world: World) : Vec2 =
+ match participant with
+ | AvatarParticipant -> world.Avatar.Pos
+ | NpcParticipant index -> world.Npcs.[index].Pos
+
+ let private participantChatable (participant: ChatParticipant) (world: World) : bool =
+ match participant with
+ | AvatarParticipant -> true
+ | NpcParticipant index -> chatableForChat world.Npcs.[index]
+
+ let private markChat (participant: ChatParticipant) (other: NpcId) (otherPos: Vec2) (world: World) : World =
+ match participant with
+ | AvatarParticipant ->
+ let memory = recordMemory world.Tick (Chatted other) world.Avatar.Mind.Memory
+ { world with Avatar = { world.Avatar with Mind = { world.Avatar.Mind with Memory = memory } } }
+ | NpcParticipant index ->
+ let newNpcs = Array.copy world.Npcs
+ let npc = newNpcs.[index]
+ let memory = recordMemory world.Tick (Chatted other) npc.Mind.Memory
+ newNpcs.[index] <-
+ { npc with
+ Mind =
+ { npc.Mind with
+ Action = Chat
+ Target = otherPos
+ ActionAge = 0L
+ EffectDone = false
+ Memory = memory } }
+ { world with Npcs = newNpcs }
+
let chat (request: ChatRequest) (world: World) : ChatResult =
- match findNpcIndex request.Narrator world.Npcs with
- | None -> ChatRejected(NarratorNotFound, world)
- | Some narratorIndex when request.Narrator = request.Receiver -> ChatRejected(ChatSameParticipant, world)
- | Some narratorIndex ->
- match findNpcIndex request.Receiver world.Npcs with
- | None -> ChatRejected(ReceiverNotFound, world)
- | Some receiverIndex ->
- let narrator = world.Npcs.[narratorIndex]
- let receiver = world.Npcs.[receiverIndex]
- if not (chatableForChat narrator) || not (chatableForChat receiver) then
- ChatRejected(ParticipantNotChatable, world)
+ match findChatParticipant request.Narrator world, findChatParticipant request.Receiver world with
+ | None, _ -> ChatRejected(NarratorNotFound, world)
+ | _, None -> ChatRejected(ReceiverNotFound, world)
+ | Some _, Some _ when request.Narrator = request.Receiver -> ChatRejected(ChatSameParticipant, world)
+ | Some narrator, Some receiver ->
+ if not (participantChatable narrator world) || not (participantChatable receiver world) then
+ ChatRejected(ParticipantNotChatable, world)
+ else
+ let parent = latestRumorFor request.Narrator world
+ let narratorPos = participantPosition narrator world
+ let receiverPos = participantPosition receiver world
+ let chatted =
+ world
+ |> markChat narrator request.Receiver receiverPos
+ |> markChat receiver request.Narrator narratorPos
+ if rumorIsDuplicate request parent world then
+ ChatSucceeded(None, chatted)
else
- let parent = latestRumorFor request.Narrator world
- let newNpcs = Array.copy world.Npcs
- let narratorMemory = recordMemory world.Tick (Chatted request.Receiver) narrator.Mind.Memory
- let receiverMemory = recordMemory world.Tick (Chatted request.Narrator) receiver.Mind.Memory
- newNpcs.[narratorIndex] <-
- { narrator with
- Mind =
- { narrator.Mind with
- Action = Chat
- Target = receiver.Pos
- ActionAge = 0L
- EffectDone = false
- Memory = narratorMemory } }
- newNpcs.[receiverIndex] <-
- { receiver with
- Mind =
- { receiver.Mind with
- Action = Chat
- Target = narrator.Pos
- ActionAge = 0L
- EffectDone = false
- Memory = receiverMemory } }
- let chatted = { world with Npcs = newNpcs }
- if rumorIsDuplicate request parent world then
- ChatSucceeded(None, chatted)
- else
- let rumor =
- match parent with
- | None ->
- { Id = nextRumorId world
- Tick = world.Tick
- OriginTick = world.Tick
- Source = request.Narrator
- Narrator = request.Narrator
- Receiver = request.Receiver
- Parent = None
- Depth = 0
- Strength = 1.0f }
- | Some parent ->
- { Id = nextRumorId world
- Tick = world.Tick
- OriginTick = parent.OriginTick
- Source = parent.Source
- Narrator = request.Narrator
- Receiver = request.Receiver
- Parent = Some parent.Id
- Depth = parent.Depth + 1
- Strength = rumorStrengthAt world.Tick parent }
- let receiverWithRumor =
- { newNpcs.[receiverIndex] with
- Mind =
- { newNpcs.[receiverIndex].Mind with
- Memory = recordMemory world.Tick (Rumor rumor.Id) newNpcs.[receiverIndex].Mind.Memory } }
- newNpcs.[receiverIndex] <- receiverWithRumor
- ChatSucceeded(Some rumor, { chatted with Npcs = newNpcs; Rumors = rumor :: world.Rumors })
+ let rumor =
+ match parent with
+ | None ->
+ { Id = nextRumorId world
+ Tick = world.Tick
+ OriginTick = world.Tick
+ Source = request.Narrator
+ Narrator = request.Narrator
+ Receiver = request.Receiver
+ Parent = None
+ Depth = 0
+ Strength = 1.0f }
+ | Some parent ->
+ { Id = nextRumorId world
+ Tick = world.Tick
+ OriginTick = parent.OriginTick
+ Source = parent.Source
+ Narrator = request.Narrator
+ Receiver = request.Receiver
+ Parent = Some parent.Id
+ Depth = parent.Depth + 1
+ Strength = rumorStrengthAt world.Tick parent }
+ let withReceiverRumor =
+ match receiver with
+ | AvatarParticipant ->
+ let memory = recordMemory world.Tick (Rumor rumor.Id) chatted.Avatar.Mind.Memory
+ { chatted with Avatar = { chatted.Avatar with Mind = { chatted.Avatar.Mind with Memory = memory } } }
+ | NpcParticipant index ->
+ let newNpcs = Array.copy chatted.Npcs
+ let npc = newNpcs.[index]
+ newNpcs.[index] <-
+ { npc with
+ Mind = { npc.Mind with Memory = recordMemory world.Tick (Rumor rumor.Id) npc.Mind.Memory } }
+ { chatted with Npcs = newNpcs }
+ let updated = { withReceiverRumor with Rumors = rumor :: world.Rumors }
+ ChatSucceeded(
+ Some rumor,
+ appendAnnal
+ { Tick = world.Tick
+ Kind = RumorAnnal rumor
+ Summary = rumorSummary rumor }
+ updated)
let rumorPath (world: World) (target: RumorId) : RumorEvent list =
let rec collect (visited: Set<RumorId>) (current: RumorId) (acc: RumorEvent list) =
@@ -729,6 +1007,23 @@ module Sim =
for i in 0 .. newNpcs.Length - 1 do
newNpcs.[i] <- stepNpc tick oldNpcs pending newNpcs.[i]
let queue = if pending.Count = 0 then world.Events else world.Events @ List.ofSeq pending
+ let avatarNeeds =
+ needsClamp
+ { Hunger = world.Avatar.Mind.Needs.Hunger - hungerDecayPerTick
+ Energy = world.Avatar.Mind.Needs.Energy - energyDecayPerTick
+ Social = world.Avatar.Mind.Needs.Social - socialDecayPerTick
+ Money = world.Avatar.Mind.Needs.Money - moneyDecayPerTick }
+ let avatarMemory, avatarFlagged =
+ if avatarNeeds.Hunger < urgentThreshold && not world.Avatar.Mind.HungerFlagged then
+ (recordMemory tick Hungry world.Avatar.Mind.Memory), true
+ else
+ world.Avatar.Mind.Memory, avatarNeeds.Hunger < urgentThreshold
+ let avatarMind =
+ { world.Avatar.Mind with
+ Needs = avatarNeeds
+ ActionAge = world.Avatar.Mind.ActionAge + 1L
+ HungerFlagged = avatarFlagged
+ Memory = avatarMemory }
let baseWorld =
{ world with
Tick = tick
@@ -737,7 +1032,8 @@ module Sim =
Avatar =
{ Pos =
{ X = clamp (world.Avatar.Pos.X + dx) 0.0f maxX
- Y = clamp (world.Avatar.Pos.Y + dy) 0.0f maxY } }
+ Y = clamp (world.Avatar.Pos.Y + dy) 0.0f maxY }
+ Mind = avatarMind }
Npcs = newNpcs }
let mutable nextWorld = baseWorld
for ev in queue do
@@ -747,6 +1043,7 @@ module Sim =
| ChatSucceeded (_, updated) -> nextWorld <- updated
| ChatRejected (_, _) -> ()
| TradeEvent _ -> ()
+ | DialogueEvent _ -> ()
{ nextWorld with Events = [] }
// ---- 关系网派生：rel(i,j) = sum(Chatted valence * exp(-ln2*(now-tick)/HALF_LIFE))（真半衰：age=HALF_LIFE 处权重恰 0.5）----
generated by cgit v1.2.3 (git 2.39.1) at 2026-10-04 16:35:53 +0000