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

namespace LivingVillage.Desktop

open System
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
        | StoneLantern
        | WaterVat
        | MarketStall

    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

    /// Presentation-only occupational archetype. Kernel NPCs carry no occupation, so the
    /// visible trade is a pure function of NpcId; three walking rhythms coexist on screen.
    type NpcTrade =
        | Farmer
        | Peddler
        | Scholar

    /// Per-trade cadence in simulation ticks plus a phase offset, all deterministic.
    type WalkRhythm =
        { WalkWindow: int64
          IdleWindow: int64
          PhaseOffset: int64 }

    type FacingDirection =
        | NorthFacing
        | SouthFacing
        | WestFacing
        | EastFacing

    type AnimationFrame =
        | FrameOne
        | FrameTwo
        | FrameThree
        | FrameFour

    /// Two-pose standing breath cycle used whenever a character is not moving.
    type IdleFrame =
        | IdleOne
        | IdleTwo

    /// A character either walks (four-pose cycle) or breathes in place (two-pose cycle).
    type CharacterFrame =
        | WalkFrame of AnimationFrame
        | IdleFrame of IdleFrame

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

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

    type private TileSprite =
        | GrassSprite
        | WaterSprite
        | StonePathSprite
        | RoofSprite
        | WallSprite
        | BridgeSprite
        | BambooSprite
        | GardenSprite
        | RoofRidgeSprite
        | RoofEaveSprite
        | WallWoodSprite
        | WallWindowSprite
        | DoorSprite
        | WaterSpriteB
        | WillowTopSprite
        | WillowBaseSprite
        | ShrubSprite
        | FlowerSprite
        | ReedSprite
        | BenchSprite
        | LanternSprite
        | WaterSpriteC
        | SmokeSpriteA
        | SmokeSpriteB
        | SmokeSpriteC
        | StoneLanternSprite
        | WaterVatSprite
        | StallSprite

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

    /// CC0 pack ground tiles: 0 grass bright / 1 grass deep (checker) / 2 path / 3 dirt.
    let private cc0GroundRect (position: TilePosition) : XnaRectangle =
        let index = if (position.X + position.Y) % 2 = 1 then 1 else 0
        XnaRectangle(index * Sim.tilePixels, 0, Sim.tilePixels, Sim.tilePixels)

    let private cc0PathRect : XnaRectangle = XnaRectangle(2 * Sim.tilePixels, 0, Sim.tilePixels, Sim.tilePixels)

    let private drawCc0Tile (spriteBatch: SpriteBatch) (cc0: Texture2D) (tint: XnaColor) (source: XnaRectangle) (screenX: int) (screenY: int) =
        spriteBatch.Draw(cc0, XnaRectangle(screenX, screenY, Sim.tilePixels, Sim.tilePixels), Nullable(source), tint)
    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
                renderProp StoneLantern 4 14
                renderProp StoneLantern 16 14
                renderProp WaterVat 12 11
                renderProp MarketStall 3 11 ]
          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
            | StoneLantern
            | WaterVat
            | MarketStall -> [ 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

    /// Trade cycle: NPCs repeat Farmer -> Peddler -> Scholar by id, so all three rhythms
    /// are present without touching kernel state.
    let npcTrade (NpcId npcId) : NpcTrade =
        match positiveModulo 3 npcId with
        | 0 -> Farmer
        | 1 -> Peddler
        | _ -> Scholar

    /// Farmer ambles at the original cadence; Peddler shuffles faster; Scholar strolls slower.
    let rhythmFor (trade: NpcTrade) : WalkRhythm =
        match trade with
        | Farmer -> { WalkWindow = 4L; IdleWindow = 24L; PhaseOffset = 0L }
        | Peddler -> { WalkWindow = 3L; IdleWindow = 20L; PhaseOffset = 1L }
        | Scholar -> { WalkWindow = 6L; IdleWindow = 36L; PhaseOffset = 2L }

    /// Four-pose walk cycle at a rhythm's window (one pose per WalkWindow sim ticks).
    let animationFrameFor (rhythm: WalkRhythm) (tick: int64) : AnimationFrame =
        match positiveModulo64 4L (tick / rhythm.WalkWindow + rhythm.PhaseOffset) with
        | 0L -> FrameOne
        | 1L -> FrameTwo
        | 2L -> FrameThree
        | _ -> FrameFour

    /// Two-pose standing breath cycle at a rhythm's IdleWindow, fully deterministic.
    let idleFrameFor (rhythm: WalkRhythm) (tick: int64) : IdleFrame =
        match positiveModulo64 2L (tick / rhythm.IdleWindow + rhythm.PhaseOffset) with
        | 0L -> IdleOne
        | _ -> IdleTwo

    /// Picks the walk cycle while moving and the breath cycle while standing still.
    let characterFrameFor (rhythm: WalkRhythm) (isMoving: bool) (tick: int64) : CharacterFrame =
        if isMoving then WalkFrame(animationFrameFor rhythm tick) else IdleFrame(idleFrameFor rhythm tick)

    /// Farmer cadence is the base cadence (window 4/24, phase 0), preserving older semantics.
    let animationFrame (tick: int64) : AnimationFrame =
        animationFrameFor (rhythmFor Farmer) tick

    let idleFrame (tick: int64) : IdleFrame =
        idleFrameFor (rhythmFor Farmer) tick

    let characterFrame (isMoving: bool) (tick: int64) : CharacterFrame =
        characterFrameFor (rhythmFor Farmer) isMoving tick

    /// Water surface ripple phase: three frames, one per 32 simulation ticks, fully deterministic.
    let waterFrameTick (tick: int64) : int =
        int (positiveModulo64 3L (tick / 32L))

    /// Chimney smoke puff phase: three frames, one per 40 simulation ticks, fully deterministic.
    let smokeFrameTick (tick: int64) : int =
        int (positiveModulo64 3L (tick / 40L))

    /// Per-tile water ripple phase. The global 32-tick cycle is offset by world tile
    /// coordinates, so neighbouring river tiles show different phases in the same frame
    /// instead of the whole surface switching in lockstep.
    let waterFrameTickAt (tick: int64) (tileX: int) (tileY: int) : int =
        int (positiveModulo64 3L (tick / 32L + int64 (tileX + 2 * tileY)))

    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) (isMoving: bool) (tick: int64) : NpcSpriteSpec =
        { Variant = npcVisualVariant npcId
          Direction = direction
          Frame = characterFrameFor (rhythmFor (npcTrade npcId)) isMoving tick }

    /// Villagers breathe while standing at their target and walk while approaching it.
    let npcSpriteSpecAtTarget (npcId: NpcId) (position: Vec2) (target: Vec2) (tick: int64) : NpcSpriteSpec =
        let movement : Vec2 =
            { X = target.X - position.X
              Y = target.Y - position.Y }
        let isMoving = abs movement.X >= 0.5f || abs movement.Y >= 0.5f
        npcSpriteSpec npcId (directionFromVector movement) isMoving 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
            | WalkFrame FrameOne -> 0
            | WalkFrame FrameTwo -> 1
            | WalkFrame FrameThree -> 2
            | WalkFrame FrameFour -> 3
            | IdleFrame IdleOne -> 4
            | IdleFrame IdleTwo -> 5
        let cellIndex = (variantIndex * 4 + directionIndex) * 6 + 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)

    /// MonoGame's default SpriteBatch blend (BlendState.AlphaBlend) treats the sprite
    /// format as premultiplied alpha: the source colour blend is `One`, so a straight
    /// Color(r,g,b,a) adds its raw rgb to the framebuffer and layered glows saturate to
    /// an opaque white block. Scale every channel by its own alpha before drawing.
    let premultiply (r: int) (g: int) (b: int) (a: int) : Microsoft.Xna.Framework.Color =
        let clampChannel (channel: int) = max 0 (min 255 channel)
        let alpha = clampChannel a
        let scale (channel: int) =
            Math.Round(float (clampChannel channel) * float alpha / 255.0, MidpointRounding.AwayFromZero)
            |> int
        Microsoft.Xna.Framework.Color(scale r, scale g, scale b, alpha)

    /// Horizontal pixel runs approximating a filled ellipse; used for soft contact shadows.
    let ellipseRuns (centerX: int) (centerY: int) (radiusX: int) (radiusY: int) : (int * int * int) list =
        if radiusX <= 0 || radiusY <= 0 then
            []
        else
            [ for dy in -radiusY .. radiusY do
                  let t = float dy / float radiusY
                  let half = int (Math.Round(float radiusX * Math.Sqrt(max 0.0 (1.0 - t * t))))
                  if half > 0 then
                      yield (centerX - half, centerY + dy, half * 2 + 1) ]

    /// Soft radial lantern glow drawn as concentric filled circles. Every ring carries a
    /// low, premultiplied warm alpha so the rings sum to `peakAlpha` at the core and thin
    /// out toward the rim; because each ring's rgb is premultiplied, the core can never
    /// saturate to an opaque white block the way straight rgba layers did.
    let lanternGlowLayers
        (centerX: int)
        (centerY: int)
        (radius: int)
        (rings: int)
        (red: int)
        (green: int)
        (blue: int)
        (peakAlpha: int) : (Microsoft.Xna.Framework.Rectangle * Microsoft.Xna.Framework.Color) list =
        if radius <= 0 || rings <= 0 || peakAlpha <= 0 then
            []
        else
            let perRing = max 1 (peakAlpha / rings)
            let glowColor = premultiply red green blue perRing
            [ for ring in 0 .. rings - 1 do
                  let ringRadius = max 1 (radius * (rings - ring) / rings)
                  for (x, y, width) in ellipseRuns centerX centerY ringRadius ringRadius do
                      yield (Microsoft.Xna.Framework.Rectangle(x, y, width, 1), glowColor) ]

    /// Characters spawn at tile centres; push the sprite down half a tile so its feet rest
    /// on the tile's ground line instead of floating at the centre.
    let characterFeetOffset = Sim.tilePixels / 2

    /// Premultiplied translucent shadow colour used beneath characters.
    let shadowColor : Microsoft.Xna.Framework.Color = premultiply 12 16 22 96

    let characterDestination (position: Vec2) (camera: Microsoft.Xna.Framework.Vector2) : Microsoft.Xna.Framework.Rectangle =
        Microsoft.Xna.Framework.Rectangle(
            int position.X - int camera.X - 16,
            int position.Y - int camera.Y - 48 + characterFeetOffset,
            32,
            48)

    let drawGroundShadow
        (spriteBatch: SpriteBatch)
        (pixel: Texture2D)
        (camera: Microsoft.Xna.Framework.Vector2)
        (position: Vec2) =
        let centerX = int position.X - int camera.X
        let centerY = int position.Y - int camera.Y + characterFeetOffset - 2
        for (x, y, width) in ellipseRuns centerX centerY 13 5 do
            spriteBatch.Draw(pixel, Microsoft.Xna.Framework.Rectangle(x, y, width, 1), shadowColor)

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

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

    let worldTileCount = 28
    let worldAtlasWidth = Sim.tilePixels * worldTileCount
    let worldAtlasHeight = Sim.tilePixels
    let characterAtlasWidth = 32 * 5 * 4 * 6
    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 useCc0Pack () : bool =
        System.Environment.GetEnvironmentVariable("LV_ASSET_PACK") = "cc0"

    let cc0TileAtlasRelativePath = "Assets/cc0-tiles.png"
    let cc0TileAtlasWidth = Sim.tilePixels * 4
    let cc0CharacterAtlasRelativePath = "Assets/cc0-characters.png"

    let loadTextures (device: GraphicsDevice) : ArtTextures =
        let cc0 =
            if useCc0Pack () then
                Some(loadTexture device cc0TileAtlasRelativePath cc0TileAtlasWidth Sim.tilePixels)
            else
                None
        let characterPath = if useCc0Pack () then cc0CharacterAtlasRelativePath else characterAtlasRelativePath
        { TileAtlas = loadTexture device worldAtlasRelativePath worldAtlasWidth worldAtlasHeight
          CharacterAtlas = loadTexture device characterPath characterAtlasWidth characterAtlasHeight
          InteriorAtlas = loadTexture device interiorAtlasRelativePath interiorAtlasWidth interiorAtlasHeight
          Cc0TileAtlas = cc0 }

    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
            | WaterSpriteC -> 21
            | SmokeSpriteA -> 22
            | SmokeSpriteB -> 23
            | SmokeSpriteC -> 24
            | StoneLanternSprite -> 25
            | WaterVatSprite -> 26
            | StallSprite -> 27
        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

        // Each water tile picks its phase from its own world coordinates, so a single
        // frame shows the three ripple phases across the river instead of one global frame.
        let waterSpriteAt (position: TilePosition) =
            match waterFrameTickAt tick position.X position.Y with
            | 0 -> WaterSprite
            | 1 -> WaterSpriteB
            | _ -> WaterSpriteC

        // Procedural terrain for the 512x384 large world: water/pebble/peat codes map
        // onto the jiangnan atlas sprites with deterministic ripple continuity.
        let drawTerrainTile (position: TilePosition) (code: int) =
            match code with
            | 1 -> draw position (waterSpriteAt position)
            | 2 -> draw position StonePathSprite
            | 3 -> draw position StonePathSprite
            | _ -> draw position GrassSprite

        let drawBaseTile (position: TilePosition) =
            match ProceduralMap.terrainOption, ProceduralMap.bigWorldActive with
            | (Some terrain, true) ->
                let tx, ty = position.X, position.Y
                let code = terrain.Tiles.[ty * ProceduralMap.width + tx]
                drawTerrainTile position code
            | _ ->
                match textures.Cc0TileAtlas with
                | Some cc0 -> drawCc0Tile spriteBatch cc0 tint (cc0GroundRect position) (position.X * Sim.tilePixels - int camera.X) (position.Y * Sim.tilePixels - int camera.Y)
                | None -> draw position GrassSprite
            match textures.Cc0TileAtlas with
            | Some cc0 -> drawCc0Tile spriteBatch cc0 tint (cc0GroundRect position) (position.X * Sim.tilePixels - int camera.X) (position.Y * Sim.tilePixels - int camera.Y)
            | None -> draw position GrassSprite

        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
                drawBaseTile (tilePosition x y)

        for localPosition, kind in plan.Grounds do
            let position = worldTile plan localPosition
            match kind with
            | Water -> draw position (waterSpriteAt position)
            | StonePath ->
                match textures.Cc0TileAtlas with
                | Some cc0 -> drawCc0Tile spriteBatch cc0 tint cc0PathRect (position.X * Sim.tilePixels - int camera.X) (position.Y * Sim.tilePixels - int camera.Y)
                | None -> draw position StonePathSprite

        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
            | StoneLantern -> drawSingleTile prop.Position StoneLanternSprite
            | WaterVat -> drawSingleTile prop.Position WaterVatSprite
            | MarketStall -> drawSingleTile prop.Position StallSprite

        // Chimney smoke is a late pass so it always reads above the roof, the bamboo and
        // any other prop sharing its tile. The puff sits one row above the ridge centre
        // (offset 0,-3) and cycles through three frames driven by smokeFrameTick.
        let smokeSprite =
            match smokeFrameTick tick with
            | 0 -> SmokeSpriteA
            | 1 -> SmokeSpriteB
            | _ -> SmokeSpriteC
        for prop in plan.Props do
            match prop.Kind with
            | House -> draw (offsetTile (worldTile plan prop.Position) 0 -3) smokeSprite
            | _ -> ()

    let drawCharacter
        (spriteBatch: SpriteBatch)
        (textures: ArtTextures)
        (camera: XnaVector2)
        (position: Vec2)
        (spec: NpcSpriteSpec)
        (tint: XnaColor) =
        let destination = characterDestination position camera
        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)