{-# OPTIONS_GHC -fplugin Foreign.Storable.Generic.Plugin #-}

module Render.Unlit.Sprite.Model
  ( InstanceAttrs(..)
  , StorableAttrs
  , InstanceBuffer
  , fromTexture
  , fromAtlas

  , animate_
  ) where

import RIO

import Engine.Vulkan.Format (HasVkFormat(..))
import Engine.Vulkan.Pipeline.Graphics (HasVertexInputBindings(..), instanceFormat)
import Foreign.Storable.Generic (GStorable)
import Geomancy (Vec2, Vec4, UVec2, vec2, vec4, withUVec2, withVec2)
import Geomancy.Vec4 qualified as Vec4
import Render.Samplers qualified as Samplers
import Resource.Buffer qualified as Buffer
import Resource.Image.Atlas (Atlas)
import Resource.Image.Atlas qualified as Atlas
import RIO.Vector.Storable qualified as Storable
import Vulkan.Core10 qualified as Vk
import Vulkan.NamedType ((:::))
import Vulkan.Zero (Zero(..))

data InstanceAttrs = InstanceAttrs
  { InstanceAttrs -> Vec4
vertRect :: Vec4
  , InstanceAttrs -> Vec4
fragRect :: Vec4

  , InstanceAttrs -> Vec4
tint    :: Vec4
  , InstanceAttrs -> Vec4
outline :: Vec4

  , InstanceAttrs -> Vec4
animation :: Vec4 -- direction xy, number of frames, speed

  , InstanceAttrs -> UVec2
textureSize :: UVec2
  , InstanceAttrs -> Int32
samplerId :: Int32
  , InstanceAttrs -> Int32
textureId :: Int32
  }
  deriving (("num.frames" ::: Int) -> InstanceAttrs -> ShowS
[InstanceAttrs] -> ShowS
InstanceAttrs -> String
forall a.
(("num.frames" ::: Int) -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InstanceAttrs] -> ShowS
$cshowList :: [InstanceAttrs] -> ShowS
show :: InstanceAttrs -> String
$cshow :: InstanceAttrs -> String
showsPrec :: ("num.frames" ::: Int) -> InstanceAttrs -> ShowS
$cshowsPrec :: ("num.frames" ::: Int) -> InstanceAttrs -> ShowS
Show, forall x. Rep InstanceAttrs x -> InstanceAttrs
forall x. InstanceAttrs -> Rep InstanceAttrs x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep InstanceAttrs x -> InstanceAttrs
$cfrom :: forall x. InstanceAttrs -> Rep InstanceAttrs x
Generic)

-- XXX: okay, the layout matches
instance GStorable InstanceAttrs

instance Zero InstanceAttrs where
  zero :: InstanceAttrs
zero = InstanceAttrs
    { $sel:vertRect:InstanceAttrs :: Vec4
vertRect = Vec4
0
    , $sel:fragRect:InstanceAttrs :: Vec4
fragRect = Vec4
0

    , $sel:tint:InstanceAttrs :: Vec4
tint    = Vec4
0
    , $sel:outline:InstanceAttrs :: Vec4
outline = Vec4
0

    , $sel:animation:InstanceAttrs :: Vec4
animation = Vec4
0

    , $sel:textureSize:InstanceAttrs :: UVec2
textureSize = UVec2
0
    , $sel:samplerId:InstanceAttrs :: Int32
samplerId = Int32
0
    , $sel:textureId:InstanceAttrs :: Int32
textureId = Int32
0
    }

instance HasVkFormat InstanceAttrs where
  getVkFormat :: [Format]
getVkFormat =
    [ Format
Vk.FORMAT_R32G32B32A32_SFLOAT -- Quad scale+offset
    , Format
Vk.FORMAT_R32G32B32A32_SFLOAT -- UV scale+offset
    , Format
Vk.FORMAT_R32G32B32A32_SFLOAT -- Tint
    , Format
Vk.FORMAT_R32G32B32A32_SFLOAT -- Outline (when enabled)

    , Format
Vk.FORMAT_R32G32B32A32_SFLOAT -- Linear animation direction/duration, num frames, phase

    , Format
Vk.FORMAT_R32G32_UINT -- Texture size
    , Format
Vk.FORMAT_R32G32_SINT -- Sampler + texture IDs
    ]

instance HasVertexInputBindings InstanceAttrs where
  vertexInputBindings :: [VertexInputBinding]
vertexInputBindings = [forall a. HasVkFormat a => VertexInputBinding
instanceFormat @InstanceAttrs]

type StorableAttrs = Storable.Vector InstanceAttrs
type InstanceBuffer stage = Buffer.Allocated stage InstanceAttrs

fromTexture
  :: Int32 -- ^ Sampler index.
  -> Int32 -- ^ Texture index.
  -> Vec2  -- ^ Sprite size.
  -> Vec2  -- ^ Sprite position.
  -> InstanceAttrs
fromTexture :: Int32 -> Int32 -> Vec2 -> Vec2 -> InstanceAttrs
fromTexture Int32
sampler Int32
texture Vec2
wh Vec2
pos =
  InstanceAttrs
    { $sel:vertRect:InstanceAttrs :: Vec4
vertRect = Vec2 -> Vec2 -> Vec4
Vec4.fromVec22 Vec2
pos Vec2
wh
    , $sel:fragRect:InstanceAttrs :: Vec4
fragRect = Vec2 -> Vec2 -> Vec4
Vec4.fromVec22 Vec2
0 Vec2
1

    , $sel:tint:InstanceAttrs :: Vec4
tint    = Vec4
1
    , $sel:outline:InstanceAttrs :: Vec4
outline = Vec4
0

    , $sel:animation:InstanceAttrs :: Vec4
animation = Vec4
0

    , $sel:textureSize:InstanceAttrs :: UVec2
textureSize = UVec2
0
    , $sel:samplerId:InstanceAttrs :: Int32
samplerId = Int32
sampler
    , $sel:textureId:InstanceAttrs :: Int32
textureId = Int32
texture
    }

fromAtlas
  :: Int32 -- ^ Texture ID.
  -> Atlas
  -> Vec2 -- ^ Sprite scale, wrt. to native tile size
  -> Vec2 -- ^ Tile position in atlas tiles. Can be fractional when using subgrids.
  -> Vec2 -- ^ Sprite position.
  -> InstanceAttrs
fromAtlas :: Int32 -> Atlas -> Vec2 -> Vec2 -> Vec2 -> InstanceAttrs
fromAtlas Int32
texture Atlas
atlas Vec2
scale Vec2
atlasPos Vec2
worldPos =
  InstanceAttrs
    { $sel:vertRect:InstanceAttrs :: Vec4
vertRect = Vec2 -> Vec2 -> Vec4
Vec4.fromVec22 Vec2
worldPos (Vec2
tileSize forall a. Num a => a -> a -> a
* Vec2
scale)
    , $sel:fragRect:InstanceAttrs :: Vec4
fragRect = Vec2 -> Vec2 -> Vec4
Vec4.fromVec22 ((Vec2
atlasPos forall a. Num a => a -> a -> a
+ Vec2
tileMargins forall a. Fractional a => a -> a -> a
/ Vec2
tileSize) forall a. Num a => a -> a -> a
* Vec2
uvScale) Vec2
uvScale

    , $sel:tint:InstanceAttrs :: Vec4
tint    = Vec4
1
    , $sel:outline:InstanceAttrs :: Vec4
outline = Vec4
0

    , $sel:animation:InstanceAttrs :: Vec4
animation = Vec4
0

    , $sel:textureSize:InstanceAttrs :: UVec2
textureSize = Atlas -> UVec2
Atlas.sizePx Atlas
atlas
    , $sel:samplerId:InstanceAttrs :: Int32
samplerId = forall a. Collection a -> a
Samplers.nearest Collection Int32
Samplers.indices
    , $sel:textureId:InstanceAttrs :: Int32
textureId = Int32
texture
    }

  where
    uvScale :: Vec2
uvScale = Atlas -> Vec2
Atlas.uvScale Atlas
atlas

    tileSize :: Vec2
tileSize =
      forall r. UVec2 -> (Word32 -> Word32 -> r) -> r
withUVec2 (Atlas -> UVec2
Atlas.tileSizePx Atlas
atlas) \Word32
tw Word32
th ->
        Float -> Float -> Vec2
vec2 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
tw) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
th)

    tileMargins :: Vec2
