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 open LivingVillage.Desktop.ChineseText open LivingVillage.Desktop.VillagePresentation 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 isRenderable (text: string) : bool = not (isNull text) && text |> Seq.forall (fun character -> character = ' ' || Map.containsKey (Char.ToUpperInvariant character) glyphs || CjkGlyphAtlas.contains character) let draw (spriteBatch: SpriteBatch) (pixel: Texture2D) (cjkAtlas: Texture2D) (x: int) (y: int) (scale: int) (color: Color) (text: string) = let mutable cursor = x for character in text.ToUpperInvariant() do if character = ' ' then cursor <- cursor + (4 * scale) elif CjkGlyphAtlas.sourceRectangle character |> Option.isSome then let source = CjkGlyphAtlas.sourceRectangle character |> Option.get let glyphPixels = 8 * scale spriteBatch.Draw( cjkAtlas, Rectangle(cursor, y, glyphPixels, glyphPixels), Nullable(source), color) cursor <- cursor + glyphPixels else match glyphs |> Map.tryFind character with | Some rows -> 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) | None -> // Unsupported characters are intentionally blank, never a fake glyph. 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 sampleMode = Environment.GetEnvironmentVariable("LV_AUTOPLAY_SAMPLE") = "1" let daylightAutoplay = Environment.GetEnvironmentVariable("LV_AUTOPLAY_DAYLIGHT") = "1" let automated = autoplay || autoplayFlow let modeName = if sampleMode then "sample" elif 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 startSimulationControl = if sampleMode then SimulationControl.setSpeed TwoX initialSimulationControl else initialSimulationControl 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 artTextures = Unchecked.defaultof let mutable cjkAtlas = Unchecked.defaultof let mutable pixel = Unchecked.defaultof let renderPlan = VillageArt.sampleRenderPlan () let createInitialWorld () = WorldBootstrap.initialWorldForDaylight daylightAutoplay 42UL Sim.npcCount let mutable world = createInitialWorld () let mutable camera = Vector2.Zero let mutable avatarFacing = VillageArt.SouthFacing 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 = startSimulationControl let mutable legacyStepsPerFrame = (if sampleMode then None else initialLegacyStepsPerFrame) let mutable menu = MenuState.create startSimulationControl false let mutable autoplayFrames = 0 let mutable flowStep = 0 let mutable flowHold = 0 let mutable sampleState = SampleScript.initial let mutable hudClock = 0L let mutable hudStatus = "" let mutable hudStatusAt = 0L let mutable pauseHelpControl: SimulationControl option = None let recordMode = Environment.GetEnvironmentVariable("LV_AUTOPLAY_RECORD") = "1" let mutable recordIndex = 0 do graphics.PreferredBackBufferWidth <- 1280 graphics.PreferredBackBufferHeight <- 720 graphics.SynchronizeWithVerticalRetrace <- true this.IsFixedTimeStep <- true this.TargetElapsedTime <- TimeSpan.FromTicks(TimeSpan.TicksPerSecond / 60L) this.Window.Title <- ChineseText.copy.SceneTitle 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 avatarFacing <- VillageArt.SouthFacing m5View <- M5Interaction.refreshPrompt world M5Interaction.initial this.CenterCamera() member private this.StartNewGame() = world <- createInitialWorld () 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 m5View <- { m5View with Status = "save succeeded"; StatusTick = Some world.Tick } printfn $"{prefix}=ok path={savePath} tick={world.Tick}" true with | ex -> m5View <- { m5View with Status = "save failed"; StatusTick = Some world.Tick } 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 || sampleMode) && not autoplayFlow && menu.Page = MainMenu && not menu.HasCurrentWorld -> autoplayFrames <- autoplayFrames + 1 if autoplayFrames >= 15 then this.DispatchMenuInput Confirm | None -> () member private this.RunSampleMode () = let stageBefore = sampleState.Stage let positionBefore = world.Avatar.Pos let nextWorld, nextView, nextState = SampleScript.runFrame world m5View sampleState if nextWorld.Avatar.Pos <> positionBefore then avatarFacing <- VillageArt.facingAfterMovement positionBefore nextWorld.Avatar.Pos avatarFacing world <- nextWorld m5View <- nextView sampleState <- nextState this.CenterCamera() if nextState.Stage <> stageBefore then printfn $"sample stage={nextState.Stage} tick={nextWorld.Tick} pos=({nextWorld.Avatar.Pos.X:F0},{nextWorld.Avatar.Pos.Y:F0})" if nextState.Stage = SampleScript.SampleComplete then printfn (if nextState.TimedOut then "sample result=timeout" else "sample result=ok") this.Exit() member private this.UpdatePlaying (gameTime: GameTime) (kb: KeyboardState) (pressed: Keys -> bool) (pressedAny: Keys list -> bool) = if sampleMode then this.RunSampleMode() else this.UpdatePlayingManual gameTime kb pressed pressedAny member private this.UpdatePlayingManual (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 if m5View.Panel = WorldPanel then let helpState, pausedControl = MenuState.enterPauseHelp simulationControl menu menu <- helpState pauseHelpControl <- Some simulationControl simulationControl <- pausedControl printfn $"help=pause-open 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 && M5Interaction.worldInputAllowed m5View 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 M5Interaction.worldInputAllowed m5View && pressed Keys.E then Some Interact elif m5View.Panel = DialoguePanel && pressedAny [ Keys.D1; Keys.NumPad1 ] then Some Intent1 elif m5View.Panel = DialoguePanel && pressedAny [ Keys.D2; Keys.NumPad2 ] then Some Intent2 elif m5View.Panel = DialoguePanel && pressedAny [ Keys.D3; Keys.NumPad3 ] then Some Intent3 elif m5View.Panel = DialoguePanel && pressedAny [ Keys.D4; Keys.NumPad4 ] then Some Intent4 elif m5View.Panel = DialoguePanel && pressedAny [ Keys.D5; Keys.NumPad5 ] then Some Intent5 elif m5View.Panel = DialoguePanel && 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 let previousPosition = world.Avatar.Pos world <- Sim.step ts world avatarFacing <- VillageArt.facingAfterMovement previousPosition world.Avatar.Pos avatarFacing this.CenterCamera() m5View <- M5Interaction.refreshPrompt world m5View member private this.RunAutoplayFlow() = let moveDown count = for _ in 1 .. count do this.DispatchMenuInput Down match flowStep with | 0 -> printfn "flow=main-menu" flowStep <- 50 | 50 when menu.Page = MainMenu -> flowHold <- flowHold + 1 if flowHold >= 60 then flowHold <- 0 this.DispatchMenuInput Confirm printfn "flow=new-game" flowStep <- 1 | 50 -> 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" flowStep <- 30 | 30 -> flowHold <- flowHold + 1 if flowHold >= 60 || menu.Page <> Controls then flowHold <- 0 flowStep <- 31 | 31 -> 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) artTextures <- VillageArt.loadTextures this.GraphicsDevice cjkAtlas <- CjkGlyphAtlas.load this.GraphicsDevice pixel <- new Texture2D(this.GraphicsDevice, 1, 1) pixel.SetData([| Color.White |]) override _.UnloadContent() = if not (isNull artTextures.TileAtlas) then artTextures.TileAtlas.Dispose() if not (isNull artTextures.CharacterAtlas) then artTextures.CharacterAtlas.Dispose() if not (isNull artTextures.InteriorAtlas) then artTextures.InteriorAtlas.Dispose() if not (isNull cjkAtlas) then cjkAtlas.Dispose() if not (isNull pixel) then pixel.Dispose() if not (isNull spriteBatch) then spriteBatch.Dispose() 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 match pauseHelpControl with | Some original when menu.Page = Playing -> let _, restoredControl = MenuState.exitPauseHelp original menu simulationControl <- restoredControl pauseHelpControl <- None printfn $"help=pause-close simulation={M6Presentation.clockLabel simulationControl}" | _ -> () hudClock <- hudClock + 1L if m5View.Status <> hudStatus then hudStatus <- m5View.Status hudStatusAt <- hudClock fpsFrames <- fpsFrames + 1 fpsSeconds <- fpsSeconds + gameTime.ElapsedGameTime.TotalSeconds if fpsSeconds >= 1.0 then let fps = float fpsFrames / fpsSeconds fpsFrames <- 0 fpsSeconds <- 0.0 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() if recordMode && sampleMode then recordIndex <- recordIndex + 1 if recordIndex % 25 = 0 then let directory = "/tmp/lv-p5-prompt" System.IO.Directory.CreateDirectory directory |> ignore let width, height = this.GraphicsDevice.PresentationParameters.BackBufferWidth, this.GraphicsDevice.PresentationParameters.BackBufferHeight let buffer = Array.zeroCreate (width * height) this.GraphicsDevice.GetBackBufferData(buffer) use texture = new Texture2D(this.GraphicsDevice, width, height) texture.SetData(buffer) let path = sprintf "%s/rec-frame-%04d.png" directory recordIndex use stream = System.IO.File.Create(path) texture.SaveAsPng(stream, width, height) member private this.DrawMenu() = let viewport = this.GraphicsDevice.Viewport let width = viewport.Width let height = viewport.Height let layout = TitleScreen.layout width height let panelWidth = layout.PanelWidth let panelX = layout.PanelX let panelY = layout.PanelY let contentRows = match menu.Page with | MainMenu -> MenuState.items menu |> List.length | Settings -> MenuState.settings.Length | Controls -> MenuState.controlRows.Length | LoadError -> 4 | Playing -> 0 let rowHeight = if menu.Page = Controls then 25 else layout.MenuLineHeight let panelY = if menu.Page = Controls then layout.ControlsPanelY else layout.PanelY let panelHeight = min (height - panelY - 16) (max layout.PanelHeight (120 + contentRows * rowHeight + 48)) let innerX = layout.MenuX let textScale = 2 let lineHeight = layout.MenuLineHeight 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 cjkAtlas x y textScale color text let drawSelection (index: int) (label: string) (y: int) = let selected = index = menu.Selected let cursor, labelRect = TitleScreen.selectionRects layout index if selected then PixelText.draw spriteBatch pixel cjkAtlas cursor.X cursor.Y textScale selectedColor ">" else PixelText.draw spriteBatch pixel cjkAtlas cursor.X cursor.Y textScale mutedColor " " PixelText.draw spriteBatch pixel cjkAtlas labelRect.X labelRect.Y textScale (if selected then selectedColor else textColor) label spriteBatch.Begin() // Layered dusk gradient: sky bands darken toward the horizon, never a flat block. let bandCount = List.length layout.SkyBands let bandHeight = height / bandCount List.iteri (fun index (band: TitleScreen.ColorRgb) -> let y0 = index * bandHeight let y1 = if index = bandCount - 1 then height else y0 + bandHeight spriteBatch.Draw(pixel, Rectangle(0, y0, width, y1 - y0), Color(band.R, band.G, band.B))) layout.SkyBands // Jiangnan skyline: eave tiles continuously, ridge tiles rising above them. List.iteri (fun column slot -> let x = column * Sim.tilePixels let source = VillageArt.atlasTileRectangle slot if slot = fst TitleScreen.roofSlots then spriteBatch.Draw(artTextures.TileAtlas, Rectangle(x, layout.RidgeY, Sim.tilePixels, Sim.tilePixels), source, Color.White) spriteBatch.Draw(artTextures.TileAtlas, Rectangle(x, layout.EaveY, Sim.tilePixels, Sim.tilePixels), VillageArt.atlasTileRectangle (snd TitleScreen.roofSlots), Color.White)) layout.RoofTileSlots // Water band drawn from the atlas water tile, reflecting the skyline above. for row in layout.WaterRows do for x in 0 .. Sim.tilePixels .. width - 1 do spriteBatch.Draw(artTextures.TileAtlas, Rectangle(x, row, Sim.tilePixels, Sim.tilePixels), VillageArt.atlasTileRectangle TitleScreen.waterSlot, Color(150, 170, 178)) // Lantern glows along the water bank. let lanternColor, lanternHalo = TitleScreen.lanternColors for (lx, ly) in layout.Lanterns do spriteBatch.Draw(pixel, Rectangle(lx - 8, ly - 8, 24, 24), Color(lanternHalo.R, lanternHalo.G, lanternHalo.B, 70)) spriteBatch.Draw(pixel, Rectangle(lx - 3, ly - 5, 8, 10), Color(lanternColor.R, lanternColor.G, lanternColor.B)) spriteBatch.Draw(pixel, Rectangle(lx - 1, ly - 7, 4, 2), Color(90, 60, 40)) spriteBatch.Draw(pixel, Rectangle(lx - 2, ly + 5, 6, 2), Color(90, 60, 40)) // Title: large CJK atlas glyphs with a soft shadow for readability. PixelText.draw spriteBatch pixel cjkAtlas (layout.TitleX + 4) (layout.TitleY + 4) layout.TitleScale (Color(12, 20, 28)) layout.TitleText PixelText.draw spriteBatch pixel cjkAtlas layout.TitleX layout.TitleY layout.TitleScale (Color(235, 246, 232)) layout.TitleText // Menu panel floats over the lower half; translucent so the scene layers stay visible. spriteBatch.Draw(pixel, Rectangle(panelX, panelY, panelWidth, panelHeight), Color(11, 19, 27, 200)) spriteBatch.Draw(pixel, Rectangle(panelX, panelY, panelWidth, 4), Color(92, 180, 190)) let contentY = panelY + 60 let headingY = panelY + 20 match menu.Page with | MainMenu -> drawText innerX headingY mutedColor (ChineseText.menuHeading MainMenuHeading) MenuState.items menu |> List.iteri (fun index item -> drawSelection index (MenuState.itemLabel item) (contentY + index * lineHeight)) drawText innerX (panelY + panelHeight - 40) mutedColor "UP DOWN 选择 ENTER 确认" | Settings -> drawText innerX headingY mutedColor (ChineseText.menuHeading SettingsHeading) MenuState.settings |> List.iteri (fun index setting -> drawSelection index (MenuState.settingsLabel setting) (contentY + index * lineHeight)) drawText innerX (panelY + panelHeight - 72) mutedColor (sprintf "当前 %s" (M6Presentation.clockLabel menu.Settings)) drawText innerX (panelY + panelHeight - 40) mutedColor "ENTER 应用 ESC 返回" | Controls -> drawText innerX headingY mutedColor (ChineseText.menuHeading ControlsHeading) MenuState.controlRows |> List.iteri (fun index row -> let keyRect, actionRect = TitleScreen.controlRowRects layout index PixelText.draw spriteBatch pixel cjkAtlas keyRect.X keyRect.Y textScale textColor row.Keys PixelText.draw spriteBatch pixel cjkAtlas actionRect.X actionRect.Y textScale textColor row.Action) drawText innerX (panelY + panelHeight - 40) mutedColor "ESC 返回" | LoadError -> drawText innerX headingY (Color(240, 130, 120)) "读取失败" let message = menu.Error |> Option.defaultValue "暂无存档" let visible = if message.Length > 24 then message.Substring(0, 24) else message drawText innerX contentY textColor visible drawText innerX (contentY + lineHeight * 2) mutedColor "ENTER ESC 返回" | Playing -> () spriteBatch.End() member private this.DrawWorldView() = let profile = M6Presentation.profileAtTick world.Tick let viewport = this.GraphicsDevice.Viewport this.GraphicsDevice.Clear(profile.Background) spriteBatch.Begin() match m5View.HomeMode with | Inside _ -> VillageArt.drawInterior spriteBatch pixel artTextures viewport.Width viewport.Height renderPlan.Interior profile.WorldTint let interiorAvatarSpec = VillageArt.avatarSpriteSpec avatarFacing world.Tick VillageArt.drawInteriorCharacter spriteBatch artTextures viewport.Width viewport.Height world.Avatar.Pos interiorAvatarSpec profile.WorldTint | Outside -> VillageArt.drawWorld spriteBatch artTextures camera viewport.Width viewport.Height renderPlan world.Tick profile.WorldTint let avatarSpec = VillageArt.avatarSpriteSpec avatarFacing world.Tick VillageArt.drawCharacter spriteBatch artTextures camera world.Avatar.Pos avatarSpec profile.WorldTint for npc in world.Npcs do let spec = VillageArt.npcSpriteSpecAtTarget npc.Id npc.Pos npc.Mind.Target world.Tick VillageArt.drawCharacter spriteBatch artTextures camera npc.Pos spec profile.WorldTint spriteBatch.End() // Contextual floating prompt over the unique target; same CJK atlas font path as the HUD. if m5View.Panel = M5Panel.WorldPanel && menu.Page = Playing then match m5View.Prompt, m5View.PromptTargetPos with | Some text, Some targetPos -> let scale = 2 let rect = FloatingPrompt.layout viewport.Width viewport.Height targetPos.X targetPos.Y camera.X camera.Y scale text spriteBatch.Begin() spriteBatch.Draw(pixel, Rectangle(rect.X - 6, rect.Y - 5, rect.Width + 12, rect.Height + 8), Color(15, 19, 25, 200)) spriteBatch.Draw(pixel, Rectangle(rect.X - 6, rect.Y - 5, rect.Width + 12, 2), Color(92, 180, 190)) PixelText.draw spriteBatch pixel cjkAtlas rect.X rect.Y scale (Color(240, 250, 240)) text spriteBatch.End() | _ -> () this.DrawM5Overlay() member private this.DrawM5Overlay() = let viewport = this.GraphicsDevice.Viewport let textScale = 2 let lineHeight = 18 let profile = M6Presentation.profileAtTick world.Tick let timeLine = sprintf "时间 %s %s" (M6Presentation.dayNightLabel profile.Mode) (M6Presentation.clockLabel simulationControl) let persistentLines = timeLine :: (m5View.Prompt |> Option.toList) let dialogueLines = match m5View.Panel, m5View.Menu with | DialoguePanel, Some menu -> menu.Options |> List.mapi (fun index intent -> sprintf "%d %s" (index + 1) (M5Interaction.intentLine intent)) |> fun options -> [ sprintf "互动：村民 %d" (M5Interaction.menuNpcNumber menu) ] @ options | _ -> [] let statusView = { m5View with StatusTick = Some hudStatusAt } let statusLine = M5Interaction.transientStatusLine hudClock statusView |> Option.toList let allLines = persistentLines @ dialogueLines @ statusLine let cornerLines = M5Interaction.cornerStatusLines world let panelWidth = min 360 (max 1 (viewport.Width - 32)) let maxLines = max 1 ((viewport.Height - 48) / lineHeight) let lines = allLines |> List.truncate maxLines let panelHeight = lines.Length * lineHeight + 24 let panelX = 16 let panelY = max 16 (viewport.Height - panelHeight - 16) let panel = Rectangle(panelX, panelY, panelWidth, panelHeight) let innerX = panelX + 12 let innerWidth = max 1 (panelWidth - 24) let maxChars = max 1 (innerWidth / (6 * textScale)) spriteBatch.Begin() spriteBatch.Draw(pixel, panel, Color(15, 19, 25, 160)) spriteBatch.Draw(pixel, Rectangle(panelX, panelY, panelWidth, 3), 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 cjkAtlas innerX (panelY + 12 + index * lineHeight) textScale color visible) // Minimal top-right status strip: day counter + real money/energy values. let cornerWidth = 232 let cornerHeight = List.length cornerLines * lineHeight + 20 let cornerX = viewport.Width - cornerWidth - 16 let cornerY = 16 spriteBatch.Draw(pixel, Rectangle(cornerX, cornerY, cornerWidth, cornerHeight), Color(15, 19, 25, 150)) spriteBatch.Draw(pixel, Rectangle(cornerX, cornerY, cornerWidth, 3), Color(92, 180, 190)) cornerLines |> List.iteri (fun index line -> let visible = if line.Length > maxChars then line.Substring(0, maxChars) else line PixelText.draw spriteBatch pixel cjkAtlas (cornerX + 10) (cornerY + 10 + index * lineHeight) textScale (Color(220, 235, 220)) visible) spriteBatch.End()