feat(m6a): add save speed and day-night controls

11 files changed, 818 insertions, 10 deletions

diff --git a/src/LivingVillage.Desktop.Tests/DesktopTests.fs b/src/LivingVillage.Desktop.Tests/DesktopTests.fs
index ffcc6c0..650f757 100644
--- a/src/LivingVillage.Desktop.Tests/DesktopTests.fs
+++ b/src/LivingVillage.Desktop.Tests/DesktopTests.fs
@@ -61,3 +61,13 @@ type DesktopTests () =
         Assert.IsTrue(result.Chronicle.Contains("dialogue"))
         Assert.IsTrue(result.RumorTrace.Contains("receiver=-1"))
         Assert.IsTrue(result.RumorTrace.Contains("depth=3"))
+
+    [<TestMethod>]
+    member _.DayNightStateChangesTheRenderProfile () =
+        let day = M6Presentation.profileAtTick (6L * Sim.ticksPerDay / 24L)
+        let night = M6Presentation.profileAtTick (22L * Sim.ticksPerDay / 24L)
+
+        Assert.AreEqual<M6DayNight>(Day, day.Mode)
+        Assert.AreEqual<M6DayNight>(Night, night.Mode)
+        Assert.AreNotEqual(day.Background, night.Background)
+        Assert.AreNotEqual(day.WorldTint, night.WorldTint)
diff --git a/src/LivingVillage.Desktop.Tests/LivingVillage.Desktop.Tests.fsproj b/src/LivingVillage.Desktop.Tests/LivingVillage.Desktop.Tests.fsproj
index a1cbe33..b8e2055 100644
--- a/src/LivingVillage.Desktop.Tests/LivingVillage.Desktop.Tests.fsproj
+++ b/src/LivingVillage.Desktop.Tests/LivingVillage.Desktop.Tests.fsproj
@@ -7,6 +7,7 @@
 
   <ItemGroup>
     <Compile Include="DesktopTests.fs" />
+    <Compile Include="M6aTests.fs" />
   </ItemGroup>
 
   <ItemGroup>
diff --git a/src/LivingVillage.Desktop.Tests/M6aTests.fs b/src/LivingVillage.Desktop.Tests/M6aTests.fs
new file mode 100644
index 0000000..1cc29d4
--- /dev/null
+++ b/src/LivingVillage.Desktop.Tests/M6aTests.fs
@@ -0,0 +1,15 @@
+namespace LivingVillage.Desktop.Tests
+
+open Microsoft.VisualStudio.TestTools.UnitTesting
+open LivingVillage.Kernel
+open LivingVillage.Desktop
+
+[<TestClass>]
+type M6aDesktopTests () =
+
+    [<TestMethod>]
+    member _.SpeedLabelsExposePauseAndThreeRunningModes () =
+        Assert.AreEqual<string>("PAUSED", M6Presentation.clockLabel { Paused = true; Speed = OneX })
+        Assert.AreEqual<string>("1X", M6Presentation.clockLabel { Paused = false; Speed = OneX })
+        Assert.AreEqual<string>("2X", M6Presentation.clockLabel { Paused = false; Speed = TwoX })
+        Assert.AreEqual<string>("5X", M6Presentation.clockLabel { Paused = false; Speed = FiveX })
diff --git a/src/LivingVillage.Desktop/Game.fs b/src/LivingVillage.Desktop/Game.fs
index 09d3364..232930d 100644
--- a/src/LivingVillage.Desktop/Game.fs
+++ b/src/LivingVillage.Desktop/Game.fs
@@ -139,13 +139,19 @@ type LivingVillageGame() as this =
     let autoplay = Environment.GetEnvironmentVariable("LV_AUTOPLAY") = "1"
     let titleSuffix = if autoplay then " [AUTOPLAY]" else ""
     let modeName = if autoplay then "autoplay" else "keyboard"
-    let stepsPerFrame =
+    let configuredStepsPerFrame =
         match Environment.GetEnvironmentVariable("LV_STEPS_PER_FRAME") with
         | null | "" -> 1
         | s ->
             match Int32.TryParse s with
             | true, n when n > 0 -> n
             | _ -> 1
+    let initialSimulationControl, initialLegacyStepsPerFrame =
+        SimulationControl.initialForConfiguredSteps configuredStepsPerFrame
+    let savePath =
+        match Environment.GetEnvironmentVariable("LV_SAVE_PATH") with
+        | null | "" -> "living-village.save"
+        | path -> path
     let graphics = new GraphicsDeviceManager(this)
     let mutable spriteBatch = Unchecked.defaultof<SpriteBatch>
     let mutable atlas = Unchecked.defaultof<Texture2D>
@@ -159,6 +165,8 @@ type LivingVillageGame() as this =
     let mutable relationView = false
     let mutable relationSnapshot: float32[,] option = None
     let mutable m5View = M5Interaction.initial
+    let mutable simulationControl = initialSimulationControl
+    let mutable legacyStepsPerFrame = initialLegacyStepsPerFrame
 
     do
         graphics.PreferredBackBufferWidth <- 1280
@@ -166,9 +174,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 M5 [AUTOPLAY]" else "Living Village M5"
+        this.Window.Title <- if autoplay then "Living Village M6 [AUTOPLAY]" else "Living Village M6"
         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"
+        printfn "controls=WASD move E interact 1-6 choose Q observe Tab needs C chronicle L relations P pause F1/F2/F3 speed F6 save F7 load Esc close/exit"
     member private this.CenterCamera() =
         let viewport = this.GraphicsDevice.Viewport
         let vw = float32 viewport.Width
