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" |] '?', [| "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 titleSuffix = if autoplay then " [AUTOPLAY]" else "" let modeName = if 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 do graphics.PreferredBackBufferWidth <- 1280 graphics.PreferredBackBufferHeight <- 720 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" 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) 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 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 world <- nextWorld m5View <- nextView printfn $"m5 panel={M5Interaction.panelName m5View} status={m5View.Status} 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() 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 "" 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}" 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 relationView then this.DrawRelationView() this.DrawM5Overlay() else this.DrawWorldView() 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()