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)