@@ -196,6 +204,37 @@ type LivingVillageGame() as this =
         let pressedAny (keys: Keys list) = keys |> List.exists pressed
         let lPressed = pressed Keys.L
         let escapePressed = pressed Keys.Escape
+        if pressed Keys.P then
+            simulationControl <- SimulationControl.togglePause simulationControl
+            printfn $"simulation={M6Presentation.clockLabel simulationControl}"
+        if pressed Keys.F1 then
+            simulationControl <- SimulationControl.setSpeed OneX simulationControl
+            legacyStepsPerFrame <- None
+            printfn $"simulation={M6Presentation.clockLabel simulationControl}"
+        if pressed Keys.F2 then
+            simulationControl <- SimulationControl.setSpeed TwoX simulationControl
+            legacyStepsPerFrame <- None
+            printfn $"simulation={M6Presentation.clockLabel simulationControl}"
+        if pressed Keys.F3 then
+            simulationControl <- SimulationControl.setSpeed FiveX simulationControl
+            legacyStepsPerFrame <- None
+            printfn $"simulation={M6Presentation.clockLabel simulationControl}"
+        if pressed Keys.F6 then
+            try
+                WorldSave.saveToFile savePath world
+                printfn $"save=ok path={savePath} tick={world.Tick}"
+            with
+            | ex -> printfn $"save=error path={savePath} message={ex.Message}"
+        if pressed Keys.F7 then
+            match WorldSave.loadFromFile savePath with
+            | Ok nextWorld ->
+                world <- nextWorld
+                relationView <- false
+                relationSnapshot <- None
+                m5View <- M5Interaction.initial
+                this.CenterCamera()
+                printfn $"load=ok path={savePath} tick={world.Tick}"
+            | Error failure -> printfn $"load=error path={savePath} message={failure}"
         if escapePressed then
             if m5View.Panel <> WorldPanel then
                 let nextWorld, nextView = M5Interaction.apply ClosePanel world m5View
@@ -245,8 +284,10 @@ type LivingVillageGame() as this =
                          elif kb.IsKeyDown(Keys.W) then -1.0f
                          else 0.0f) }
             let ts = { Input = input }
-            for _ in 1 .. stepsPerFrame do
-                world <- Sim.step ts world
+            let stepCount = SimulationControl.stepsPerFrameWithLegacy legacyStepsPerFrame simulationControl
+            if stepCount > 0 then
+                for _ in 1 .. stepCount do
+                    world <- Sim.step ts world
             this.CenterCamera()
         fpsFrames <- fpsFrames + 1
         fpsSeconds <- fpsSeconds + gameTime.ElapsedGameTime.TotalSeconds
@@ -258,9 +299,14 @@ type LivingVillageGame() as this =
                 if world.Npcs.Length > 0 then
                     NpcView.actionName world.Npcs.[0].Mind.Action
                 else "none"
+            let profile = M6Presentation.profileAtTick world.Tick
+            let dayNight =
+                match profile.Mode with
+                | Day -> "DAY"
+                | Night -> "NIGHT"
             let viewTag = if relationView then " | [RELATIONS]" else ""
             this.Window.Title <-
-                $"Living Village M5{titleSuffix} | fps {fps:F1} | tick {world.Tick} | npc {npcAction}{viewTag} | panel {M5Interaction.panelName m5View} | {M5Interaction.titleText m5View}"
+                $"Living Village M6{titleSuffix} | fps {fps:F1} | tick {world.Tick} | {dayNight} | {M6Presentation.clockLabel simulationControl} | 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
 
@@ -272,7 +318,8 @@ type LivingVillageGame() as this =
             spriteBatch.Draw(pixel, a, System.Nullable(), color, angle, Vector2.Zero, Vector2(len, thickness), SpriteEffects.None, 0.0f)
 
     member private this.DrawRelationView() =
-        this.GraphicsDevice.Clear(Color(16, 20, 26))
+        let profile = M6Presentation.profileAtTick world.Tick
+        this.GraphicsDevice.Clear(profile.Background)
         let viewport = this.GraphicsDevice.Viewport
         let vw = float32 viewport.Width
         let vh = float32 viewport.Height
@@ -310,7 +357,8 @@ type LivingVillageGame() as this =
             this.DrawWorldView()
 
     member private this.DrawWorldView() =
-        this.GraphicsDevice.Clear(Color.CornflowerBlue)
+        let profile = M6Presentation.profileAtTick world.Tick
+        this.GraphicsDevice.Clear(profile.Background)
         let viewport = this.GraphicsDevice.Viewport
         let camX = int camera.X
         let camY = int camera.Y
@@ -324,7 +372,7 @@ type LivingVillageGame() as this =
                 let src = Rectangle(int map.[x, y] * Sim.tilePixels, 0, Sim.tilePixels, Sim.tilePixels)
                 let dst =
                     Rectangle(x * Sim.tilePixels - camX, y * Sim.tilePixels - camY, Sim.tilePixels, Sim.tilePixels)
-                spriteBatch.Draw(atlas, dst, src, Color.White)
+                spriteBatch.Draw(atlas, dst, src, profile.WorldTint)
         let avatarDst =
             Rectangle(int world.Avatar.Pos.X - camX, int world.Avatar.Pos.Y - camY, Sim.tilePixels, Sim.tilePixels)
         spriteBatch.Draw(pixel, avatarDst, Color.Red)
