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

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

  , vkInstanceAttrs
  ) where

import RIO

import Foreign.Storable.Generic (GStorable)
import Geomancy (Vec2, Vec4, UVec2, withUVec2, vec2)
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.Zero (Zero(..))

type StorableAttrs = Storable.Vector InstanceAttrs

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

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

  , InstanceAttrs -> Int32
samplerId :: Int32
  , InstanceAttrs -> Int32
textureId :: Int32
  , InstanceAttrs -> UVec2
textureSize :: UVec2
  }
  deriving (Int -> InstanceAttrs -> ShowS
[InstanceAttrs] -> ShowS
InstanceAttrs -> String
(Int -> InstanceAttrs -> ShowS)
-> (InstanceAttrs -> String)
-> ([InstanceAttrs] -> ShowS)
-> Show InstanceAttrs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InstanceAttrs] -> ShowS
$cshowList :: [InstanceAttrs] -> ShowS
show :: InstanceAttrs -> String
$cshow :: InstanceAttrs -> String
showsPrec :: Int -> InstanceAttrs -> ShowS
$cshowsPrec :: Int -> InstanceAttrs -> ShowS
Show, (forall x. InstanceAttrs -> Rep InstanceAttrs x)
-> (forall x. Rep InstanceAttrs x -> InstanceAttrs)
-> Generic InstanceAttrs
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)

instance GStorable InstanceAttrs

instance Zero InstanceAttrs where
  zero :: InstanceAttrs
zero = InstanceAttrs :: Vec4
-> Vec4 -> Vec4 -> Vec4 -> Int32 -> Int32 -> UVec2 -> InstanceAttrs
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:samplerId:InstanceAttrs :: Int32
samplerId = Int32
0
    , $sel:textureId:InstanceAttrs :: Int32
textureId = Int32
0
    , $sel:textureSize:InstanceAttrs :: UVec2
textureSize = UVec2
0
    }

vkInstanceAttrs :: [Vk.Format]
vkInstanceAttrs :: [Format]
vkInstanceAttrs =
  [ 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_R32G32_SINT -- Sampler + texture IDs
  , Format
Vk.FORMAT_R32G32_UINT -- Texture size
  ]

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 :: Vec4
-> Vec4 -> Vec4 -> Vec4 -> Int32 -> Int32 -> UVec2 -> InstanceAttrs
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:samplerId:InstanceAttrs :: Int32
samplerId = Int32
sampler
    , $sel:textureId:InstanceAttrs :: Int32
textureId = Int32
texture
    , $sel:textureSize:InstanceAttrs :: UVec2
textureSize = UVec2
0
    }

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 :: Vec4
-> Vec4 -> Vec4 -> Vec4 -> Int32 -> Int32 -> UVec2 -> InstanceAttrs
InstanceAttrs
    { $sel:vertRect:InstanceAttrs :: Vec4
vertRect = Vec2 -> Vec2 -> Vec4
Vec4.fromVec22 Vec2
worldPos (Vec2
tileSize Vec2 -> Vec2 -> Vec2
forall a. Num a => a -> a -> a
* Vec2
scale)
    , $sel:fragRect:InstanceAttrs :: Vec4
fragRect = Vec2 -> Vec2 -> Vec4
Vec4.fromVec22 (Vec2
atlasPos Vec2 -> Vec2 -> Vec2
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:samplerId:InstanceAttrs :: Int32
samplerId = Collection Int32 -> Int32
forall a. Collection a -> a
Samplers.nearest Collection Int32
Samplers.indices
    , $sel:textureId:InstanceAttrs :: Int32
textureId = Int32
texture
    , $sel:textureSize:InstanceAttrs :: UVec2
textureSize = Atlas -> UVec2
Atlas.sizePx Atlas
atlas
    }

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

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