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

3 files changed, 103 insertions, 10 deletions

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"