@@ -351,7 +399,16 @@ type LivingVillageGame() as this =
         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
+        let profile = M6Presentation.profileAtTick world.Tick
+        let dayNight =
+            match profile.Mode with
+            | Day -> "DAY"
+            | Night -> "NIGHT"
+        let m6Lines =
+            [ sprintf "TIME %s %s" dayNight (M6Presentation.clockLabel simulationControl)
+              "P PAUSE F1 F2 F3 SPEED"
+              "F6 SAVE F7 LOAD" ]
+        let lines = (m6Lines @ 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))
diff --git a/src/LivingVillage.Desktop/LivingVillage.Desktop.fsproj b/src/LivingVillage.Desktop/LivingVillage.Desktop.fsproj
index cd8ccab..caf8ba5 100644
--- a/src/LivingVillage.Desktop/LivingVillage.Desktop.fsproj
+++ b/src/LivingVillage.Desktop/LivingVillage.Desktop.fsproj
@@ -7,6 +7,7 @@
 
   <ItemGroup>
     <Compile Include="Interaction.fs" />
+    <Compile Include="M6Presentation.fs" />
     <Compile Include="Game.fs" />
     <Compile Include="Program.fs" />
   </ItemGroup>
diff --git a/src/LivingVillage.Desktop/M6Presentation.fs b/src/LivingVillage.Desktop/M6Presentation.fs
new file mode 100644
index 0000000..410f20a
--- /dev/null
+++ b/src/LivingVillage.Desktop/M6Presentation.fs
@@ -0,0 +1,35 @@
+namespace LivingVillage.Desktop
+
+open Microsoft.Xna.Framework
+open LivingVillage.Kernel
+open LivingVillage.Kernel.Sim
+
+type M6DayNight =
+    | Day
+    | Night
+
+type M6RenderProfile =
+    { Mode: M6DayNight
+      Background: Color
+      WorldTint: Color }
+
+module M6Presentation =
+
+    let profileAtTick (tick: int64) : M6RenderProfile =
+        if Sim.isNightTick tick then
+            { Mode = Night
+              Background = Color(18, 25, 55)
+              WorldTint = Color(118, 136, 184) }
+        else
+            { Mode = Day
+              Background = Color(100, 160, 210)
+              WorldTint = Color.White }
+
+    let clockLabel (control: SimulationControl) : string =
+        if control.Paused then
+            "PAUSED"
+        else
+            match control.Speed with
+            | OneX -> "1X"
+            | TwoX -> "2X"
+            | FiveX -> "5X"
diff --git a/src/LivingVillage.Kernel.Tests/LivingVillage.Kernel.Tests.fsproj b/src/LivingVillage.Kernel.Tests/LivingVillage.Kernel.Tests.fsproj
index 2a3ba3c..b30fc8f 100644
--- a/src/LivingVillage.Kernel.Tests/LivingVillage.Kernel.Tests.fsproj
+++ b/src/LivingVillage.Kernel.Tests/LivingVillage.Kernel.Tests.fsproj
@@ -11,6 +11,7 @@
     <Compile Include="RumorTests.fs" />
     <Compile Include="TradeTests.fs" />
     <Compile Include="M5Tests.fs" />
+    <Compile Include="M6aTests.fs" />
   </ItemGroup>
 
   <ItemGroup>
