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

namespace LivingVillage.Desktop

open Microsoft.Xna.Framework.Graphics
open LivingVillage.Kernel
open LivingVillage.Kernel.Sim
open LivingVillage.Desktop.VillagePresentation

module VillageArt =

    type PropKind =
        | WhiteWallDarkTileHouse
        | StoneBridge
        | Bamboo
        | VegetableGarden

    type TileKind =
        | RiverWater
        | StonePaving

    type ArtProp =
        { Kind: PropKind
          Position: TilePosition }

    type ArtTile =
        { Kind: TileKind
          Position: TilePosition }

    type JiangnanArtPlan =
        { Props: ArtProp list
          Tiles: ArtTile list }

    type GroundKind =
        | Water
        | StonePath

    type RenderPropKind =
        | House
        | Bridge
        | BambooGrove
        | VegetablePatch
        | WillowTree
        | ShrubPatch
        | FlowerBush
        | ReedCluster
        | StoneBench
        | RiverLantern

    type RenderProp =
        { Kind: RenderPropKind
          Position: TilePosition }

    type InteriorElementKind =
        | Window
        | Table
        | Bed
        | Screen

    type InteriorElement =
        { Kind: InteriorElementKind
          Position: TilePosition }

    type InteriorPlan =
        { Elements: InteriorElement list }

    type JiangnanRenderPlan =
        { Origin: TilePosition
          Grounds: (TilePosition * GroundKind) list
          Props: RenderProp list
          Interior: InteriorPlan }

    type NpcVisualVariant =
        | IndigoRobe
        | OchreVest
        | JadeSash
        | GreyCap
        | StrawHat

    type FacingDirection =
        | NorthFacing
        | SouthFacing
        | WestFacing
        | EastFacing

    type AnimationFrame =
        | FrameOne
        | FrameTwo

    type NpcSpriteSpec =
        { Variant: NpcVisualVariant
          Direction: FacingDirection
          Frame: AnimationFrame }

    type ArtTextures =
        { TileAtlas: Texture2D
          CharacterAtlas: Texture2D
          InteriorAtlas: Texture2D }

    type private TileSprite =
        | GrassSprite
        | WaterSprite
        | StonePathSprite
        | RoofSprite
        | WallSprite
        | BridgeSprite
        | BambooSprite
        | GardenSprite
        | RoofRidgeSprite
        | RoofEaveSprite
        | WallWoodSprite
        | WallWindowSprite
        | DoorSprite
        | WaterSpriteB
        | WillowTopSprite
        | WillowBaseSprite
        | ShrubSprite
        | FlowerSprite
        | ReedSprite
        | BenchSprite
        | LanternSprite

    type private XnaColor = Microsoft.Xna.Framework.Color
    type private XnaRectangle = Microsoft.Xna.Framework.Rectangle
    type private XnaVector2 = Microsoft.Xna.Framework.Vector2

    let private position x y : TilePosition =
        { X = x
          Y = y }

    let private prop kind x y : ArtProp =
        { Kind = kind
          Position = position x y }

    let private tile kind x y : ArtTile =
        { Kind = kind
          Position = position x y }

    let samplePlan () : JiangnanArtPlan =
        { Props =
            [ prop WhiteWallDarkTileHouse 6 4
              prop StoneBridge 10 4
              prop Bamboo 3 2
              prop VegetableGarden 8 7 ]
          Tiles =
            [ tile RiverWater 10 2
              tile RiverWater 10 3
              tile StonePaving 4 5
              tile StonePaving 5 5
              tile StonePaving 6 5 ] }

    let sampleRenderPlan () : JiangnanRenderPlan =
        let ground kind x y = position x y, kind
        let renderProp (kind: RenderPropKind) x y : RenderProp =
            { Kind = kind
              Position = position x y }
        let interiorElement kind x y : InteriorElement =
            { Kind = kind
              Position = position x y }

        { Origin = position 25 18
          Grounds =
              [ ground StonePath 3 5
                ground StonePath 4 5
                ground StonePath 5 5
                ground StonePath 6 5
                ground StonePath 7 5
                ground StonePath 8 5
                ground StonePath 9 5
                ground StonePath 10 5
                ground StonePath 11 5
                ground StonePath 6 6
                ground StonePath 6 7
                ground StonePath 6 8
                ground StonePath 6 9
                ground StonePath 6 10
                for x in 0 .. 5 do
                    ground StonePath x 11
                for x in 9 .. 19 do
                    ground StonePath x 11
                for x in 1 .. 18 do
                    ground StonePath x 14
                ground Water 6 11
                ground Water 7 11
                ground Water 8 11
                for x in 0 .. 19 do
                    ground Water x 12
                for x in 2 .. 17 do
                    ground Water x 13 ]
          Props =
              [ renderProp House 6 5
                renderProp Bridge 6 11
                renderProp BambooGrove 3 2
                renderProp VegetablePatch 8 7
                renderProp WillowTree 1 9
                renderProp WillowTree 13 9
                renderProp ShrubPatch 1 7
                renderProp ShrubPatch 10 7
                renderProp FlowerBush 3 8
                renderProp FlowerBush 12 8
                renderProp ReedCluster 3 12
                renderProp ReedCluster 15 13
                renderProp StoneBench 9 11
                renderProp RiverLantern 5 11
                renderProp RiverLantern 7 14 ]
          Interior =
              { Elements =
                  [ interiorElement Window 2 2
                    interiorElement Table 4 4
                    interiorElement Bed 7 3
                    interiorElement Screen 7 6 ] } }

    let worldTile (plan: JiangnanRenderPlan) (localPosition: TilePosition) : TilePosition =
        { X = plan.Origin.X + localPosition.X
          Y = plan.Origin.Y + localPosition.Y }

    /// Every tile a prop paints over, in world coordinates. Used by draw ordering and by
    /// spawn-overlap assertions so villagers never start inside a painted prop.
    let planFootprint (plan: JiangnanRenderPlan) : TilePosition list =
        let many positions = positions |> List.map (worldTile plan)
        plan.Props
        |> List.collect (fun prop ->
            let x, y = prop.Position.X, prop.Position.Y
            match prop.Kind with
            | House ->
                [ for dx in -2 .. 1 do
                      for dy in -2 .. 0 do
                          yield position (x + dx) (y + dy) ]
            | Bridge -> [ position x y; position x (y + 1); position x (y + 2) ]
            | BambooGrove -> [ position x y; position x (y + 1); position (x + 1) y ]
            | VegetablePatch -> [ position x y; position (x + 1) y ]
            | WillowTree -> [ position x y; position x (y + 1) ]
            | ShrubPatch
            | FlowerBush
            | ReedCluster
            | StoneBench
            | RiverLantern -> [ position x y ])
        |> many

    let private positiveModulo divisor value =
        let remainder = value % divisor
        if remainder < 0 then remainder + divisor else remainder

    let npcVisualVariant (NpcId npcId) : NpcVisualVariant =
        match positiveModulo 4 npcId with
        | 0 -> IndigoRobe
        | 1 -> OchreVest
        | 2 -> JadeSash
        | _ -> GreyCap

    let private positiveModulo64 divisor value =
        let remainder = value % divisor
        if remainder < 0L then remainder + divisor else remainder

    let animationFrame (tick: int64) : AnimationFrame =
        if positiveModulo64 8L tick < 4L then FrameOne else FrameTwo

    /// Water surface ripple phase: flips every 32 simulation ticks, fully deterministic.
    let waterFrameTick (tick: int64) : int =
        int (positiveModulo64 2L (tick / 32L))

    let directionFromVector (vector: Vec2) : FacingDirection =
        if abs vector.X < 0.001f && abs vector.Y < 0.001f then
            SouthFacing
        elif abs vector.X >= abs vector.Y then
            if vector.X >= 0.0f then EastFacing else WestFacing
        elif vector.Y >= 0.0f then
            SouthFacing
        else
            NorthFacing

    let facingAfterMovement (previousPosition: Vec2) (nextPosition: Vec2) (current: FacingDirection) : FacingDirection =
        let movement : Vec2 =
            { X = nextPosition.X - previousPosition.X
              Y = nextPosition.Y - previousPosition.Y }
        if abs movement.X < 0.001f && abs movement.Y < 0.001f then current else directionFromVector movement

    let npcSpriteSpec (npcId: NpcId) (direction: FacingDirection) (tick: int64) : NpcSpriteSpec =
        { Variant = npcVisualVariant npcId
          Direction = direction
          Frame = animationFrame tick }

    let npcSpriteSpecAtTarget (npcId: NpcId) (position: Vec2) (target: Vec2) (tick: int64) : NpcSpriteSpec =
        let direction =
            directionFromVector
                { X = target.X - position.X
                  Y = target.Y - position.Y }
        npcSpriteSpec npcId direction tick

    let characterSourceRectangle (spec: NpcSpriteSpec) : Microsoft.Xna.Framework.Rectangle =
        let variantIndex =
            match spec.Variant with
            | IndigoRobe -> 0
            | OchreVest -> 1
            | JadeSash -> 2
            | GreyCap -> 3
            | StrawHat -> 4
        let directionIndex =
            match spec.Direction with
            | NorthFacing -> 0
            | SouthFacing -> 1
            | WestFacing -> 2
            | EastFacing -> 3
        let frameIndex =
            match spec.Frame with
            | FrameOne -> 0
            | FrameTwo -> 1
        let cellIndex = (variantIndex * 4 + directionIndex) * 2 + frameIndex
        Microsoft.Xna.Framework.Rectangle(cellIndex * 32, 0, 32, 48)

    let private rgba (r: int) (g: int) (b: int) (a: int) : XnaColor = XnaColor(r, g, b, a)

    let avatarSpriteSpec (direction: FacingDirection) (tick: int64) : NpcSpriteSpec =
        { Variant = StrawHat
          Direction = direction
          Frame = animationFrame tick }

    let worldAtlasRelativePath = "Assets/jiangnan-world.png"
    let characterAtlasRelativePath = "Assets/jiangnan-characters.png"
    let interiorAtlasRelativePath = "Assets/jiangnan-interior.png"

    let worldTileCount = 21
    let worldAtlasWidth = Sim.tilePixels * worldTileCount
    let worldAtlasHeight = Sim.tilePixels
    let characterAtlasWidth = 32 * 5 * 4 * 2
    let characterAtlasHeight = 48
    let interiorAtlasWidth = 392
    let interiorAtlasHeight = 96

    let private loadTexture (device: GraphicsDevice) (relativePath: string) (expectedWidth: int) (expectedHeight: int) : Texture2D =
        let fullPath = System.IO.Path.Combine(System.AppContext.BaseDirectory, relativePath)
        if not (System.IO.File.Exists fullPath) then
            raise (System.IO.FileNotFoundException(sprintf "Jiangnan art atlas is missing: %s" fullPath, fullPath))

        use stream = System.IO.File.OpenRead fullPath
        let texture = Texture2D.FromStream(device, stream)
        if texture.Width <> expectedWidth || texture.Height <> expectedHeight then
            texture.Dispose()
            invalidOp (sprintf "Jiangnan art atlas %s has dimensions %dx%d; expected %dx%d." fullPath texture.Width texture.Height expectedWidth expectedHeight)
        else
            texture

    let loadTextures (device: GraphicsDevice) : ArtTextures =
        { TileAtlas = loadTexture device worldAtlasRelativePath worldAtlasWidth worldAtlasHeight
          CharacterAtlas = loadTexture device characterAtlasRelativePath characterAtlasWidth characterAtlasHeight
          InteriorAtlas = loadTexture device interiorAtlasRelativePath interiorAtlasWidth interiorAtlasHeight }

    let atlasTileRectangle (index: int) : Microsoft.Xna.Framework.Rectangle =
        XnaRectangle(index * Sim.tilePixels, 0, Sim.tilePixels, Sim.tilePixels)

    let private tileSourceRectangle sprite : XnaRectangle =
        let index =
            match sprite with
            | GrassSprite -> 0
            | WaterSprite -> 1
            | StonePathSprite -> 2
            | RoofSprite -> 3
            | WallSprite -> 4
            | BridgeSprite -> 5
            | BambooSprite -> 6
            | GardenSprite -> 7
            | RoofRidgeSprite -> 8
            | RoofEaveSprite -> 9
            | WallWoodSprite -> 10
            | WallWindowSprite -> 11
            | DoorSprite -> 12
            | WaterSpriteB -> 13
            | WillowTopSprite -> 14
            | WillowBaseSprite -> 15
            | ShrubSprite -> 16
            | FlowerSprite -> 17
            | ReedSprite -> 18
            | BenchSprite -> 19
            | LanternSprite -> 20
        XnaRectangle(index * Sim.tilePixels, 0, Sim.tilePixels, Sim.tilePixels)

    let private tilePosition x y : TilePosition =
        { X = x
          Y = y }

    let private isVisible (camera: XnaVector2) (viewportWidth: int) (viewportHeight: int) (position: TilePosition) =
        let screenX = position.X * Sim.tilePixels - int camera.X
        let screenY = position.Y * Sim.tilePixels - int camera.Y
        screenX < viewportWidth
        && screenX + Sim.tilePixels > 0
        && screenY < viewportHeight
        && screenY + Sim.tilePixels > 0

    let private drawTile (spriteBatch: SpriteBatch) (atlas: Texture2D) (camera: XnaVector2) (position: TilePosition) sprite tint =
        let destination =
            XnaRectangle(
                position.X * Sim.tilePixels - int camera.X,
                position.Y * Sim.tilePixels - int camera.Y,
                Sim.tilePixels,
                Sim.tilePixels)
        spriteBatch.Draw(atlas, destination, tileSourceRectangle sprite, tint)

    let private drawWorldTile (spriteBatch: SpriteBatch) (textures: ArtTextures) (camera: XnaVector2) (viewportWidth: int) (viewportHeight: int) position sprite tint =
        if isVisible camera viewportWidth viewportHeight position then
            drawTile spriteBatch textures.TileAtlas camera position sprite tint

    let private offsetTile (position: TilePosition) dx dy : TilePosition =
        tilePosition (position.X + dx) (position.Y + dy)

    let drawWorld
        (spriteBatch: SpriteBatch)
        (textures: ArtTextures)
        (camera: XnaVector2)
        (viewportWidth: int)
        (viewportHeight: int)
        (plan: JiangnanRenderPlan)
        (tick: int64)
        (tint: XnaColor) =
        let draw position sprite =
            drawWorldTile spriteBatch textures camera viewportWidth viewportHeight position sprite tint
        let rippleFrame = waterFrameTick tick

        let tx0 = max 0 (int camera.X / Sim.tilePixels)
        let ty0 = max 0 (int camera.Y / Sim.tilePixels)
        let tx1 = min (Sim.mapWidthTiles - 1) ((int camera.X + viewportWidth) / Sim.tilePixels + 1)
        let ty1 = min (Sim.mapHeightTiles - 1) ((int camera.Y + viewportHeight) / Sim.tilePixels + 1)
        for y in ty0 .. ty1 do
            for x in tx0 .. tx1 do
                draw (tilePosition x y) GrassSprite

        for localPosition, kind in plan.Grounds do
            let position = worldTile plan localPosition
            let sprite =
                match kind with
                | Water -> if rippleFrame = 0 then WaterSprite else WaterSpriteB
                | StonePath -> StonePathSprite
            draw position sprite

        let drawHouse doorTile =
            let position = worldTile plan doorTile
            for dx in -2 .. 1 do
                draw (offsetTile position dx -2) RoofRidgeSprite
                draw (offsetTile position dx -1) RoofEaveSprite
            draw (offsetTile position -2 0) WallWoodSprite
            draw (offsetTile position -1 0) WallWindowSprite
            draw (offsetTile position 0 0) DoorSprite
            draw (offsetTile position 1 0) WallWoodSprite

        let drawBridge localPosition =
            let position = worldTile plan localPosition
            draw position BridgeSprite
            draw (offsetTile position 0 1) BridgeSprite
            draw (offsetTile position 0 2) BridgeSprite

        let drawBamboo localPosition =
            let position = worldTile plan localPosition
            draw position BambooSprite
            draw (offsetTile position 0 1) BambooSprite
            draw (offsetTile position 1 0) BambooSprite

        let drawGarden localPosition =
            let position = worldTile plan localPosition
            draw position GardenSprite
            draw (offsetTile position 1 0) GardenSprite

        let drawWillow localPosition =
            let position = worldTile plan localPosition
            draw position WillowTopSprite
            draw (offsetTile position 0 1) WillowBaseSprite

        let drawSingleTile localPosition sprite =
            draw (worldTile plan localPosition) sprite

        for prop in plan.Props do
            match prop.Kind with
            | House -> drawHouse prop.Position
            | Bridge -> drawBridge prop.Position
            | BambooGrove -> drawBamboo prop.Position
            | VegetablePatch -> drawGarden prop.Position
            | WillowTree -> drawWillow prop.Position
            | ShrubPatch -> drawSingleTile prop.Position ShrubSprite
            | FlowerBush -> drawSingleTile prop.Position FlowerSprite
            | ReedCluster -> drawSingleTile prop.Position ReedSprite
            | StoneBench -> drawSingleTile prop.Position BenchSprite
            | RiverLantern -> drawSingleTile prop.Position LanternSprite

    let drawCharacter
        (spriteBatch: SpriteBatch)
        (textures: ArtTextures)
        (camera: XnaVector2)
        (position: Vec2)
        (spec: NpcSpriteSpec)
        (tint: XnaColor) =
        let destination =
            XnaRectangle(
                int position.X - int camera.X - 16,
                int position.Y - int camera.Y - 48,
                32,
                48)
        spriteBatch.Draw(textures.CharacterAtlas, destination, characterSourceRectangle spec, tint)

    type InteriorLayout =
        { RoomX: int
          RoomY: int
          RoomWidth: int
          RoomHeight: int }

    let private interiorWallBandHeight = 64

    let private floorCellSource = XnaRectangle(0, 64, Sim.tilePixels, Sim.tilePixels)
    let private wallCellSource = XnaRectangle(32, 64, Sim.tilePixels, Sim.tilePixels)
    let private rugSource = XnaRectangle(256, 32, 96, 64)
    let private chestSource = XnaRectangle(352, 60, 40, 36)

    let interiorSourceRectangle (kind: InteriorElementKind) : Microsoft.Xna.Framework.Rectangle =
        match kind with
        | Window -> XnaRectangle(64, 56, 48, 40)
        | Table -> XnaRectangle(112, 48, 64, 48)
        | Bed -> XnaRectangle(176, 0, 48, 96)
        | Screen -> XnaRectangle(224, 0, 32, 96)

    let interiorLayout (viewportWidth: int) (viewportHeight: int) : InteriorLayout =
        { RoomX = 40
          RoomY = 40
          RoomWidth = max 320 (viewportWidth - 80)
          RoomHeight = max 240 (viewportHeight - 80) }

    let interiorColumns (layout: InteriorLayout) : int =
        max 1 (layout.RoomWidth / Sim.tilePixels)

    let interiorRows (layout: InteriorLayout) : int =
        max 1 ((layout.RoomHeight - interiorWallBandHeight) / Sim.tilePixels)

    let interiorFloorY (layout: InteriorLayout) : int =
        layout.RoomY + interiorWallBandHeight

    let private clampInt (minimum: int) (maximum: int) (value: int) : int =
        if value < minimum then minimum
        elif value > maximum then maximum
        else value

    let interiorCharacterScreenPosition (layout: InteriorLayout) (worldPosition: Vec2) : PixelPosition =
        let sceneTile = sceneTileFromPixel { PixelPosition.X = worldPosition.X; Y = worldPosition.Y }
        let tileX = clampInt 1 (interiorColumns layout - 2) sceneTile.X
        let tileY = clampInt 1 (interiorRows layout - 2) sceneTile.Y
        let floorY = interiorFloorY layout
        { PixelPosition.X = float32 (layout.RoomX + tileX * Sim.tilePixels + Sim.tilePixels / 2)
          Y = float32 (floorY + (tileY + 1) * Sim.tilePixels) }

    let drawInterior
        (spriteBatch: SpriteBatch)
        (pixel: Texture2D)
        (textures: ArtTextures)
        (viewportWidth: int)
        (viewportHeight: int)
        (plan: InteriorPlan)
        (tint: XnaColor) =
        let layout = interiorLayout viewportWidth viewportHeight
        let floorY = interiorFloorY layout
        let columns = interiorColumns layout
        let rows = interiorRows layout
        let partialRows = (layout.RoomHeight - interiorWallBandHeight) % Sim.tilePixels
        let totalRows = 2 + rows + (if partialRows > 0 then 1 else 0)

        spriteBatch.Draw(pixel, XnaRectangle(0, 0, viewportWidth, viewportHeight), rgba 18 25 42 255)

        let drawCell (source: XnaRectangle) (screenX: int) (screenY: int) =
            let width = min Sim.tilePixels (layout.RoomX + layout.RoomWidth - screenX)
            let height = min Sim.tilePixels (layout.RoomY + layout.RoomHeight - screenY)
            if width > 0 && height > 0 then
                spriteBatch.Draw(textures.InteriorAtlas, XnaRectangle(screenX, screenY, width, height), source, tint)

        for row in 0 .. totalRows - 1 do
            for column in 0 .. columns - 1 do
                let screenX = layout.RoomX + column * Sim.tilePixels
                let screenY = layout.RoomY + row * Sim.tilePixels
                let source = if row < 2 then wallCellSource else floorCellSource
                drawCell source screenX screenY

        let rugX = layout.RoomX + (layout.RoomWidth - 96) / 2
        let rugY = floorY + 96
        spriteBatch.Draw(textures.InteriorAtlas, XnaRectangle(rugX, rugY, 96, 64), rugSource, tint)

        let elementDestination (element: InteriorElement) : XnaRectangle =
            let baseY = floorY + (element.Position.Y + 1) * Sim.tilePixels
            match element.Kind with
            | Window ->
                XnaRectangle(layout.RoomX + element.Position.X * Sim.tilePixels - 8, layout.RoomY + 24, 48, 40)
            | Table ->
                XnaRectangle(layout.RoomX + element.Position.X * Sim.tilePixels - 16, baseY - 48, 64, 48)
            | Bed ->
                XnaRectangle(layout.RoomX + element.Position.X * Sim.tilePixels - 8, baseY - 96, 48, 96)
            | Screen ->
                XnaRectangle(layout.RoomX + element.Position.X * Sim.tilePixels, baseY - 96, 32, 96)

        for element in plan.Elements |> List.sortBy (fun element -> element.Position.Y, element.Position.X) do
            spriteBatch.Draw(textures.InteriorAtlas, elementDestination element, interiorSourceRectangle element.Kind, tint)

        let chestX = layout.RoomX + layout.RoomWidth - 44
        let chestY = layout.RoomY + layout.RoomHeight - 36
        spriteBatch.Draw(textures.InteriorAtlas, XnaRectangle(chestX, chestY, 40, 36), chestSource, tint)

    let drawInteriorCharacter
        (spriteBatch: SpriteBatch)
        (textures: ArtTextures)
        (viewportWidth: int)
        (viewportHeight: int)
        (position: Vec2)
        (spec: NpcSpriteSpec)
        (tint: XnaColor) =
        let layout = interiorLayout viewportWidth viewportHeight
        let screenPosition = interiorCharacterScreenPosition layout position
        let destination = XnaRectangle(int screenPosition.X - 16, int screenPosition.Y - 48, 32, 48)
        spriteBatch.Draw(textures.CharacterAtlas, destination, characterSourceRectangle spec, tint)