namespace LivingVillage.Desktop open System open Microsoft.Xna.Framework open Microsoft.Xna.Framework.Graphics open Microsoft.Xna.Framework.Input open LivingVillage.Kernel open LivingVillage.Kernel.Sim type TileKind = | Grass = 0 | Path = 1 | Water = 2 | Flower = 3 module MapGen = let generate (width: int) (height: int) : TileKind[,] = let rnd = Random(20260918) let map = Array2D.zeroCreate width height for y in 0 .. height - 1 do for x in 0 .. width - 1 do let border = x = 0 || y = 0 || x = width - 1 || y = height - 1 map.[x, y] <- if border then TileKind.Water elif rnd.NextDouble() < 0.04 then TileKind.Flower else TileKind.Grass let midX = width / 2 let midY = height / 2 for x in 1 .. width - 2 do map.[x, midY] <- TileKind.Path for y in 1 .. height - 2 do map.[midX, y] <- TileKind.Path map module Atlas = let tilePixels = 32 let build (device: GraphicsDevice) : Texture2D = let rnd = Random(7) let c (r: int) (g: int) (b: int) = Color(r, g, b) let tex = new Texture2D(device, tilePixels * 4, tilePixels) let colors = Array.zeroCreate (tilePixels * tilePixels * 4) for t in 0 .. 3 do let baseColor, variance, isFlower = match t with | 1 -> (c 148 118 84), 12, false | 2 -> (c 52 92 168), 10, false | 3 -> (c 56 118 48), 14, true | _ -> (c 56 118 48), 14, false for y in 0 .. tilePixels - 1 do for x in 0 .. tilePixels - 1 do let jitter = rnd.Next(variance + 1) - variance / 2 colors.[t * tilePixels * tilePixels + y * tilePixels + x] <- c (int baseColor.R + jitter) (int baseColor.G + jitter) (int baseColor.B + jitter) if isFlower then for _ in 1 .. 6 do let fx = rnd.Next(tilePixels - 2) let fy = rnd.Next(tilePixels - 2) let fc = if rnd.NextDouble() < 0.5 then c 240 220 80 else c 235 240 245 for dy in 0 .. 1 do for dx in 0 .. 1 do colors.[t * tilePixels * tilePixels + (fy + dy) * tilePixels + fx + dx] <- fc tex.SetData(colors) tex module NpcView = let actionName (k: NpcActionKind) : string = match k with | Eat -> "eat" | Sleep -> "sleep" | Wander -> "wander" | Work -> "work" | Chat -> "chat" 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" |] '>', [| "10000"; "01000"; "00100"; "00010"; "00100"; "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() let autoplay = Environment.GetEnvironmentVariable("LV_AUTOPLAY") = "1" 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 | 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 let mutable atlas = Unchecked.defaultof let mutable pixel = Unchecked.defaultof let mutable map = MapGen.generate Sim.mapWidthTiles Sim.mapHeightTiles let mutable world = Sim.initialWorldN 42UL Sim.npcCount let mutable camera = Vector2.Zero let mutable fpsFrames = 0 let mutable fpsSeconds = 0.0 let mutable prevKb = Unchecked.defaultof let mutable relationView = false let mutable relationSnapshot: float32[,] option = None 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 graphics.PreferredBackBufferHeight <- 720 graphics.SynchronizeWithVerticalRetrace <- true this.IsFixedTimeStep <- true this.TargetElapsedTime <- TimeSpan.FromTicks(TimeSpan.TicksPerSecond / 60L) 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() = let viewport = this.GraphicsDevice.Viewport let vw = float32 viewport.Width let vh = float32 viewport.Height let worldW = float32 (Sim.mapWidthTiles * Sim.tilePixels) let worldH = float32 (Sim.mapHeightTiles * Sim.tilePixels) let half = float32 Sim.tilePixels / 2.0f let x = MathHelper.Clamp(world.Avatar.Pos.X + half - vw / 2.0f, 0.0f, max 0.0f (worldW - vw)) let y = MathHelper.Clamp(world.Avatar.Pos.Y + half - vh / 2.0f, 0.0f, max 0.0f (worldH - vh)) camera <- Vector2(x, y) member private this.ResetWorldView() = relationView <- false relationSnapshot <- None m5View <- M5Interaction.initial this.CenterCamera() 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}" 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 = 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 this.SaveWorld "save" |> ignore if pressed Keys.F7 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.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 let fps = float fpsFrames / fpsSeconds fpsFrames <- 0 fpsSeconds <- 0.0 let npcAction = 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 "" 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} | {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 member private this.DrawLine (a: Vector2) (b: Vector2) (thickness: float32) (color: Color) = let d = b - a let len = d.Length() if len > 1.0f then let angle = MathF.Atan2(d.Y, d.X) spriteBatch.Draw(pixel, a, System.Nullable(), color, angle, Vector2.Zero, Vector2(len, thickness), SpriteEffects.None, 0.0f) member private this.DrawRelationView() = 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 let mapW = float32 (Sim.mapWidthTiles * Sim.tilePixels) let mapH = float32 (Sim.mapHeightTiles * Sim.tilePixels) let margin = 48.0f let scale = min ((vw - 2.0f * margin) / mapW) ((vh - 2.0f * margin) / mapH) let ox = (vw - mapW * scale) / 2.0f let oy = (vh - mapH * scale) / 2.0f let toScreen (p: Vec2) : Vector2 = Vector2(ox + p.X * scale, oy + p.Y * scale) spriteBatch.Begin() match relationSnapshot with | Some m -> let n = Array2D.length1 m for i in 0 .. n - 1 do for j in i + 1 .. n - 1 do let r = m.[i, j] if abs r > Sim.relationThreshold then let a = toScreen world.Npcs.[i].Pos let b = toScreen world.Npcs.[j].Pos let color = if r > 0.0f then Color.LimeGreen else Color.IndianRed let thickness = Sim.clamp (1.5f + 3.0f * abs r) 1.5f 12.0f this.DrawLine a b thickness color for npc in world.Npcs do let p = toScreen npc.Pos spriteBatch.Draw(pixel, Rectangle(int p.X - 5, int p.Y - 5, 10, 10), Color.Cyan) | None -> () spriteBatch.End() override this.Draw(gameTime: GameTime) = 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) let viewport = this.GraphicsDevice.Viewport let camX = int camera.X let camY = int camera.Y let tx0 = max 0 (camX / Sim.tilePixels) let ty0 = max 0 (camY / Sim.tilePixels) let tx1 = min (Sim.mapWidthTiles - 1) ((camX + viewport.Width) / Sim.tilePixels + 1) let ty1 = min (Sim.mapHeightTiles - 1) ((camY + viewport.Height) / Sim.tilePixels + 1) spriteBatch.Begin() for y in ty0 .. ty1 do for x in tx0 .. tx1 do 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, 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) let npcShades = [| Color.Navy; Color.MediumBlue; Color.Blue; Color.RoyalBlue; Color.DodgerBlue |] for npc in world.Npcs do let npcDst = Rectangle(int npc.Pos.X - camX, int npc.Pos.Y - camY, Sim.tilePixels, Sim.tilePixels) 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 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)) 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()