module Render.Lit.Colored.Model
  ( Model

  , VertexAttrs(..)
  , vkVertexAttrs

  , InstanceAttrs
  ) where

import RIO

import Foreign (Storable(..))
import Geomancy (Transform, Vec2, Vec4)
import Geomancy.Vec3 qualified as Vec3
import Resource.Model qualified as Model
import Vulkan.Core10 qualified as Vk

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

data VertexAttrs = VertexAttrs
  { VertexAttrs -> Vec4
vaBaseColor         :: Vec4
  , VertexAttrs -> Vec4
vaEmissiveColor     :: Vec4 -- XXX: a: alpha cutoff
  , VertexAttrs -> Vec2
vaMetallicRoughness :: Vec2
  , VertexAttrs -> Packed
vaNormal            :: Vec3.Packed
  }
  deriving (VertexAttrs -> VertexAttrs -> Bool
(VertexAttrs -> VertexAttrs -> Bool)
-> (VertexAttrs -> VertexAttrs -> Bool) -> Eq VertexAttrs
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VertexAttrs -> VertexAttrs -> Bool
$c/= :: VertexAttrs -> VertexAttrs -> Bool
== :: VertexAttrs -> VertexAttrs -> Bool
$c== :: VertexAttrs -> VertexAttrs -> Bool
Eq, Eq VertexAttrs
Eq VertexAttrs
-> (VertexAttrs -> VertexAttrs -> Ordering)
-> (VertexAttrs -> VertexAttrs -> Bool)
-> (VertexAttrs -> VertexAttrs -> Bool)
-> (VertexAttrs -> VertexAttrs -> Bool)
-> (VertexAttrs -> VertexAttrs -> Bool)
-> (VertexAttrs -> VertexAttrs -> VertexAttrs)
-> (VertexAttrs -> VertexAttrs -> VertexAttrs)
-> Ord VertexAttrs
VertexAttrs -> VertexAttrs -> Bool
VertexAttrs -> VertexAttrs -> Ordering
VertexAttrs -> VertexAttrs -> VertexAttrs
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: VertexAttrs -> VertexAttrs -> VertexAttrs
$cmin :: VertexAttrs -> VertexAttrs -> VertexAttrs
max :: VertexAttrs -> VertexAttrs -> VertexAttrs
$cmax :: VertexAttrs -> VertexAttrs -> VertexAttrs
>= :: VertexAttrs -> VertexAttrs -> Bool
$c>= :: VertexAttrs -> VertexAttrs -> Bool
> :: VertexAttrs -> VertexAttrs -> Bool
$c> :: VertexAttrs -> VertexAttrs -> Bool
<= :: VertexAttrs -> VertexAttrs -> Bool
$c<= :: VertexAttrs -> VertexAttrs -> Bool
< :: VertexAttrs -> VertexAttrs -> Bool
$c< :: VertexAttrs -> VertexAttrs -> Bool
compare :: VertexAttrs -> VertexAttrs -> Ordering
$ccompare :: VertexAttrs -> VertexAttrs -> Ordering
$cp1Ord :: Eq VertexAttrs
Ord, Int -> VertexAttrs -> ShowS
[VertexAttrs] -> ShowS
VertexAttrs -> String
(Int -> VertexAttrs -> ShowS)
-> (VertexAttrs -> String)
-> ([VertexAttrs] -> ShowS)
-> Show VertexAttrs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VertexAttrs] -> ShowS
$cshowList :: [VertexAttrs] -> ShowS
show :: VertexAttrs -> String
$cshow :: VertexAttrs -> String
showsPrec :: Int -> VertexAttrs -> ShowS
$cshowsPrec :: Int -> VertexAttrs -> ShowS
Show, (forall x. VertexAttrs -> Rep VertexAttrs x)
-> (forall x. Rep VertexAttrs x -> VertexAttrs)
-> Generic VertexAttrs
forall x. Rep VertexAttrs x -> VertexAttrs
forall x. VertexAttrs -> Rep VertexAttrs x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep VertexAttrs x -> VertexAttrs
$cfrom :: forall x. VertexAttrs -> Rep VertexAttrs x
Generic)

instance Storable VertexAttrs where
  alignment :: VertexAttrs -> Int
alignment ~VertexAttrs
_ = Int
4

  sizeOf :: VertexAttrs -> Int
sizeOf ~VertexAttrs
_ = 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
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
12

  peek :: Ptr VertexAttrs -> IO VertexAttrs
peek Ptr VertexAttrs
ptr = do
    Vec4
vaBaseColor         <- Ptr VertexAttrs -> Int -> IO Vec4
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VertexAttrs
ptr  Int
0
    Vec4
vaEmissiveColor     <- Ptr VertexAttrs -> Int -> IO Vec4
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VertexAttrs
ptr Int
16
    Vec2
vaMetallicRoughness <- Ptr VertexAttrs -> Int -> IO Vec2
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VertexAttrs
ptr Int
32
    Packed
vaNormal            <- Ptr VertexAttrs -> Int -> IO Packed
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VertexAttrs
ptr Int
40
    pure VertexAttrs :: Vec4 -> Vec4 -> Vec2 -> Packed -> VertexAttrs
VertexAttrs{Vec2
Vec4
Packed
vaNormal :: Packed
vaMetallicRoughness :: Vec2
vaEmissiveColor :: Vec4
vaBaseColor :: Vec4
$sel:vaNormal:VertexAttrs :: Packed
$sel:vaMetallicRoughness:VertexAttrs :: Vec2
$sel:vaEmissiveColor:VertexAttrs :: Vec4
$sel:vaBaseColor:VertexAttrs :: Vec4
..}

  poke :: Ptr VertexAttrs -> VertexAttrs -> IO ()
poke Ptr VertexAttrs
ptr VertexAttrs{Vec2
Vec4
Packed
vaNormal :: Packed
vaMetallicRoughness :: Vec2
vaEmissiveColor :: Vec4
vaBaseColor :: Vec4
$sel:vaNormal:VertexAttrs :: VertexAttrs -> Packed
$sel:vaMetallicRoughness:VertexAttrs :: VertexAttrs -> Vec2
$sel:vaEmissiveColor:VertexAttrs :: VertexAttrs -> Vec4
$sel:vaBaseColor:VertexAttrs :: VertexAttrs -> Vec4
..} = do
    Ptr VertexAttrs -> Int -> Vec4 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VertexAttrs
ptr  Int
0 Vec4
vaBaseColor
    Ptr VertexAttrs -> Int -> Vec4 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VertexAttrs
ptr Int
16 Vec4
vaEmissiveColor
    Ptr VertexAttrs -> Int -> Vec2 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VertexAttrs
ptr Int
32 Vec2
vaMetallicRoughness
    Ptr VertexAttrs -> Int -> Packed -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VertexAttrs
ptr Int
40 Packed
vaNormal

type InstanceAttrs = Transform

vkVertexAttrs :: [Vk.Format]
vkVertexAttrs :: [Format]
vkVertexAttrs =
  [ Format
Vk.FORMAT_R32G32B32A32_SFLOAT -- vBaseColor         :: vec4
  , Format
Vk.FORMAT_R32G32B32A32_SFLOAT -- vEmissiveColor     :: vec4
  , Format
Vk.FORMAT_R32G32_SFLOAT       -- vMetallicRoughness :: vec2
  , Format
Vk.FORMAT_R32G32B32_SFLOAT    -- vNormal            :: vec3
  ]