diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/LivingVillage.Desktop.Tests/LivingVillage.Desktop.Tests.fsproj | 1 | ||||
| -rw-r--r-- | src/LivingVillage.Desktop.Tests/M6bTests.fs | 82 | ||||
| -rw-r--r-- | src/LivingVillage.Desktop/Game.fs | 367 | ||||
| -rw-r--r-- | src/LivingVillage.Desktop/LivingVillage.Desktop.fsproj | 1 | ||||
| -rw-r--r-- | src/LivingVillage.Desktop/MenuState.fs | 192 |
5 files changed, 565 insertions, 78 deletions
diff --git a/src/LivingVillage.Desktop.Tests/LivingVillage.Desktop.Tests.fsproj b/src/LivingVillage.Desktop.Tests/LivingVillage.Desktop.Tests.fsproj index b8e2055..405e8b5 100644 --- a/src/LivingVillage.Desktop.Tests/LivingVillage.Desktop.Tests.fsproj +++ b/src/LivingVillage.Desktop.Tests/LivingVillage.Desktop.Tests.fsproj @@ -8,6 +8,7 @@ <ItemGroup> <Compile Include="DesktopTests.fs" /> <Compile Include="M6aTests.fs" /> + <Compile Include="M6bTests.fs" /> </ItemGroup> <ItemGroup> diff --git a/src/LivingVillage.Desktop.Tests/M6bTests.fs b/src/LivingVillage.Desktop.Tests/M6bTests.fs new file mode 100644 index 0000000..6ae0634 --- /dev/null +++ b/src/LivingVillage.Desktop.Tests/M6bTests.fs @@ -0,0 +1,82 @@ +namespace LivingVillage.Desktop.Tests + +open Microsoft.VisualStudio.TestTools.UnitTesting +open LivingVillage.Kernel +open LivingVillage.Desktop + +[<TestClass>] +type M6bMenuTests () = + + [<TestMethod>] + member _.MainMenuHasRequiredOrderAndStartsAtNewGame () = + let state = MenuState.create SimulationControl.initial false + + Assert.AreEqual<MenuPage>(MainMenu, state.Page) + Assert.AreEqual<MenuItem list>( + [ NewGameItem; LoadItem; SettingsItem; ControlsItem; ExitItem ], + MenuState.items state) + Assert.AreEqual<int>(0, state.Selected) + + [<TestMethod>] + member _.SelectionWrapsAndConfirmProducesNewGameCommand () = + let state = MenuState.create SimulationControl.initial false + let wrapped = MenuState.move Up state + let confirmed = MenuState.update Confirm wrapped |> snd + + Assert.AreEqual<MenuItem>(ExitItem, MenuState.selectedItem wrapped) + Assert.AreEqual<MenuCommand>(ExitGame, confirmed) + let newGameState, newGameCommand = MenuState.update Confirm state + Assert.AreEqual<MenuPage>(MainMenu, newGameState.Page) + Assert.AreEqual<MenuCommand>(StartNewGame, newGameCommand) + + [<TestMethod>] + member _.SettingsCanSelectEveryExistingSimulationMode () = + let initial = MenuState.create SimulationControl.initial false + let settings, _ = MenuState.update Confirm (MenuState.move Down (MenuState.move Down initial)) + let oneX, oneXCommand = MenuState.update Confirm settings + let twoX, twoXCommand = MenuState.update Confirm (MenuState.move Down settings) + let fiveX, fiveXCommand = MenuState.update Confirm (MenuState.move Down (MenuState.move Down settings)) + let paused, pausedCommand = MenuState.update Confirm (MenuState.move Down (MenuState.move Down (MenuState.move Down settings))) + + Assert.AreEqual<MenuPage>(Settings, settings.Page) + Assert.AreEqual<MenuCommand>(ApplySettings { Paused = false; Speed = OneX }, oneXCommand) + Assert.AreEqual<MenuCommand>(ApplySettings { Paused = false; Speed = TwoX }, twoXCommand) + Assert.AreEqual<MenuCommand>(ApplySettings { Paused = false; Speed = FiveX }, fiveXCommand) + Assert.AreEqual<MenuCommand>(ApplySettings { Paused = true; Speed = OneX }, pausedCommand) + Assert.AreEqual<MenuPage>(Settings, oneX.Page) + + [<TestMethod>] + member _.EscapeReturnsToPreviousPageAndKeepsCurrentWorld () = + let playing = MenuState.create SimulationControl.initial true |> MenuState.enterGame + let settings = MenuState.openSettings playing + let returned, command = MenuState.update Back settings + let main = MenuState.openMain playing + let continued, continueCommand = MenuState.update Confirm main + + Assert.AreEqual<MenuPage>(Playing, returned.Page) + Assert.AreEqual<MenuCommand>(NoCommand, command) + Assert.IsTrue(returned.HasCurrentWorld) + Assert.AreEqual<MenuPage>(MainMenu, main.Page) + Assert.AreEqual<MenuItem>(ContinueItem, MenuState.selectedItem main) + Assert.AreEqual<MenuPage>(Playing, continued.Page) + Assert.AreEqual<MenuCommand>(ContinueGame, continueCommand) + + [<TestMethod>] + member _.ControlsPageExposesCompleteKeyboardBindings () = + let state = MenuState.openControls (MenuState.create SimulationControl.initial false) + let keys = MenuState.controlRows |> List.map (fun row -> row.Keys) + + Assert.AreEqual<MenuPage>(Controls, state.Page) + Assert.AreEqual<string list>( + [ "WASD"; "E"; "1-6"; "Q"; "TAB"; "C"; "L"; "P"; "F1/F2/F3"; "F6"; "F7"; "ESC"; "UP/DOWN"; "ENTER" ], + keys) + + [<TestMethod>] + member _.LoadFailureIsAnExplicitPageAndBackReturnsToMenu () = + let failed = MenuState.showLoadError "missing save" (MenuState.create SimulationControl.initial false) + let returned, command = MenuState.update Back failed + + Assert.AreEqual<MenuPage>(LoadError, failed.Page) + Assert.AreEqual<string option>(Some "missing save", failed.Error) + Assert.AreEqual<MenuPage>(MainMenu, returned.Page) + Assert.AreEqual<MenuCommand>(NoCommand, command) diff --git a/src/LivingVillage.Desktop/Game.fs b/src/LivingVillage.Desktop/Game.fs index 232930d..5465ba2 100644 --- a/src/LivingVillage.Desktop/Game.fs +++ b/src/LivingVillage.Desktop/Game.fs @@ -116,6 +116,7 @@ module PixelText = ':', [| "00000"; "00110"; "00110"; "00000"; "00110"; "00110"; "00000" |] ';', [| "00000"; "00110"; "00110"; "00000"; "00110"; "00100"; "01000" |] '/', [| "00001"; "00010"; "00010"; "00100"; "01000"; "01000"; "10000" |] + '>', [| "10000"; "01000"; "00100"; "00010"; "00100"; "01000"; "10000" |] '?', [| "01110"; "10001"; "00001"; "00010"; "00100"; "00000"; "00100" |] ] |> Map.ofList @@ -137,8 +138,13 @@ type LivingVillageGame() as this = inherit Game() let autoplay = Environment.GetEnvironmentVariable("LV_AUTOPLAY") = "1" - let titleSuffix = if autoplay then " [AUTOPLAY]" else "" - let modeName = if autoplay then "autoplay" else "keyboard" + let autoplayFlow = Environment.GetEnvironmentVariable("LV_AUTOPLAY_FLOW") = "1" + let automated = autoplay || autoplayFlow + let titleSuffix = if automated then " [AUTOPLAY]" else "" + let modeName = + if autoplayFlow then "autoplay-flow" + elif autoplay then "autoplay" + else "keyboard" let configuredStepsPerFrame = match Environment.GetEnvironmentVariable("LV_STEPS_PER_FRAME") with | null | "" -> 1 @@ -167,6 +173,9 @@ type LivingVillageGame() as this = let mutable m5View = M5Interaction.initial let mutable simulationControl = initialSimulationControl let mutable legacyStepsPerFrame = initialLegacyStepsPerFrame + let mutable menu = MenuState.create initialSimulationControl false + let mutable autoplayFrames = 0 + let mutable flowStep = 0 do graphics.PreferredBackBufferWidth <- 1280 @@ -174,7 +183,7 @@ 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 M6 [AUTOPLAY]" else "Living Village M6" + this.Window.Title <- $"Living Village M6{titleSuffix}" printfn $"mode={modeName} seed=42" 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() = @@ -188,107 +197,246 @@ type LivingVillageGame() as this = let y = MathHelper.Clamp(world.Avatar.Pos.Y + half - vh / 2.0f, 0.0f, max 0.0f (worldH - vh)) camera <- Vector2(x, y) - override this.Initialize() = - base.Initialize() - prevKb <- Keyboard.GetState() + member private this.ResetWorldView() = + relationView <- false + relationSnapshot <- None + m5View <- M5Interaction.initial + this.CenterCamera() - override _.LoadContent() = - spriteBatch <- new SpriteBatch(this.GraphicsDevice) - atlas <- Atlas.build this.GraphicsDevice - pixel <- new Texture2D(this.GraphicsDevice, 1, 1) - pixel.SetData([| Color.White |]) + member private this.StartNewGame() = + world <- Sim.initialWorldN 42UL Sim.npcCount + this.ResetWorldView() + menu <- menu |> MenuState.setCurrentWorld true |> MenuState.enterGame + printfn $"new-game=ok seed=42 npcs={Sim.npcCount}" - override this.Update(gameTime: GameTime) = - let kb = Keyboard.GetState() - let pressed (key: Keys) = kb.IsKeyDown(key) && not (prevKb.IsKeyDown(key)) + member private this.SaveWorld (prefix: string) : bool = + try + WorldSave.saveToFile savePath world + printfn $"{prefix}=ok path={savePath} tick={world.Tick}" + true + with + | ex -> + printfn $"{prefix}=error path={savePath} message={ex.Message}" + false + + member private this.LoadWorld (prefix: string) : Result<int64, string> = + match WorldSave.loadFromFile savePath with + | Ok nextWorld -> + world <- nextWorld + this.ResetWorldView() + printfn $"{prefix}=ok path={savePath} tick={world.Tick}" + Ok world.Tick + | Error failure -> + printfn $"{prefix}=error path={savePath} message={failure}" + Error failure + + member private this.OpenMainMenu() = + relationView <- false + relationSnapshot <- None + m5View <- M5Interaction.initial + menu <- menu |> MenuState.setCurrentWorld true |> MenuState.openMain + printfn $"menu=open tick={world.Tick}" + + member private this.ApplyMenuCommand (command: MenuCommand) = + match command with + | NoCommand -> () + | ContinueGame -> + menu <- menu |> MenuState.setCurrentWorld true |> MenuState.enterGame + printfn $"continue=ok tick={world.Tick}" + | StartNewGame -> this.StartNewGame() + | LoadGame -> + match this.LoadWorld "load" with + | Ok _ -> + menu <- menu |> MenuState.setCurrentWorld true |> MenuState.enterGame + | Error failure -> + menu <- menu |> MenuState.showLoadError failure + | ApplySettings nextControl -> + simulationControl <- nextControl + legacyStepsPerFrame <- None + menu <- menu |> MenuState.setSettings nextControl + printfn $"simulation={M6Presentation.clockLabel simulationControl}" + | ExitGame -> + printfn "menu=exit" + this.Exit() + + member private this.DispatchMenuInput (input: MenuInput) = + let nextMenu, command = MenuState.update input menu + menu <- nextMenu + this.ApplyMenuCommand command + + member private this.UpdateMenu (pressed: Keys -> bool) = let pressedAny (keys: Keys list) = keys |> List.exists pressed + let input = + if pressedAny [ Keys.Up; Keys.W ] then Some Up + elif pressedAny [ Keys.Down; Keys.S ] then Some Down + elif pressed Keys.Enter then Some Confirm + elif pressed Keys.Escape then Some Back + else None + match input with + | Some nextInput -> this.DispatchMenuInput nextInput + | None when autoplay && not autoplayFlow && menu.Page = MainMenu && not menu.HasCurrentWorld -> + autoplayFrames <- autoplayFrames + 1 + if autoplayFrames >= 15 then + this.DispatchMenuInput Confirm + | None -> () + + member private this.UpdatePlaying (gameTime: GameTime) (kb: KeyboardState) (pressed: Keys -> bool) (pressedAny: Keys list -> bool) = + let mutable loadFailed = false + let mutable leftGame = false let lPressed = pressed Keys.L let escapePressed = pressed Keys.Escape if pressed Keys.P then simulationControl <- SimulationControl.togglePause simulationControl + menu <- MenuState.setSettings simulationControl menu printfn $"simulation={M6Presentation.clockLabel simulationControl}" if pressed Keys.F1 then simulationControl <- SimulationControl.setSpeed OneX simulationControl legacyStepsPerFrame <- None + menu <- MenuState.setSettings simulationControl menu printfn $"simulation={M6Presentation.clockLabel simulationControl}" if pressed Keys.F2 then simulationControl <- SimulationControl.setSpeed TwoX simulationControl legacyStepsPerFrame <- None + menu <- MenuState.setSettings simulationControl menu printfn $"simulation={M6Presentation.clockLabel simulationControl}" if pressed Keys.F3 then simulationControl <- SimulationControl.setSpeed FiveX simulationControl legacyStepsPerFrame <- None + menu <- MenuState.setSettings simulationControl menu 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}" + this.SaveWorld "save" |> ignore 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 + match this.LoadWorld "load" with + | Ok _ -> menu <- MenuState.setCurrentWorld true menu + | Error failure -> + menu <- menu |> MenuState.setCurrentWorld true |> MenuState.showLoadError failure + loadFailed <- true + if not loadFailed && 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}" + elif relationView then + relationView <- false + relationSnapshot <- None + printfn $"relation view=off 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}" - 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 - { MoveX = MathF.Sin(t / 60.0f) * 0.8f - MoveY = MathF.Cos(t / 90.0f) * 0.6f } - else - { MoveX = - (if kb.IsKeyDown(Keys.D) then 1.0f - elif kb.IsKeyDown(Keys.A) then -1.0f - else 0.0f) - MoveY = - (if kb.IsKeyDown(Keys.S) then 1.0f - elif kb.IsKeyDown(Keys.W) then -1.0f - else 0.0f) } - let ts = { Input = input } - let stepCount = SimulationControl.stepsPerFrameWithLegacy legacyStepsPerFrame simulationControl - if stepCount > 0 then - for _ in 1 .. stepCount do - world <- Sim.step ts world - this.CenterCamera() + this.OpenMainMenu() + leftGame <- true + if not loadFailed && not leftGame then + 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}" + 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 automated then + let t = float32 world.Tick + { MoveX = MathF.Sin(t / 60.0f) * 0.8f + MoveY = MathF.Cos(t / 90.0f) * 0.6f } + else + { MoveX = + (if kb.IsKeyDown(Keys.D) then 1.0f + elif kb.IsKeyDown(Keys.A) then -1.0f + else 0.0f) + MoveY = + (if kb.IsKeyDown(Keys.S) then 1.0f + elif kb.IsKeyDown(Keys.W) then -1.0f + else 0.0f) } + let ts = { Input = input } + let stepCount = SimulationControl.stepsPerFrameWithLegacy legacyStepsPerFrame simulationControl + if stepCount > 0 then + for _ in 1 .. stepCount do + world <- Sim.step ts world + this.CenterCamera() + + member private this.RunAutoplayFlow() = + let moveDown count = + for _ in 1 .. count do + this.DispatchMenuInput Down + match flowStep with + | 0 -> + printfn "flow=main-menu" + this.DispatchMenuInput Confirm + printfn "flow=new-game" + flowStep <- 1 + | 1 when menu.Page = Playing -> + this.OpenMainMenu() + printfn "flow=return-menu" + flowStep <- 2 + | 2 when menu.Page = MainMenu -> + moveDown 3 + this.DispatchMenuInput Confirm + printfn "flow=settings=open" + this.DispatchMenuInput Down + this.DispatchMenuInput Confirm + this.DispatchMenuInput Back + printfn "flow=settings=back" + flowStep <- 3 + | 3 when menu.Page = MainMenu -> + moveDown 4 + this.DispatchMenuInput Confirm + printfn "flow=controls=open" + this.DispatchMenuInput Back + printfn "flow=controls=back" + flowStep <- 4 + | 4 when menu.Page = MainMenu -> + this.DispatchMenuInput Confirm + this.SaveWorld "flow=save" |> ignore + flowStep <- 5 + | 5 when menu.Page = Playing -> + this.LoadWorld "flow=load" |> ignore + flowStep <- 6 + | 6 -> + this.OpenMainMenu() + printfn "flow=exit" + this.Exit() + flowStep <- 7 + | _ -> () + + override this.Initialize() = + base.Initialize() + prevKb <- Keyboard.GetState() + + override _.LoadContent() = + spriteBatch <- new SpriteBatch(this.GraphicsDevice) + atlas <- Atlas.build this.GraphicsDevice + pixel <- new Texture2D(this.GraphicsDevice, 1, 1) + pixel.SetData([| Color.White |]) + + override this.Update(gameTime: GameTime) = + let kb = Keyboard.GetState() + let pressed (key: Keys) = kb.IsKeyDown(key) && not (prevKb.IsKeyDown(key)) + let pressedAny (keys: Keys list) = keys |> List.exists pressed + if autoplayFlow then + this.RunAutoplayFlow() + elif menu.Page = Playing then + this.UpdatePlaying gameTime kb pressed pressedAny + else + this.UpdateMenu pressed fpsFrames <- fpsFrames + 1 fpsSeconds <- fpsSeconds + gameTime.ElapsedGameTime.TotalSeconds if fpsSeconds >= 1.0 then @@ -305,8 +453,15 @@ type LivingVillageGame() as this = | Day -> "DAY" | Night -> "NIGHT" let viewTag = if relationView then " | [RELATIONS]" else "" + let pageName = + match menu.Page with + | MainMenu -> "MAIN MENU" + | Settings -> "SETTINGS" + | Controls -> "CONTROLS" + | Playing -> "PLAYING" + | LoadError -> "LOAD ERROR" this.Window.Title <- - $"Living Village M6{titleSuffix} | fps {fps:F1} | tick {world.Tick} | {dayNight} | {M6Presentation.clockLabel simulationControl} | npc {npcAction}{viewTag} | panel {M5Interaction.panelName m5View} | {M5Interaction.titleText m5View}" + $"Living Village M6{titleSuffix} | {pageName} | 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 @@ -350,12 +505,68 @@ type LivingVillageGame() as this = spriteBatch.End() override this.Draw(gameTime: GameTime) = - if relationView then + if menu.Page <> Playing then + this.DrawMenu() + elif relationView then this.DrawRelationView() this.DrawM5Overlay() else this.DrawWorldView() + member private this.DrawMenu() = + this.DrawWorldView() + let viewport = this.GraphicsDevice.Viewport + let width = viewport.Width + let height = viewport.Height + let panelWidth = min 720 (max 1 (width - 64)) + let panelHeight = min 640 (max 1 (height - 48)) + let panelX = (width - panelWidth) / 2 + let panelY = (height - panelHeight) / 2 + let innerX = panelX + 32 + let textScale = 3 + let lineHeight = 30 + let selectedColor = Color(245, 222, 120) + let textColor = Color(210, 226, 220) + let mutedColor = Color(140, 170, 170) + let drawText (x: int) (y: int) (color: Color) (text: string) = + PixelText.draw spriteBatch pixel x y textScale color text + let drawSelection (index: int) (label: string) (y: int) = + let selected = index = menu.Selected + let prefix = if selected then ">" else " " + drawText innerX y (if selected then selectedColor else textColor) (sprintf "%s %s" prefix label) + spriteBatch.Begin() + spriteBatch.Draw(pixel, Rectangle(0, 0, width, height), Color(4, 9, 14, 190)) + spriteBatch.Draw(pixel, Rectangle(panelX, panelY, panelWidth, panelHeight), Color(11, 19, 27, 245)) + spriteBatch.Draw(pixel, Rectangle(panelX, panelY, panelWidth, 6), Color(92, 180, 190)) + drawText innerX (panelY + 28) (Color(235, 246, 232)) "LIVING VILLAGE" + let contentY = panelY + 100 + match menu.Page with + | MainMenu -> + drawText innerX (panelY + 70) mutedColor "MAIN MENU" + MenuState.items menu + |> List.iteri (fun index item -> drawSelection index (MenuState.itemLabel item) (contentY + index * lineHeight)) + drawText innerX (panelY + panelHeight - 54) mutedColor "UP DOWN SELECT ENTER CONFIRM" + | Settings -> + drawText innerX (panelY + 70) mutedColor "SETTINGS" + MenuState.settings + |> List.iteri (fun index setting -> drawSelection index (MenuState.settingsLabel setting) (contentY + index * lineHeight)) + drawText innerX (panelY + panelHeight - 84) mutedColor (sprintf "ACTIVE %s" (M6Presentation.clockLabel menu.Settings)) + drawText innerX (panelY + panelHeight - 54) mutedColor "ENTER APPLY ESC BACK" + | Controls -> + drawText innerX (panelY + 70) mutedColor "CONTROLS" + MenuState.controlRows + |> List.iteri (fun index row -> + drawText innerX (contentY + index * 25) textColor (sprintf "%s %s" row.Keys row.Action)) + drawText innerX (panelY + panelHeight - 28) mutedColor "ESC BACK" + | LoadError -> + drawText innerX (panelY + 70) (Color(240, 130, 120)) "LOAD ERROR" + let message = menu.Error |> Option.defaultValue "NO SAVE AVAILABLE" |> fun value -> value.ToUpperInvariant() + let visible = if message.Length > 34 then message.Substring(0, 34) else message + drawText innerX contentY textColor visible + drawText innerX (contentY + lineHeight * 2) mutedColor "ENTER OR ESC BACK" + | Playing -> () + spriteBatch.End() + member private this.DrawWorldView() = let profile = M6Presentation.profileAtTick world.Tick this.GraphicsDevice.Clear(profile.Background) diff --git a/src/LivingVillage.Desktop/LivingVillage.Desktop.fsproj b/src/LivingVillage.Desktop/LivingVillage.Desktop.fsproj index caf8ba5..36f1216 100644 --- a/src/LivingVillage.Desktop/LivingVillage.Desktop.fsproj +++ b/src/LivingVillage.Desktop/LivingVillage.Desktop.fsproj @@ -6,6 +6,7 @@ </PropertyGroup> <ItemGroup> + <Compile Include="MenuState.fs" /> <Compile Include="Interaction.fs" /> <Compile Include="M6Presentation.fs" /> <Compile Include="Game.fs" /> diff --git a/src/LivingVillage.Desktop/MenuState.fs b/src/LivingVillage.Desktop/MenuState.fs new file mode 100644 index 0000000..78d846c --- /dev/null +++ b/src/LivingVillage.Desktop/MenuState.fs @@ -0,0 +1,192 @@ +namespace LivingVillage.Desktop + +open LivingVillage.Kernel + +type MenuPage = + | MainMenu + | Settings + | Controls + | Playing + | LoadError + +type MenuItem = + | ContinueItem + | NewGameItem + | LoadItem + | SettingsItem + | ControlsItem + | ExitItem + +type MenuSetting = + | OneXSetting + | TwoXSetting + | FiveXSetting + | PauseSetting + +type MenuInput = + | Up + | Down + | Confirm + | Back + +type MenuCommand = + | NoCommand + | ContinueGame + | StartNewGame + | LoadGame + | ApplySettings of SimulationControl + | ExitGame + +type ControlRow = + { Keys: string + Action: string } + +type MenuState = + { Page: MenuPage + Selected: int + HasCurrentWorld: bool + ReturnPage: MenuPage + Settings: SimulationControl + Error: string option } + +module MenuState = + + let settings : MenuSetting list = + [ OneXSetting; TwoXSetting; FiveXSetting; PauseSetting ] + + let controlRows : ControlRow list = + [ { Keys = "WASD"; Action = "MOVE" } + { Keys = "E"; Action = "INTERACT" } + { Keys = "1-6"; Action = "DIALOGUE" } + { Keys = "Q"; Action = "OBSERVE" } + { Keys = "TAB"; Action = "NEEDS" } + { Keys = "C"; Action = "CHRONICLE" } + { Keys = "L"; Action = "RELATIONS" } + { Keys = "P"; Action = "PAUSE" } + { Keys = "F1/F2/F3"; Action = "SPEED" } + { Keys = "F6"; Action = "SAVE" } + { Keys = "F7"; Action = "LOAD" } + { Keys = "ESC"; Action = "MENU OR CLOSE" } + { Keys = "UP/DOWN"; Action = "SELECT" } + { Keys = "ENTER"; Action = "CONFIRM" } ] + + let create (simulationControl: SimulationControl) (hasCurrentWorld: bool) : MenuState = + { Page = MainMenu + Selected = 0 + HasCurrentWorld = hasCurrentWorld + ReturnPage = MainMenu + Settings = simulationControl + Error = None } + + let items (state: MenuState) : MenuItem list = + if state.HasCurrentWorld then + [ ContinueItem; NewGameItem; LoadItem; SettingsItem; ControlsItem; ExitItem ] + else + [ NewGameItem; LoadItem; SettingsItem; ControlsItem; ExitItem ] + + let settingsLabel setting : string = + match setting with + | OneXSetting -> "1X" + | TwoXSetting -> "2X" + | FiveXSetting -> "5X" + | PauseSetting -> "PAUSE" + + let itemLabel item : string = + match item with + | ContinueItem -> "CONTINUE" + | NewGameItem -> "NEW GAME" + | LoadItem -> "LOAD SAVE" + | SettingsItem -> "SETTINGS" + | ControlsItem -> "CONTROLS" + | ExitItem -> "QUIT" + + let private optionsFor (state: MenuState) : int = + match state.Page with + | MainMenu -> items state |> List.length + | Settings -> settings.Length + | _ -> 0 + + let private moveBy (delta: int) (state: MenuState) : MenuState = + let count = optionsFor state + if count = 0 then + state + else + let next = (state.Selected + delta) % count + let wrapped = if next < 0 then next + count else next + { state with Selected = wrapped } + + let move direction state = + match direction with + | Up -> moveBy -1 state + | Down -> moveBy 1 state + | Confirm + | Back -> state + + let selectedItem (state: MenuState) : MenuItem = + items state |> List.item state.Selected + + let selectedSetting (state: MenuState) : MenuSetting = + settings |> List.item state.Selected + + let private selectedControl (state: MenuState) : SimulationControl = + match selectedSetting state with + | OneXSetting -> { state.Settings with Paused = false; Speed = OneX } + | TwoXSetting -> { state.Settings with Paused = false; Speed = TwoX } + | FiveXSetting -> { state.Settings with Paused = false; Speed = FiveX } + | PauseSetting -> { state.Settings with Paused = true } + + let enterGame (state: MenuState) : MenuState = + { state with Page = Playing; Selected = 0; ReturnPage = MainMenu; Error = None } + + let setCurrentWorld (hasCurrentWorld: bool) (state: MenuState) : MenuState = + { state with HasCurrentWorld = hasCurrentWorld } + + let setSettings (simulationControl: SimulationControl) (state: MenuState) : MenuState = + { state with Settings = simulationControl } + + let openMain (state: MenuState) : MenuState = + { state with Page = MainMenu; Selected = 0; ReturnPage = MainMenu; Error = None } + + let openSettings (state: MenuState) : MenuState = + { state with Page = Settings; Selected = 0; ReturnPage = state.Page; Error = None } + + let openControls (state: MenuState) : MenuState = + { state with Page = Controls; Selected = 0; ReturnPage = state.Page; Error = None } + + let showLoadError (message: string) (state: MenuState) : MenuState = + { state with Page = LoadError; Selected = 0; ReturnPage = MainMenu; Error = Some message } + + let private returnFromSubpage (state: MenuState) : MenuState = + match state.ReturnPage with + | Playing -> { state with Page = Playing; Selected = 0; Error = None } + | _ -> openMain state + + let private confirmMain (state: MenuState) : MenuState * MenuCommand = + match selectedItem state with + | ContinueItem -> enterGame state, ContinueGame + | NewGameItem -> state, StartNewGame + | LoadItem -> state, LoadGame + | SettingsItem -> openSettings state, NoCommand + | ControlsItem -> openControls state, NoCommand + | ExitItem -> state, ExitGame + + let update (input: MenuInput) (state: MenuState) : MenuState * MenuCommand = + match input with + | Up -> move Up state, NoCommand + | Down -> move Down state, NoCommand + | Back -> + match state.Page with + | MainMenu -> state, ExitGame + | Settings + | Controls -> returnFromSubpage state, NoCommand + | LoadError -> openMain state, NoCommand + | Playing -> openMain state, NoCommand + | Confirm -> + match state.Page with + | MainMenu -> confirmMain state + | Settings -> + let nextSettings = selectedControl state + { state with Settings = nextSettings }, ApplySettings nextSettings + | Controls -> state, NoCommand + | LoadError -> openMain state, NoCommand + | Playing -> state, NoCommand |