diff --git a/src/LivingVillage.Kernel.Tests/M6aTests.fs b/src/LivingVillage.Kernel.Tests/M6aTests.fs
new file mode 100644
index 0000000..8a318be
--- /dev/null
+++ b/src/LivingVillage.Kernel.Tests/M6aTests.fs
@@ -0,0 +1,99 @@
+namespace LivingVillage.Kernel.Tests
+
+open Microsoft.VisualStudio.TestTools.UnitTesting
+open LivingVillage.Kernel
+open LivingVillage.Kernel.Sim
+
+module private M6aHarness =
+
+    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 withDialogue (world: World) : World =
+        match Sim.chooseDialogue (NpcId 0) SmallTalk (atNpc 0 world) with
+        | DialogueSucceeded (_, next) -> next
+        | DialogueRejected (failure, _) -> Assert.Fail($"dialogue rejected: {failure}"); Unchecked.defaultof<World>
+
+    let withChat (world: World) : World =
+        match Sim.chat { Narrator = NpcId 0; Receiver = NpcId 1 } (readyForChat world) with
+        | ChatSucceeded (Some _, next) -> next
+        | ChatSucceeded (None, _) -> Assert.Fail("chat should create a rumor"); Unchecked.defaultof<World>
+        | ChatRejected (failure, _) -> Assert.Fail($"chat rejected: {failure}"); Unchecked.defaultof<World>
+
+    let withTrade (world: World) : World =
+        match Sim.trade { Buyer = NpcId 0; Seller = NpcId 1; Item = Food; Quantity = 1 } world with
+        | TradeSucceeded next -> next
+        | TradeRejected (failure, _) -> Assert.Fail($"trade rejected: {failure}"); Unchecked.defaultof<World>
+
+    let advance (inputs: Input list) (world: World) : World =
+        inputs |> List.fold (fun current input -> Sim.step { Input = input } current) world
+
+[<TestClass>]
+type M6aTests () =
+
+    [<TestMethod>]
+    member _.SaveLoadPreservesWorldAndDeterministicContinuation () =
+        let world =
+            Sim.initialWorldN 7UL 4
+            |> M6aHarness.withDialogue
+            |> M6aHarness.withChat
+            |> M6aHarness.withTrade
+        let encoded = WorldSave.save world
+
+        match WorldSave.load encoded with
+        | Error failure -> Assert.Fail($"save should load: {failure}")
+        | Ok restored ->
+            Assert.AreEqual<string>(encoded, WorldSave.save restored)
+            let inputs =
+                [ { MoveX = 0.5f; MoveY = -0.25f }
+                  { MoveX = 0.0f; MoveY = 0.0f }
+                  { MoveX = -1.0f; MoveY = 0.75f }
+                  { MoveX = 0.25f; MoveY = 0.0f } ]
+            let continued = M6aHarness.advance inputs world
+            let restoredContinued = M6aHarness.advance inputs restored
+            Assert.AreEqual<string>(WorldSave.save continued, WorldSave.save restoredContinued)
+            Assert.AreEqual<int64>(world.Tick, restored.Tick)
+            Assert.AreEqual<uint64>(world.Rng.State, restored.Rng.State)
+            Assert.IsFalse(restored.Events.IsEmpty)
+            Assert.IsFalse(restored.Rumors.IsEmpty)
+            Assert.IsFalse(restored.Annals.IsEmpty)
+            Assert.AreEqual<Avatar>(world.Avatar, restored.Avatar)
+            CollectionAssert.AreEqual(world.Npcs, restored.Npcs)
+
+    [<TestMethod>]
+    member _.SimulationClockSupportsPauseAndRequestedSpeeds () =
+        let initial = SimulationControl.initial
+        Assert.AreEqual<int>(1, SimulationControl.stepsPerFrame initial)
+        Assert.AreEqual<int>(2, SimulationControl.stepsPerFrame (SimulationControl.setSpeed TwoX initial))
+        Assert.AreEqual<int>(5, SimulationControl.stepsPerFrame (SimulationControl.setSpeed FiveX initial))
+        let paused = SimulationControl.togglePause initial
+        Assert.IsTrue(paused.Paused)
+        Assert.AreEqual<int>(0, SimulationControl.stepsPerFrame paused)
+        let resumed = SimulationControl.togglePause paused
+        Assert.IsFalse(resumed.Paused)
+        Assert.AreEqual<SimulationSpeed>(OneX, resumed.Speed)
+
+    [<TestMethod>]
+    member _.ConfiguredLegacyStepCountsRemainExactUntilManualSpeedSelection () =
+        let control, legacySteps = SimulationControl.initialForConfiguredSteps 7
+        Assert.AreEqual<int option>(Some 7, legacySteps)
+        Assert.AreEqual<int>(7, SimulationControl.stepsPerFrameWithLegacy legacySteps control)
+        Assert.AreEqual<int>(0, SimulationControl.stepsPerFrameWithLegacy legacySteps (SimulationControl.togglePause control))
+        let manuallySelected = SimulationControl.setSpeed TwoX control
+        Assert.AreEqual<int>(2, SimulationControl.stepsPerFrameWithLegacy None manuallySelected)
diff --git a/src/LivingVillage.Kernel/LivingVillage.Kernel.fsproj b/src/LivingVillage.Kernel/LivingVillage.Kernel.fsproj
index 8a4fad1..2a3126c 100644
--- a/src/LivingVillage.Kernel/LivingVillage.Kernel.fsproj
+++ b/src/LivingVillage.Kernel/LivingVillage.Kernel.fsproj
@@ -7,6 +7,8 @@
   <ItemGroup>
     <Compile Include="Rng.fs" />
     <Compile Include="Sim.fs" />
+    <Compile Include="SimulationControl.fs" />
+    <Compile Include="WorldSave.fs" />
   </ItemGroup>
 
 </Project>
