path: root/src/LivingVillage.Desktop.Tests/P40ArtTests.fs

namespace LivingVillage.Desktop.Tests

open Microsoft.VisualStudio.TestTools.UnitTesting
open LivingVillage.Kernel.Sim
open LivingVillage.Desktop
open LivingVillage.Desktop.VillageArt

/// P40 art-deepening slice:
///  * paving slabs follow the traffic network (paths / doorways / bridges) and the
///    isolated decorative scatter is dropped, so cc0 ground reads as coherent bands;
///  * red door lanterns complement the stone road lanterns with a distinct form,
///    both feeding the existing P14 premultiplied-alpha night-glow path;
///  * every placement stays a pure function of the map, so the same seed yields
///    byte-identical positions across day and night frames.
[<TestClass>]
type P40ArtTests () =

    let seed = 4242UL
    let map = MapGen.generateWithSize 256 192 seed

    let indexOf (x: int) (y: int) = y * map.Width + x
    let isStone (x: int) (y: int) =
        x >= 0 && x < map.Width && y >= 0 && y < map.Height
        && map.Tiles.[indexOf x y] = int MapGen.GroundTile.Stone

    // --- P40 boat awning: solid arch silhouette (atlas pixel decode) -----------
    // The atlas is written by scripts/make-cc0-art.py as non-interlaced 8-bit RGBA
    // with filter byte 0 on every scanline, so a tiny decoder is enough to assert
    // the awning is a filled arch with a continuous ridge (not a row of 1px posts).
    let atlasRgba () : int * int * (int -> int -> (int * int * int * int)) =
        let path = System.IO.Path.Combine(System.AppContext.BaseDirectory, cc0TileAtlasRelativePath)
        let bytes = System.IO.File.ReadAllBytes path
        let be32 (o: int) =
            (int bytes.[o] <<< 24) ||| (int bytes.[o + 1] <<< 16) ||| (int bytes.[o + 2] <<< 8) ||| int bytes.[o + 3]
        let width = be32 16
        let height = be32 20
        let mutable offset = 8
        let mutable idat = System.IO.MemoryStream()
        while offset < bytes.Length do
            let length = be32 offset
            let tag = System.Text.Encoding.ASCII.GetString(bytes, offset + 4, 4)
            if tag = "IDAT" then idat.Write(bytes, offset + 8, length)
            offset <- offset + 12 + length
        use z = new System.IO.Compression.ZLibStream(new System.IO.MemoryStream(idat.ToArray()), System.IO.Compression.CompressionMode.Decompress)
        use ms = new System.IO.MemoryStream()
        z.CopyTo ms
        let decompressed = ms.ToArray()
        let stride = width * 4
        let pixels = Array.zeroCreate<byte> (width * height * 4)
        for y in 0 .. height - 1 do
            let rowStart = y * (stride + 1) + 1 // skip the per-row filter byte (always 0 here)
            Array.blit decompressed rowStart pixels (y * stride) stride
        let get (x: int) (y: int) =
            if x < 0 || x >= width || y < 0 || y >= height then (0, 0, 0, 0)
            else
                let i = (y * width + x) * 4
                (int pixels.[i], int pixels.[i + 1], int pixels.[i + 2], int pixels.[i + 3])
        width, height, get

    let isBambooOpaque (r: int, g: int, b: int, a: int) =
        a > 0
        && ((r, g, b) = (44, 58, 34)
            || (r, g, b) = (86, 104, 62)
            || (r, g, b) = (28, 38, 22)
            || (r, g, b) = (22, 30, 17))

    // --- P41 boat night contrast: pixel regression on the recorded night frame ---
    // Decodes the MonoGame 8-bit RGBA PNG (color type 6, may use filters 0-4) so the
    // test can measure the rendered frame without a GPU.
    let decodePng (path: string) : int * int * (int -> int -> (int * int * int * int)) =
        let bytes = System.IO.File.ReadAllBytes path
        let be32 (o: int) =
            (int bytes.[o] <<< 24) ||| (int bytes.[o + 1] <<< 16) ||| (int bytes.[o + 2] <<< 8) ||| int bytes.[o + 3]
        let width = be32 16
        let height = be32 20
        let mutable offset = 8
        let mutable idat = new System.IO.MemoryStream()
        while offset < bytes.Length do
            let length = be32 offset
            let tag = System.Text.Encoding.ASCII.GetString(bytes, offset + 4, 4)
            if tag = "IDAT" then idat.Write(bytes, offset + 8, length)
            offset <- offset + 12 + length
        use z = new System.IO.Compression.ZLibStream(new System.IO.MemoryStream(idat.ToArray()), System.IO.Compression.CompressionMode.Decompress)
        use ms = new System.IO.MemoryStream()
        z.CopyTo ms
        let raw = ms.ToArray()
        let bpp = 4
        let stride = width * bpp
        let pixels = Array.zeroCreate<byte> (stride * height)
        let paeth (a: int) (b: int) (c: int) =
            let p = a + b - c
            let pa = abs (p - a)
            let pb = abs (p - b)
            let pc = abs (p - c)
            if pa <= pb && pa <= pc then a elif pb <= pc then b else c
        for y in 0 .. height - 1 do
            let ft = int raw.[y * (stride + 1)]
            let rowIn = y * (stride + 1) + 1
            let rowOut = y * stride
            let prev = rowOut - stride
            for x in 0 .. stride - 1 do
                let rv = int raw.[rowIn + x]
                let a = if x >= bpp then int pixels.[rowOut + x - bpp] else 0
                let b = if y > 0 then int pixels.[prev + x] else 0
                let c = if y > 0 && x >= bpp then int pixels.[prev + x - bpp] else 0
                let v =
                    match ft with
                    | 0 -> rv
                    | 1 -> rv + a
                    | 2 -> rv + b
                    | 3 -> rv + (a + b) / 2
                    | 4 -> rv + paeth a b c
                    | _ -> failwithf "unsupported PNG filter %d" ft
                pixels.[rowOut + x] <- byte (v &&& 0xFF)
        let get x y =
            let i = (y * width + x) * 4
            (int pixels.[i], int pixels.[i + 1], int pixels.[i + 2], int pixels.[i + 3])
        width, height, get

    let evidencePath (name: string) : string option =
        let mutable dir = Some (new System.IO.DirectoryInfo(System.AppContext.BaseDirectory))
        let mutable found = None
        while found.IsNone && dir.IsSome do
            let d = dir.Value
            let candidate = System.IO.Path.Combine(d.FullName, "docs/evidence", name)
            if System.IO.File.Exists candidate then found <- Some candidate
            else dir <- Option.ofObj d.Parent
        found

    let luma (r: int, g: int, b: int, _: int) =
        0.299 * float r + 0.587 * float g + 0.114 * float b


    [<TestMethod>]
    member _.PavingCoversTrafficNetworkAndDropsIsolatedScatter () =
        let paving = cc0PavingTiles map
        Assert.IsTrue(paving.Count > 0, "seed 4242 should pave something")
        // Every path / bridge anchor tile that is stone must be paved.
        for (x, y) in map.Paths @ map.Bridges do
            if isStone x y then
                Assert.IsTrue(paving.Contains(indexOf x y), sprintf "path/bridge stone (%d,%d) must be paved" x y)
        // Every paved tile must be stone and touch the network (itself or a 4-neighbour).
        let anchors = (map.Paths @ map.Bridges) |> List.map (fun (x, y) -> indexOf x y) |> Set.ofList
        let anchorAt (x: int) (y: int) =
            x >= 0 && x < map.Width && y >= 0 && y < map.Height && Set.contains (indexOf x y) anchors
        for i in paving do
            let x = i % map.Width
            let y = i / map.Width
            Assert.IsTrue(isStone x y, "paving must only replace stone tiles")
            Assert.IsTrue(
                anchorAt x y || anchorAt (x - 1) y || anchorAt (x + 1) y || anchorAt x (y - 1) || anchorAt x (y + 1),
                sprintf "paved tile (%d,%d) is disconnected from the traffic network" x y)
        // The isolated decorative scatter must NOT be paved (that is the whole point).
        Assert.IsTrue(paving.Count < (map.Tiles |> Array.filter (fun c -> c = int MapGen.GroundTile.Stone) |> Array.length),
                      "paving must be a strict subset of all stone (scatter dropped)")

    [<TestMethod>]
    member _.PavingIsDeterministicForTheSameSeed () =
        let map2 = MapGen.generateWithSize 256 192 seed
        let a = cc0PavingTiles map |> Set.toList |> List.sort |> List.map (fun i -> sprintf "%d" i) |> String.concat ";"
        let b = cc0PavingTiles map2 |> Set.toList |> List.sort |> List.map (fun i -> sprintf "%d" i) |> String.concat ";"
        Assert.AreEqual<string>(a, b)

    [<TestMethod>]
    member _.RedLanternsHangAtDoorwaysAndAreDeterministic () =
        let lanterns = cc0RedLanternTiles map
        let doors =
            (map.Buildings @ map.Farmhouses)
            |> List.map (fun b -> (b.DoorX, b.DoorY))
            |> List.distinct
        Assert.IsTrue(lanterns.Length > 0, "seed 4242 should hang red lanterns")
        Assert.AreEqual<int>(doors.Length, lanterns.Length)
        for (x, y) in lanterns do
            Assert.IsTrue(List.contains (x, y) doors, "a red lantern hangs exactly at a doorway")
        Assert.AreEqual<string>(
            (lanterns |> List.sort |> List.map (fun (x, y) -> sprintf "%d:%d" x y) |> String.concat ";"),
            (cc0RedLanternTiles map |> List.sort |> List.map (fun (x, y) -> sprintf "%d:%d" x y) |> String.concat ";"))

    [<TestMethod>]
    member _.RedAndStoneLanternsFeedTheSameNightGlowPath () =
        let cc0Lights = nightLightTilesWith true map |> Set.ofList
        let fallbackLights = nightLightTilesWith false map |> Set.ofList
        // cc0 mode adds both the road stone lanterns and the red door lanterns.
        for t in cc0RedLanternTiles map do
            Assert.IsTrue(Set.contains t cc0Lights, "red lantern must be a cc0 night light")
        for t in cc0LanternTiles map 12 do
            Assert.IsTrue(Set.contains t cc0Lights, "road lantern must be a cc0 night light")
        // Red lanterns hang at doorways, which are already house lights, so the
        // fallback set may legitimately contain that tile; what must NOT leak is
        // the road stone lantern set (a cc0-only placement).
        for t in cc0LanternTiles map 12 do
            Assert.IsFalse(Set.contains t fallbackLights, "road lantern must not leak into the fallback light set")
        Assert.IsTrue(nightLightTiles map = nightLightTilesWith false map, "nightLightTiles keeps the old set")
        Assert.IsTrue(Set.isSubset fallbackLights cc0Lights, "cc0 light set is a superset of the fallback set")

    [<TestMethod>]
    member _.SameSeedPlacementsAreStableAcrossGeneration () =
        // Day and night frames reuse the same map; re-generating it must reproduce
        // every P40 placement byte-for-byte (no clock, no hidden randomness).
        let map2 = MapGen.generateWithSize 256 192 seed
        Assert.AreEqual<string>(
            (cc0PavingTiles map |> Set.toList |> List.sort |> List.map string |> String.concat ";"),
            (cc0PavingTiles map2 |> Set.toList |> List.sort |> List.map string |> String.concat ";"))
        Assert.AreEqual<string>(
            (cc0RedLanternTiles map |> List.sort |> List.map (fun (x, y) -> sprintf "%d:%d" x y) |> String.concat ";"),
            (cc0RedLanternTiles map2 |> List.sort |> List.map (fun (x, y) -> sprintf "%d:%d" x y) |> String.concat ";"))

    [<TestMethod>]
    member _.P40AtlasIndicesAreInRange () =
        for index in [ cc0TileIndexPaving; cc0TileIndexRedLantern ] do
            Assert.IsTrue(index >= 0 && index < cc0TileCount, sprintf "P40 tile index %d out of atlas" index)
        Assert.AreEqual<int>(21, cc0TileCount)

    [<TestMethod>]
    member _.BoatAwningIsASolidArchWithAContinuousRidge () =
        let width, _, pixel = atlasRgba ()
        Assert.IsTrue(width >= (cc0TileIndexBoatRight + 1) * 32, "atlas must cover the boat tiles")
        for tile in [ cc0TileIndexBoatLeft; cc0TileIndexBoatRight ] do
            let ox = tile * 32
            // Ridge: y in [1,2], x in [6,25] must have no transparent column break.
            for x in 6 .. 25 do
                for y in 1 .. 2 do
                    let (_, _, _, a) = pixel (ox + x) y
                    Assert.IsTrue(a > 0, sprintf "boat tile %d ridge pixel (%d,%d) is transparent" tile x y)
            // Solid arch: below the arch line, every x in [4,27] has opaque bamboo.
            for x in 4 .. 27 do
                let hasBamboo =
                    [ 0 .. 31 ]
                    |> List.exists (fun y -> isBambooOpaque (pixel (ox + x) y))
                Assert.IsTrue(hasBamboo, sprintf "boat tile %d column %d has no opaque bamboo" tile x)
        // The two halves join: the arch top at the tile boundary is the same row.
        let topRow (ox: int) (x: int) =
            [ 0 .. 31 ] |> List.tryFind (fun y -> isBambooOpaque (pixel (ox + x) y))
        Assert.AreEqual<Option<int>>(
            topRow (cc0TileIndexBoatLeft * 32) 31,
            topRow (cc0TileIndexBoatRight * 32) 0,
            "left/right awning halves must meet at the same arch height (no broken arc)")

    [<TestMethod>]
    member _.NightBoatAwningIsAtLeast40GreyDarkerThanSurroundingGlow () =
        match evidencePath "p40-night.png" with
        | None -> Assert.Inconclusive "docs/evidence/p40-night.png has not been recorded"
        | Some path ->
            let _, _, pixel = decodePng path
            // The p40-night hook centers tile (234,50) in a 1280x720 viewport; the
            // 2-tile boat occupies tiles 234-235 at row 50 (Sim.tilePixels = 32).
            let camX = 234 * 32 + 16 - 640
            let camY = 50 * 32 + 16 - 360
            let x0 = 234 * 32 - camX
            let x1 = 235 * 32 + 32 - camX
            let y0 = 50 * 32 - camY
            let y1 = 51 * 32 - camY
            let mutable boatSum = 0.0
            let mutable boatN = 0
            for y in y0 .. y1 - 1 do
                for x in x0 .. x1 - 1 do
                    boatSum <- boatSum + luma (pixel x y)
                    boatN <- boatN + 1
            let m = 24
            let mutable ringSum = 0.0
            let mutable ringN = 0
            for y in y0 - m .. y1 - 1 + m do
                for x in x0 - m .. x1 - 1 + m do
                    if not (x >= x0 && x < x1 && y >= y0 && y < y1) then
                        ringSum <- ringSum + luma (pixel x y)
                        ringN <- ringN + 1
            let boat = boatSum / float boatN
            let ring = ringSum / float ringN
            Assert.IsTrue(
                ring - boat >= 40.0,
                sprintf "night boat awning contrast %.1f grey is below the 40 grey budget (boat %.1f ring %.1f)" (ring - boat) boat ring)