tileMargins =
      forall r. UVec2 -> (Word32 -> Word32 -> r) -> r
withUVec2 (Atlas -> UVec2
Atlas.marginPx Atlas
atlas) \Word32
mx Word32
my ->
        forall r. Vec2 -> (Float -> Float -> r) -> r
withVec2 Vec2
atlasPos \Float
px Float
py ->
          Float -> Float -> Vec2
vec2 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
mx forall a. Num a => a -> a -> a
* Float
px) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
my forall a. Num a => a -> a -> a
* Float
py)

-- | Simple animation controller with left-to-right linear cycle.
animate_
  :: "margin" ::: Float
  -> "num.frames" ::: Int
  -> "frame duration" ::: Float
  -> "phase" ::: Float
  -> InstanceAttrs
  -> InstanceAttrs
animate_ :: Float
-> ("num.frames" ::: Int)
-> Float
-> Float
-> InstanceAttrs
-> InstanceAttrs
animate_ Float
margin "num.frames" ::: Int
numFrames Float
frameDuration Float
phase InstanceAttrs
attrs = InstanceAttrs
attrs
  { $sel:animation:InstanceAttrs :: Vec4
animation =
        Float -> Float -> Float -> Float -> Vec4
vec4
          (forall a b. (Integral a, Num b) => a -> b
fromIntegral "num.frames" ::: Int
numFrames)
          Float
frameDuration
          Float
margin
          Float
phase
  }