diff --git a/src/LivingVillage.Kernel/SimulationControl.fs b/src/LivingVillage.Kernel/SimulationControl.fs
new file mode 100644
index 0000000..83e5f36
--- /dev/null
+++ b/src/LivingVillage.Kernel/SimulationControl.fs
@@ -0,0 +1,54 @@
+namespace LivingVillage.Kernel
+
+type SimulationSpeed =
+    | OneX
+    | TwoX
+    | FiveX
+
+type SimulationControl =
+    { Paused: bool
+      Speed: SimulationSpeed }
+
+module SimulationControl =
+
+    let initial : SimulationControl =
+        { Paused = false
+          Speed = OneX }
+
+    let setSpeed (speed: SimulationSpeed) (control: SimulationControl) : SimulationControl =
+        { control with Speed = speed }
+
+    let togglePause (control: SimulationControl) : SimulationControl =
+        { control with Paused = not control.Paused }
+
+    let initialForConfiguredSteps (configuredSteps: int) : SimulationControl * int option =
+        let steps = if configuredSteps > 0 then configuredSteps else 1
+        let control =
+            match steps with
+            | 2 -> setSpeed TwoX initial
+            | 5 -> setSpeed FiveX initial
+            | _ -> initial
+        let legacySteps =
+            match steps with
+            | 1
+            | 2
+            | 5 -> None
+            | value -> Some value
+        control, legacySteps
+
+    let stepsPerFrame (control: SimulationControl) : int =
+        if control.Paused then
+            0
+        else
+            match control.Speed with
+            | OneX -> 1
+            | TwoX -> 2
+            | FiveX -> 5
+
+    let stepsPerFrameWithLegacy (legacySteps: int option) (control: SimulationControl) : int =
+        if control.Paused then
+            0
+        else
+            match legacySteps with
+            | Some steps when steps > 0 -> steps
+            | _ -> stepsPerFrame control
diff --git a/src/LivingVillage.Kernel/WorldSave.fs b/src/LivingVillage.Kernel/WorldSave.fs
new file mode 100644
index 0000000..726170b
--- /dev/null
+++ b/src/LivingVillage.Kernel/WorldSave.fs
@@ -0,0 +1,533 @@
+namespace LivingVillage.Kernel
+
+open System
+open System.Globalization
+open System.IO
+open System.Text
+open LivingVillage.Kernel.Sim
+
+module WorldSave =
+
+    let private invariant = CultureInfo.InvariantCulture
+    let private formatVersion = "LV_WORLD_SAVE_V1"
+
+    exception private SaveParseError of string
+
+    type private TokenReader(tokens: string[]) =
+        let mutable index = 0
+
+        member _.Take(label: string) =
+            if index >= tokens.Length then
+                raise (SaveParseError(sprintf "missing %s" label))
+            let value = tokens.[index]
+            index <- index + 1
+            value
+
+        member _.Remaining = tokens.Length - index
+
+    let private invalid message = raise (SaveParseError message)
+
+    let private add (tokens: ResizeArray<string>) (value: string) = tokens.Add(value)
+
+    let private addInt (tokens: ResizeArray<string>) (value: int) =
+        add tokens (value.ToString(invariant))
+
+    let private addInt64 (tokens: ResizeArray<string>) (value: int64) =
+        add tokens (value.ToString(invariant))
+
+    let private addUInt64 (tokens: ResizeArray<string>) (value: uint64) =
+        add tokens (value.ToString(invariant))
+
+    let private addFloat (tokens: ResizeArray<string>) (value: float) =
+        add tokens (value.ToString("R", invariant))
+
+    let private addFloat32 (tokens: ResizeArray<string>) (value: float32) =
+        add tokens (value.ToString("R", invariant))
+
+    let private addBool (tokens: ResizeArray<string>) (value: bool) =
+        add tokens (if value then "1" else "0")
+
+    let private addText (tokens: ResizeArray<string>) (value: string) =
+        let safeValue = if isNull value then "" else value
+        add tokens (Convert.ToBase64String(Encoding.UTF8.GetBytes(safeValue)))
+
+    let private readInt (reader: TokenReader) label =
+        let token = reader.Take(label)
+        match Int32.TryParse(token, NumberStyles.Integer, invariant) with
+        | true, value -> value
+        | _ -> invalid (sprintf "invalid %s" label)
+
+    let private readInt64 (reader: TokenReader) label =
+        let token = reader.Take(label)
+        match Int64.TryParse(token, NumberStyles.Integer, invariant) with
+        | true, value -> value
+        | _ -> invalid (sprintf "invalid %s" label)
+
+    let private readUInt64 (reader: TokenReader) label =
+        let token = reader.Take(label)
+        match UInt64.TryParse(token, NumberStyles.Integer, invariant) with
+        | true, value -> value
+        | _ -> invalid (sprintf "invalid %s" label)
+
+    let private readFloat (reader: TokenReader) label =
+        let token = reader.Take(label)
+        match Double.TryParse(token, NumberStyles.Float, invariant) with
+        | true, value -> value
+        | _ -> invalid (sprintf "invalid %s" label)
+
+    let private readFloat32 (reader: TokenReader) label =
+        let token = reader.Take(label)
+        match Single.TryParse(token, NumberStyles.Float, invariant) with
+        | true, value -> value
+        | _ -> invalid (sprintf "invalid %s" label)
+
+    let private readBool (reader: TokenReader) label =
+        match reader.Take(label) with
+        | "0" -> false
+        | "1" -> true
+        | _ -> invalid (sprintf "invalid %s" label)
+
+    let private readText (reader: TokenReader) label =
+        let token = reader.Take(label)
+        try
+            Encoding.UTF8.GetString(Convert.FromBase64String(token))
+        with
+        | :? FormatException -> invalid (sprintf "invalid %s" label)
+
+    let private readCount (reader: TokenReader) label =
+        let count = readInt reader label
+        if count < 0 || count > 1000000 then
+            invalid (sprintf "invalid %s count" label)
+        count
+
+    let private writeNpcId tokens (NpcId id) = addInt tokens id
+
+    let private readNpcId (reader: TokenReader) label =
+        NpcId(readInt reader label)
+
+    let private writeRumorId tokens (RumorId id) = addInt64 tokens id
+
+    let private readRumorId (reader: TokenReader) label =
+        RumorId(readInt64 reader label)
+
+    let private writeItemKind tokens item =
+        match item with
+        | Food -> add tokens "food"
+
+    let private readItemKind (reader: TokenReader) label =
+        match reader.Take(label) with
+        | "food" -> Food
+        | _ -> invalid (sprintf "invalid %s" label)
+
+    let private writeActionKind tokens action =
+        match action with
+        | Eat -> add tokens "eat"
+        | Sleep -> add tokens "sleep"
+        | Wander -> add tokens "wander"
+        | Work -> add tokens "work"
+        | Chat -> add tokens "chat"
+
+    let private readActionKind (reader: TokenReader) label =
+        match reader.Take(label) with
+        | "eat" -> Eat
+        | "sleep" -> Sleep
+        | "wander" -> Wander
+        | "work" -> Work
+        | "chat" -> Chat
+        | _ -> invalid (sprintf "invalid %s" label)
+
+    let private writeIntent tokens intent =
+        match intent with
+        | SmallTalk -> add tokens "small-talk"
+        | AskHelp -> add tokens "ask-help"
+        | OfferTrade -> add tokens "offer-trade"
+        | Joke -> add tokens "joke"
+        | Apologize -> add tokens "apologize"
+        | Provoke -> add tokens "provoke"
+
+    let private readIntent (reader: TokenReader) label =
+        match reader.Take(label) with
+        | "small-talk" -> SmallTalk
+        | "ask-help" -> AskHelp
+        | "offer-trade" -> OfferTrade
+        | "joke" -> Joke
+        | "apologize" -> Apologize
+        | "provoke" -> Provoke
+        | _ -> invalid (sprintf "invalid %s" label)
+
+    let private writeResponse tokens response =
+        match response with
+        | Friendly -> add tokens "friendly"
+        | Helpful -> add tokens "helpful"
+        | Bargaining -> add tokens "bargaining"
+        | Amused -> add tokens "amused"
+        | Forgiving -> add tokens "forgiving"
+        | Hostile -> add tokens "hostile"
+        | Reserved -> add tokens "reserved"
+        | Refused -> add tokens "refused"
+        | Offended -> add tokens "offended"
+
+    let private readResponse (reader: TokenReader) label =
+        match reader.Take(label) with
+        | "friendly" -> Friendly
+        | "helpful" -> Helpful
+        | "bargaining" -> Bargaining
+        | "amused" -> Amused
+        | "forgiving" -> Forgiving
+        | "hostile" -> Hostile
+        | "reserved" -> Reserved
+        | "refused" -> Refused
+        | "offended" -> Offended
+        | _ -> invalid (sprintf "invalid %s" label)
+
+    let private writeVec2 tokens (value: Vec2) =
+        addFloat32 tokens value.X
+        addFloat32 tokens value.Y
+
+    let private readVec2 reader label =
+        { X = readFloat32 reader (label + ".x")
+          Y = readFloat32 reader (label + ".y") }
+
+    let private writeNeeds tokens (value: Needs) =
+        addFloat32 tokens value.Hunger
+        addFloat32 tokens value.Energy
+        addFloat32 tokens value.Social
+        addFloat32 tokens value.Money
+
+    let private readNeeds reader label =
+        { Hunger = readFloat32 reader (label + ".hunger")
+          Energy = readFloat32 reader (label + ".energy")
+          Social = readFloat32 reader (label + ".social")
+          Money = readFloat32 reader (label + ".money") }
+
+    let private writePersonality tokens (value: Personality) =
+        addFloat32 tokens value.Drive
+        addFloat32 tokens value.Aggression
+        addFloat32 tokens value.Extraversion
+        addFloat32 tokens value.Honesty
+        addFloat32 tokens value.Greed
+
+    let private readPersonality reader label =
+        { Drive = readFloat32 reader (label + ".drive")
+          Aggression = readFloat32 reader (label + ".aggression")
+          Extraversion = readFloat32 reader (label + ".extraversion")
+          Honesty = readFloat32 reader (label + ".honesty")
+          Greed = readFloat32 reader (label + ".greed") }
+
+    let private writeDialogueOutcome tokens (value: DialogueOutcome) =
+        addInt64 tokens value.Tick
+        writeNpcId tokens value.Actor
+        writeNpcId tokens value.Target
+        writeIntent tokens value.Intent
+        writeResponse tokens value.Response
+        addFloat32 tokens value.Valence
+
+    let private readDialogueOutcome reader label =
+        { Tick = readInt64 reader (label + ".tick")
+          Actor = readNpcId reader (label + ".actor")
+          Target = readNpcId reader (label + ".target")
+          Intent = readIntent reader (label + ".intent")
+          Response = readResponse reader (label + ".response")
+          Valence = readFloat32 reader (label + ".valence") }
+
+    let private writeRumor tokens (value: RumorEvent) =
+        writeRumorId tokens value.Id
+        addInt64 tokens value.Tick
+        addInt64 tokens value.OriginTick
+        writeNpcId tokens value.Source
+        writeNpcId tokens value.Narrator
+        writeNpcId tokens value.Receiver
+        match value.Parent with
+        | None -> add tokens "none"
+        | Some parent ->
+            add tokens "some"
+            writeRumorId tokens parent
+        addInt tokens value.Depth
+        addFloat32 tokens value.Strength
+
+    let private readRumor (reader: TokenReader) label =
+        let id = readRumorId reader (label + ".id")
+        let tick = readInt64 reader (label + ".tick")
+        let originTick = readInt64 reader (label + ".origin-tick")
+        let source = readNpcId reader (label + ".source")
+        let narrator = readNpcId reader (label + ".narrator")
+        let receiver = readNpcId reader (label + ".receiver")
+        let parent =
+            match reader.Take(label + ".parent") with
+            | "none" -> None
+            | "some" -> Some(readRumorId reader (label + ".parent-id"))
+            | _ -> invalid (sprintf "invalid %s parent" label)
+        { Id = id
+          Tick = tick
+          OriginTick = originTick
+          Source = source
+          Narrator = narrator
+          Receiver = receiver
+          Parent = parent
+          Depth = readInt reader (label + ".depth")
+          Strength = readFloat32 reader (label + ".strength") }
+
+    let private writeMemoryKind tokens kind =
+        match kind with
+        | Meal -> add tokens "meal"
+        | Rest -> add tokens "rest"
+        | Pay -> add tokens "pay"
+        | Hungry -> add tokens "hungry"
+        | Chatted partner ->
+            add tokens "chatted"
+            writeNpcId tokens partner
+        | Rumor rumor ->
+            add tokens "rumor"
+            writeRumorId tokens rumor
+        | Bought (partner, item, quantity, price) ->
+            add tokens "bought"
+            writeNpcId tokens partner
+            writeItemKind tokens item
+            addInt tokens quantity
+            addFloat32 tokens price
+        | Sold (partner, item, quantity, price) ->
+            add tokens "sold"
+            writeNpcId tokens partner
+            writeItemKind tokens item
+            addInt tokens quantity
+            addFloat32 tokens price
+        | Dialogue (target, intent, response) ->
+            add tokens "dialogue"
+            writeNpcId tokens target
+            writeIntent tokens intent
+            writeResponse tokens response
+
+    let private readMemoryKind (reader: TokenReader) label =
+        match reader.Take(label) with
+        | "meal" -> Meal
+        | "rest" -> Rest
+        | "pay" -> Pay
+        | "hungry" -> Hungry
+        | "chatted" -> Chatted(readNpcId reader (label + ".partner"))
+        | "rumor" -> Rumor(readRumorId reader (label + ".id"))
+        | "bought" ->
+            Bought(
+                readNpcId reader (label + ".partner"),
+                readItemKind reader (label + ".item"),
+                readInt reader (label + ".quantity"),
+                readFloat32 reader (label + ".price"))
+        | "sold" ->
+            Sold(
+                readNpcId reader (label + ".partner"),
+                readItemKind reader (label + ".item"),
+                readInt reader (label + ".quantity"),
+                readFloat32 reader (label + ".price"))
+        | "dialogue" ->
+            Dialogue(
+                readNpcId reader (label + ".target"),
+                readIntent reader (label + ".intent"),
+                readResponse reader (label + ".response"))
+        | _ -> invalid (sprintf "invalid %s" label)
+
+    let private writeMemoryEvent tokens (value: MemoryEvent) =
+        addInt64 tokens value.Tick
+        writeMemoryKind tokens value.Kind
+        addFloat32 tokens value.Valence
+
+    let private readMemoryEvent reader label =
+        { Tick = readInt64 reader (label + ".tick")
+          Kind = readMemoryKind reader (label + ".kind")
+          Valence = readFloat32 reader (label + ".valence") }
+
+    let private writeInteractionKind tokens kind =
+        match kind with
+        | ChatInit (narrator, receiver) ->
+            add tokens "chat-init"
+            writeNpcId tokens narrator
+            writeNpcId tokens receiver
+        | TradeEvent (buyer, seller, item, quantity, price) ->
+            add tokens "trade-event"
+            writeNpcId tokens buyer
+            writeNpcId tokens seller
+            writeItemKind tokens item
+            addInt tokens quantity
+            addFloat32 tokens price
+        | DialogueEvent outcome ->
+            add tokens "dialogue-event"
+            writeDialogueOutcome tokens outcome
+
+    let private readInteractionKind (reader: TokenReader) label =
+        match reader.Take(label) with
+        | "chat-init" -> ChatInit(readNpcId reader (label + ".narrator"), readNpcId reader (label + ".receiver"))
+        | "trade-event" ->
+            TradeEvent(
+                readNpcId reader (label + ".buyer"),
+                readNpcId reader (label + ".seller"),
+                readItemKind reader (label + ".item"),
+                readInt reader (label + ".quantity"),
+                readFloat32 reader (label + ".price"))
+        | "dialogue-event" -> DialogueEvent(readDialogueOutcome reader (label + ".outcome"))
+        | _ -> invalid (sprintf "invalid %s" label)
+
+    let private writeInteraction tokens (value: InteractionEvent) =
+        addInt64 tokens value.Tick
+        writeInteractionKind tokens value.Kind
+
+    let private readInteraction reader label =
+        { Tick = readInt64 reader (label + ".tick")
+          Kind = readInteractionKind reader (label + ".kind") }
+
+    let private writeAnnalKind tokens kind =
+        match kind with
+        | DialogueAnnal outcome ->
+            add tokens "dialogue"
+            writeDialogueOutcome tokens outcome
+        | RumorAnnal rumor ->
+            add tokens "rumor"
+            writeRumor tokens rumor
+        | TradeAnnal event ->
+            add tokens "trade"
+            writeInteraction tokens event
+
+    let private readAnnalKind (reader: TokenReader) label =
+        match reader.Take(label) with
+        | "dialogue" -> DialogueAnnal(readDialogueOutcome reader (label + ".outcome"))
+        | "rumor" -> RumorAnnal(readRumor reader (label + ".rumor"))
+        | "trade" -> TradeAnnal(readInteraction reader (label + ".event"))
+        | _ -> invalid (sprintf "invalid %s" label)
+
+    let private writeAnnal tokens (value: AnnalEntry) =
+        addInt64 tokens value.Tick
+        writeAnnalKind tokens value.Kind
+        addText tokens value.Summary
+
+    let private readAnnal reader label =
+        { Tick = readInt64 reader (label + ".tick")
+          Kind = readAnnalKind reader (label + ".kind")
+          Summary = readText reader (label + ".summary") }
+
+    let private writeMind tokens (value: Mind) =
+        writeNeeds tokens value.Needs
+        writePersonality tokens value.Personality
+        writeActionKind tokens value.Action
+        writeVec2 tokens value.Target
+        addInt64 tokens value.ActionAge
+        addBool tokens value.EffectDone
+        addBool tokens value.HungerFlagged
+        addInt tokens value.Memory.Length
+        value.Memory |> List.iter (writeMemoryEvent tokens)
+
+    let private readMind reader label =
+        let needs = readNeeds reader (label + ".needs")
+        let personality = readPersonality reader (label + ".personality")
+        let action = readActionKind reader (label + ".action")
+        let target = readVec2 reader (label + ".target")
+        let actionAge = readInt64 reader (label + ".action-age")
+        let effectDone = readBool reader (label + ".effect-done")
+        let hungerFlagged = readBool reader (label + ".hunger-flagged")
+        let memoryCount = readCount reader (label + ".memory")
+        { Needs = needs
+          Personality = personality
+          Action = action
+          Target = target
+          ActionAge = actionAge
+          EffectDone = effectDone
+          HungerFlagged = hungerFlagged
+          Memory = List.init memoryCount (fun index -> readMemoryEvent reader (sprintf "%s.memory[%d]" label index)) }
+
+    let private writeAvatar tokens (value: Avatar) =
+        writeVec2 tokens value.Pos
+        writeMind tokens value.Mind
+
+    let private readAvatar reader =
+        { Pos = readVec2 reader "avatar.pos"
+          Mind = readMind reader "avatar.mind" }
+
+    let private writeInventory tokens (inventory: Map<ItemKind, int>) =
+        let entries = inventory |> Map.toList |> List.sortBy (fun (item, _) -> sprintf "%A" item)
+        addInt tokens entries.Length
+        for item, quantity in entries do
+            writeItemKind tokens item
+            addInt tokens quantity
+
+    let private readInventory reader label =
+        let count = readCount reader (label + ".count")
+        [ for index in 0 .. count - 1 do
+              let item = readItemKind reader (sprintf "%s[%d].item" label index)
+              let quantity = readInt reader (sprintf "%s[%d].quantity" label index)
+              yield item, quantity ]
+        |> Map.ofList
+
+    let private writeNpc tokens (value: Npc) =
+        writeNpcId tokens value.Id
+        writeVec2 tokens value.Pos
+        writeInventory tokens value.Inventory
+        writeMind tokens value.Mind
+
+    let private readNpc reader index =
+        { Id = readNpcId reader (sprintf "npc[%d].id" index)
+          Pos = readVec2 reader (sprintf "npc[%d].pos" index)
+          Inventory = readInventory reader (sprintf "npc[%d].inventory" index)
+          Mind = readMind reader (sprintf "npc[%d].mind" index) }
+
+    let save (world: World) : string =
+        let tokens = ResizeArray<string>()
+        add tokens formatVersion
+        addInt64 tokens world.Tick
+        addFloat tokens world.Time
+        addUInt64 tokens world.Rng.State
+        addUInt64 tokens world.NoHost.Reserved
+        writeAvatar tokens world.Avatar
+        addInt tokens world.Npcs.Length
+        world.Npcs |> Array.iter (writeNpc tokens)
+        addInt tokens world.Events.Length
+        world.Events |> List.iter (writeInteraction tokens)
+        addInt tokens world.Rumors.Length
+        world.Rumors |> List.iter (writeRumor tokens)
+        addInt tokens world.Annals.Length
+        world.Annals |> List.iter (writeAnnal tokens)
+        String.Join("|", tokens)
+
+    let load (text: string) : Result<World, string> =
+        if isNull text then
+            Error "save text is null"
+        else
+            try
+                let tokens = text.Split([| '|' |], StringSplitOptions.None)
+                let reader = TokenReader(tokens)
+                if reader.Take("format") <> formatVersion then
+                    invalid "unsupported save format"
+                let tick = readInt64 reader "tick"
+                let time = readFloat reader "time"
+                let rng = { State = readUInt64 reader "rng" }
+                let noHost = { Reserved = readUInt64 reader "no-host" }
+                let avatar = readAvatar reader
+                let npcCount = readCount reader "npcs"
+                let npcs = Array.init npcCount (fun index -> readNpc reader index)
+                let eventCount = readCount reader "events"
+                let events = List.init eventCount (fun index -> readInteraction reader (sprintf "event[%d]" index))
+                let rumorCount = readCount reader "rumors"
+                let rumors = List.init rumorCount (fun index -> readRumor reader (sprintf "rumor[%d]" index))
+                let annalCount = readCount reader "annals"
+                let annals = List.init annalCount (fun index -> readAnnal reader (sprintf "annal[%d]" index))
+                if reader.Remaining <> 0 then
+                    invalid "trailing save data"
+                Ok
+                    { Tick = tick
+                      Time = time
+                      Rng = rng
+                      Avatar = avatar
+                      NoHost = noHost
+                      Npcs = npcs
+                      Events = events
+                      Rumors = rumors
+                      Annals = annals }
+            with
+            | SaveParseError message -> Error message
+            | :? FormatException as ex -> Error(sprintf "invalid save: %s" ex.Message)
+            | :? OverflowException as ex -> Error(sprintf "invalid save: %s" ex.Message)
+            | :? ArgumentException as ex -> Error(sprintf "invalid save: %s" ex.Message)
+
+    let saveToFile (path: string) (world: World) : unit =
+        File.WriteAllText(path, save world, UTF8Encoding(false))
+
+    let loadFromFile (path: string) : Result<World, string> =
+        try
+            File.ReadAllText(path) |> load
+        with
+        | :? IOException as ex -> Error(sprintf "could not read save: %s" ex.Message)