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

{-# LANGUAGE DeriveAnyClass #-}

module Render.Font.EvanwSdf.Model
  ( InstanceAttrs(..)
  ) where

import RIO

import Foreign.Storable.Generic (GStorable)
import Geomancy (Vec4)
import Vulkan.Core10 qualified as Vk

import Engine.Vulkan.Format (HasVkFormat(..))
import Engine.Vulkan.Pipeline.Graphics (HasVertexInputBindings(..), instanceFormat)

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

  , InstanceAttrs -> Int32
samplerId    :: Int32
  , InstanceAttrs -> Int32
textureId    :: Int32

  , InstanceAttrs -> Float
smoothing    :: Float
  , InstanceAttrs -> Float
outlineWidth :: Float
  }
  deriving (InstanceAttrs -> InstanceAttrs -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InstanceAttrs -> InstanceAttrs -> Bool
$c/= :: InstanceAttrs -> InstanceAttrs -> Bool
== :: InstanceAttrs -> InstanceAttrs -> Bool
$c== :: InstanceAttrs -> InstanceAttrs -> Bool
Eq, Int -> InstanceAttrs -> ShowS
[InstanceAttrs] -> ShowS
InstanceAttrs -> String
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. 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: Fine, the layout matches
instance GStorable InstanceAttrs

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 -- Color
    , Format
Vk.FORMAT_R32G32B32A32_SFLOAT -- Outline color

    , Format
Vk.FORMAT_R32G32_SINT         -- Sampler + texture IDs
    , Format
Vk.FORMAT_R32G32_SFLOAT       -- Smoothing + outline width
    ]

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