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

    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

    type FacingDirection =
        | NorthFacing
        | SouthFacing
        | WestFacing
        | EastFacing

    type AnimationFrame =
        | FrameOne
        | FrameTwo

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

    type ArtTextures =
        { TileAtlas: Texture2D
          CharacterAtlas: Texture2D }

    type private TileSprite =
        | GrassSprite
        | WaterSprite
        | StonePathSprite
        | RoofSprite
        | WallSprite
        | BridgeSprite
        | BambooSprite
        | GardenSprite

    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 Water 10 2
                ground Water 10 3
                ground Water 10 4
                ground Water 10 5
                ground Water 10 6
                ground Water 10 7
                ground Water 11 4
                ground Water 11 5
                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 ]
          Props =
              [ renderProp House 6 4
                renderProp Bridge 10 5
                renderProp BambooGrove 3 2
                renderProp VegetablePatch 8 7 ]
          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 }

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

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

    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

    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
        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 setPixel (pixels: XnaColor[]) (width: int) (x: int) (y: int) (color: XnaColor) =
        let height = pixels.Length / width
        if x >= 0 && x < width && y >= 0 && y < height then
            pixels.[y * width + x] <- color

    let private fillRect (pixels: XnaColor[]) (width: int) (x: int) (y: int) (rectWidth: int) (rectHeight: int) (color: XnaColor) =
        for row in y .. y + rectHeight - 1 do
            for column in x .. x + rectWidth - 1 do
                setPixel pixels width column row color

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

    let private buildTileAtlas (device: GraphicsDevice) : Texture2D =
        let atlasWidth = Sim.tilePixels * 8
        let atlasHeight = Sim.tilePixels
        let pixels = Array.create (atlasWidth * atlasHeight) (rgba 0 0 0 0)
        let fillSlot slot color = fillRect pixels atlasWidth (slot * Sim.tilePixels) 0 Sim.tilePixels Sim.tilePixels color
        let setSlotPixel slot x y color = setPixel pixels atlasWidth (slot * Sim.tilePixels + x) y color
        let grass = rgba 66 112 70 255
        let grassLight = rgba 92 139 82 255
        let water = rgba 54 116 145 255
        let waterLight = rgba 105 174 184 255
        let path = rgba 170 153 123 255
        let pathLight = rgba 201 183 145 255
        let roof = rgba 45 49 57 255
        let roofLight = rgba 76 80 85 255
        let wall = rgba 225 216 195 255
        let wallShadow = rgba 166 147 119 255
        let wood = rgba 119 76 47 255
        let woodLight = rgba 164 111 61 255
        let bamboo = rgba 51 101 61 255
        let bambooLight = rgba 107 153 81 255
        let soil = rgba 122 78 49 255
        let sprout = rgba 86 139 68 255

        fillSlot 0 grass
        for y in 0 .. Sim.tilePixels - 1 do
            for x in 0 .. Sim.tilePixels - 1 do
                if (x * 13 + y * 7) % 29 = 0 then
                    setSlotPixel 0 x y grassLight

        fillSlot 1 water
        for y in [ 5; 16; 27 ] do
            for x in 3 .. Sim.tilePixels - 4 do
                if (x + y) % 5 <> 0 then
                    setSlotPixel 1 x y waterLight
        for x in [ 8; 23 ] do
            fillRect pixels atlasWidth (x + Sim.tilePixels) 2 2 26 (rgba 44 93 124 255)

        fillSlot 2 path
        for y in [ 0; 31 ] do
            for x in 0 .. Sim.tilePixels - 1 do
                setSlotPixel 2 x y pathLight
        for x in [ 7; 24 ] do
            for y in 4 .. 27 do
                if y % 3 <> 0 then
                    setSlotPixel 2 x y pathLight

        fillSlot 3 roof
        for y in [ 5; 13; 21; 29 ] do
            for x in 0 .. Sim.tilePixels - 1 do
                if (x + y) % 6 < 5 then
                    setSlotPixel 3 x y roofLight

        fillSlot 4 wall
        fillRect pixels atlasWidth (4 * Sim.tilePixels) 0 2 Sim.tilePixels wallShadow
        fillRect pixels atlasWidth (4 * Sim.tilePixels + 15) 0 2 Sim.tilePixels wallShadow
        fillRect pixels atlasWidth (4 * Sim.tilePixels + 30) 0 2 Sim.tilePixels wallShadow
        fillRect pixels atlasWidth (4 * Sim.tilePixels) 27 Sim.tilePixels 3 wallShadow

        fillSlot 5 wood
        for y in [ 6; 15; 24 ] do
            fillRect pixels atlasWidth (5 * Sim.tilePixels) y Sim.tilePixels 2 woodLight

        fillSlot 6 (rgba 0 0 0 0)
        for stemX in [ 6; 16; 26 ] do
            fillRect pixels atlasWidth (6 * Sim.tilePixels + stemX) 4 3 25 bamboo
            for leafY in [ 8; 17; 25 ] do
                fillRect pixels atlasWidth (6 * Sim.tilePixels + stemX - 4) leafY 5 2 bambooLight
                fillRect pixels atlasWidth (6 * Sim.tilePixels + stemX + 2) (leafY + 2) 5 2 bambooLight

        fillSlot 7 (rgba 0 0 0 0)
        for row in [ 6; 15; 24 ] do
            fillRect pixels atlasWidth (7 * Sim.tilePixels + 2) row 28 3 soil
            for sproutX in [ 6; 15; 24 ] do
                fillRect pixels atlasWidth (7 * Sim.tilePixels + sproutX) (row - 3) 2 3 sprout

        let texture = new Texture2D(device, atlasWidth, atlasHeight, false, SurfaceFormat.Color)
        texture.SetData pixels
        texture

    let private buildCharacterAtlas (device: GraphicsDevice) : Texture2D =
        let cellWidth = 32
        let cellHeight = 48
        let columns = 3 * 4 * 2
        let atlasWidth = columns * cellWidth
        let pixels = Array.create (atlasWidth * cellHeight) (rgba 0 0 0 0)
        let variants = [| IndigoRobe; OchreVest; JadeSash |]
        let directions = [| NorthFacing; SouthFacing; WestFacing; EastFacing |]
        let frames = [| FrameOne; FrameTwo |]

        for variantIndex in 0 .. variants.Length - 1 do
            for directionIndex in 0 .. directions.Length - 1 do
                for frameIndex in 0 .. frames.Length - 1 do
                    let variant = variants.[variantIndex]
                    let direction = directions.[directionIndex]
                    let frame = frames.[frameIndex]
                    let spec = { Variant = variant; Direction = direction; Frame = frame }
                    let source = characterSourceRectangle spec
                    let offsetX = source.X
                    let robe, sash =
                        match variant with
                        | IndigoRobe -> rgba 46 57 108 255, rgba 104 145 183 255
                        | OchreVest -> rgba 141 91 45 255, rgba 205 163 76 255
                        | JadeSash -> rgba 46 113 91 255, rgba 121 185 139 255
                    let skin = rgba 232 180 139 255
                    let hair = rgba 42 36 37 255
                    let shadow = rgba 23 31 34 120
                    let legShift = if frame = FrameOne then 0 else 2
                    fillRect pixels atlasWidth (offsetX + 7) 42 18 3 shadow
                    fillRect pixels atlasWidth (offsetX + 8 + legShift) 35 6 10 robe
                    fillRect pixels atlasWidth (offsetX + 18 - legShift) 35 6 10 robe
                    fillRect pixels atlasWidth (offsetX + 7) 22 18 16 robe
                    fillRect pixels atlasWidth (offsetX + 9) 32 14 4 sash
                    fillRect pixels atlasWidth (offsetX + 10) 12 12 10 skin
                    fillRect pixels atlasWidth (offsetX + 7) 8 18 4 hair
                    fillRect pixels atlasWidth (offsetX + 5) 7 22 3 sash
                    match direction with
                    | NorthFacing ->
                        fillRect pixels atlasWidth (offsetX + 9) 13 14 8 hair
                    | SouthFacing ->
                        fillRect pixels atlasWidth (offsetX + 12) 17 2 2 hair
                        fillRect pixels atlasWidth (offsetX + 18) 17 2 2 hair
                    | WestFacing ->
                        fillRect pixels atlasWidth (offsetX + 9) 16 3 5 hair
                    | EastFacing ->
                        fillRect pixels atlasWidth (offsetX + 20) 16 3 5 hair

        let texture = new Texture2D(device, atlasWidth, cellHeight, false, SurfaceFormat.Color)
        texture.SetData pixels
        texture

    let buildTextures (device: GraphicsDevice) : ArtTextures =
        { TileAtlas = buildTileAtlas device
          CharacterAtlas = buildCharacterAtlas device }

    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
        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)
        (tint: XnaColor) =
        let draw position sprite =
            drawWorldTile spriteBatch textures camera viewportWidth viewportHeight position sprite tint

        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 -> WaterSprite
                | StonePath -> StonePathSprite
            draw position sprite

        let drawHouse localPosition =
            let position = worldTile plan localPosition
            for dx in -1 .. 1 do
                draw (offsetTile position dx 0) RoofSprite
                draw (offsetTile position dx 1) WallSprite
            draw (offsetTile position 0 1) BridgeSprite

        let drawBridge localPosition =
            let position = worldTile plan localPosition
            draw position BridgeSprite
            draw (offsetTile position 1 0) 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

        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

    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)

    let drawInterior (spriteBatch: SpriteBatch) (pixel: Texture2D) (viewportWidth: int) (viewportHeight: int) (plan: InteriorPlan) =
        let roomX = 40
        let roomY = 40
        let roomWidth = max 320 (viewportWidth - 80)
        let roomHeight = max 240 (viewportHeight - 80)
        spriteBatch.Draw(pixel, XnaRectangle(0, 0, viewportWidth, viewportHeight), rgba 18 25 42 255)
        spriteBatch.Draw(pixel, XnaRectangle(roomX, roomY, roomWidth, roomHeight), rgba 188 163 126 255)
        spriteBatch.Draw(pixel, XnaRectangle(roomX, roomY, roomWidth, 18), rgba 65 57 59 255)
        spriteBatch.Draw(pixel, XnaRectangle(roomX, roomY + roomHeight - 18, roomWidth, 18), rgba 99 70 50 255)

        for element in plan.Elements do
            let x = roomX + element.Position.X * Sim.tilePixels
            let y = roomY + element.Position.Y * Sim.tilePixels
            match element.Kind with
            | Window ->
                spriteBatch.Draw(pixel, XnaRectangle(x, y, 48, 30), rgba 86 143 170 255)
                spriteBatch.Draw(pixel, XnaRectangle(x + 22, y, 4, 30), rgba 225 216 195 255)
            | Table ->
                spriteBatch.Draw(pixel, XnaRectangle(x, y, 64, 32), rgba 119 76 47 255)
                spriteBatch.Draw(pixel, XnaRectangle(x + 8, y + 28, 8, 20), rgba 83 52 39 255)
                spriteBatch.Draw(pixel, XnaRectangle(x + 48, y + 28, 8, 20), rgba 83 52 39 255)
            | Bed ->
                spriteBatch.Draw(pixel, XnaRectangle(x, y, 48, 80), rgba 114 62 67 255)
                spriteBatch.Draw(pixel, XnaRectangle(x + 4, y + 4, 40, 24), rgba 224 211 185 255)
            | Screen ->
                spriteBatch.Draw(pixel, XnaRectangle(x, y, 16, 80), rgba 61 45 49 255)
                spriteBatch.Draw(pixel, XnaRectangle(x + 12, y + 4, 8, 72), rgba 142 102 72 255)