module Render.Font.EvanwSdf.Model
  ( Model
  , VertexAttrs
  , InstanceAttrs(..)
  , vkInstanceAttrs
  , InstanceBuffer
  ) where

import RIO

import Foreign (Storable(..))
import Geomancy (Vec2, Vec4)
import Geomancy.Vec3 qualified as Vec3
import Vulkan.Core10 qualified as Vk
import Vulkan.NamedType ((:::))

import Resource.Buffer qualified as Buffer
import Resource.Model qualified as Model

type Model buf = Model.Indexed buf Vec3.Packed VertexAttrs

type VertexAttrs = "uv" ::: Vec2

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
(InstanceAttrs -> InstanceAttrs -> Bool)
-> (InstanceAttrs -> InstanceAttrs -> Bool) -> Eq InstanceAttrs
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
(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)

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 -- 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 Storable InstanceAttrs where
  alignment :: InstanceAttrs -> Int
alignment ~InstanceAttrs
_ = Int
4
  sizeOf :: InstanceAttrs -> Int
sizeOf ~InstanceAttrs
_ = Int
16 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
16 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
16 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
16 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4

  peek :: Ptr InstanceAttrs -> IO InstanceAttrs
peek Ptr InstanceAttrs
ptr = do
    Vec4
vertRect     <- Ptr InstanceAttrs -> Int -> IO Vec4
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr InstanceAttrs
ptr  Int
0 -- +16
    Vec4
fragRect     <- Ptr InstanceAttrs -> Int -> IO Vec4
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr InstanceAttrs
ptr Int
16 -- +16
    Vec4
color        <- Ptr InstanceAttrs -> Int -> IO Vec4
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr InstanceAttrs
ptr Int
32 -- +16
    Vec4
outlineColor <- Ptr InstanceAttrs -> Int -> IO Vec4
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr InstanceAttrs
ptr Int
48 -- +16
    Int32
samplerId    <- Ptr InstanceAttrs -> Int -> IO Int32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr InstanceAttrs
ptr Int
64 -- +4
    Int32
textureId    <- Ptr InstanceAttrs -> Int -> IO Int32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr InstanceAttrs
ptr Int
68 -- +4
    Float
smoothing    <- Ptr InstanceAttrs -> Int -> IO Float
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr InstanceAttrs
ptr Int
72 -- +4
    Float
outlineWidth <- Ptr InstanceAttrs -> Int -> IO Float
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr InstanceAttrs
ptr Int
76 -- +4
    pure InstanceAttrs :: Vec4
-> Vec4
-> Vec4
-> Vec4
-> Int32
-> Int32
-> Float
-> Float
-> InstanceAttrs
InstanceAttrs{Float
Int32
Vec4
outlineWidth :: Float
smoothing :: Float
textureId :: Int32
samplerId :: Int32
outlineColor :: Vec4
color :: Vec4
fragRect :: Vec4
vertRect :: Vec4
$sel:outlineWidth:InstanceAttrs :: Float
$sel:smoothing:InstanceAttrs :: Float
$sel:textureId:InstanceAttrs :: Int32
$sel:samplerId:InstanceAttrs :: Int32
$sel:outlineColor:InstanceAttrs :: Vec4
$sel:color:InstanceAttrs :: Vec4
$sel:fragRect:InstanceAttrs :: Vec4
$sel:vertRect:InstanceAttrs :: Vec4
..}

  poke :: Ptr InstanceAttrs -> InstanceAttrs -> IO ()
poke Ptr InstanceAttrs
ptr InstanceAttrs{Float
Int32
Vec4
outlineWidth :: Float
smoothing :: Float
textureId :: Int32
samplerId :: Int32
outlineColor :: Vec4
color :: Vec4
fragRect :: Vec4
vertRect :: Vec4
$sel:outlineWidth:InstanceAttrs :: InstanceAttrs -> Float
$sel:smoothing:InstanceAttrs :: InstanceAttrs -> Float
$sel:textureId:InstanceAttrs :: InstanceAttrs -> Int32
$sel:samplerId:InstanceAttrs :: InstanceAttrs -> Int32
$sel:outlineColor:InstanceAttrs :: InstanceAttrs -> Vec4
$sel:color:InstanceAttrs :: InstanceAttrs -> Vec4
$sel:fragRect:InstanceAttrs :: InstanceAttrs -> Vec4
$sel:vertRect:InstanceAttrs :: InstanceAttrs -> Vec4
..} = do
    Ptr InstanceAttrs -> Int -> Vec4 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr InstanceAttrs
ptr  Int
0 Vec4
vertRect
    Ptr InstanceAttrs -> Int -> Vec4 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr InstanceAttrs
ptr Int
16 Vec4
fragRect
    Ptr InstanceAttrs -> Int -> Vec4 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr InstanceAttrs
ptr Int
32 Vec4
color
    Ptr InstanceAttrs -> Int -> Vec4 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr InstanceAttrs
ptr Int
48 Vec4
outlineColor
    Ptr InstanceAttrs -> Int -> Int32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr InstanceAttrs
ptr Int
64 Int32
samplerId
    Ptr InstanceAttrs -> Int -> Int32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr InstanceAttrs
ptr Int
68 Int32
textureId
    Ptr InstanceAttrs -> Int -> Float -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr InstanceAttrs
ptr Int
72 Float
smoothing
    Ptr InstanceAttrs -> Int -> Float -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr InstanceAttrs
ptr Int
76 Float
outlineWidth

type InstanceBuffer stage = Buffer.Allocated stage InstanceAttrs