path: root/src/LivingVillage.Desktop/Game.fs

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<TileKind> 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<Color> (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<SpriteBatch>
    let mutable atlas = Unchecked.defaultof<Texture2D>
    let mutable pixel = Unchecked.defaultof<Texture2D>
    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<KeyboardState>
    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()