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

module Render.Lit.Material.Model
  ( Model
  , VertexAttrs(..)
  , vkVertexAttrs

  , InstanceAttrs
  -- , InstanceBuffers(..)

  -- , TextureParams(..)
  -- , vkInstanceTexture

  -- , allocateInstancesWith
  , Transform
  , Material
  ) where

import RIO

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

import Resource.Model qualified as Model
import Render.Lit.Material (Material)

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

data VertexAttrs = VertexAttrs
  { VertexAttrs -> Vec2
vaTexCoord0 :: Vec2
  , VertexAttrs -> Vec2
vaTexCoord1 :: Vec2
  , VertexAttrs -> Packed
vaNormal    :: Vec3.Packed
  , VertexAttrs -> Packed
vaTangent   :: Vec3.Packed
  , VertexAttrs -> Word32
vaMaterial  :: Word32
  }
  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
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
12 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
12 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4

  peek :: Ptr VertexAttrs -> IO VertexAttrs
peek Ptr VertexAttrs
ptr = do
    Vec2
vaTexCoord0 <- Ptr VertexAttrs -> Int -> IO Vec2
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VertexAttrs
ptr Int
0
    Vec2
vaTexCoord1 <- Ptr VertexAttrs -> Int -> IO Vec2
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VertexAttrs
ptr Int
8
    Packed
vaNormal    <- Ptr VertexAttrs -> Int -> IO Packed
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VertexAttrs
ptr Int
16
    Packed
vaTangent   <- Ptr VertexAttrs -> Int -> IO Packed
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VertexAttrs
ptr Int
28
    Word32
vaMaterial  <- Ptr VertexAttrs -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VertexAttrs
ptr Int
40
    pure VertexAttrs :: Vec2 -> Vec2 -> Packed -> Packed -> Word32 -> VertexAttrs
VertexAttrs{Word32
Vec2
Packed
vaMaterial :: Word32
vaTangent :: Packed
vaNormal :: Packed
vaTexCoord1 :: Vec2
vaTexCoord0 :: Vec2
$sel:vaMaterial:VertexAttrs :: Word32
$sel:vaTangent:VertexAttrs :: Packed
$sel:vaNormal:VertexAttrs :: Packed
$sel:vaTexCoord1:VertexAttrs :: Vec2
$sel:vaTexCoord0:VertexAttrs :: Vec2
..}

  poke :: Ptr VertexAttrs -> VertexAttrs -> IO ()
poke Ptr VertexAttrs
ptr VertexAttrs{Word32
Vec2
Packed
vaMaterial :: Word32
vaTangent :: Packed
vaNormal :: Packed
vaTexCoord1 :: Vec2
vaTexCoord0 :: Vec2
$sel:vaMaterial:VertexAttrs :: VertexAttrs -> Word32
$sel:vaTangent:VertexAttrs :: VertexAttrs -> Packed
$sel:vaNormal:VertexAttrs :: VertexAttrs -> Packed
$sel:vaTexCoord1:VertexAttrs :: VertexAttrs -> Vec2
$sel:vaTexCoord0:VertexAttrs :: VertexAttrs -> Vec2
..} = do
    Ptr VertexAttrs -> Int -> Vec2 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VertexAttrs
ptr  Int
0 Vec2
vaTexCoord0
    Ptr VertexAttrs -> Int -> Vec2 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VertexAttrs
ptr  Int
8 Vec2
vaTexCoord1
    Ptr VertexAttrs -> Int -> Packed -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VertexAttrs
ptr Int
16 Packed
vaNormal
    Ptr VertexAttrs -> Int -> Packed -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VertexAttrs
ptr Int
28 Packed
vaTangent
    Ptr VertexAttrs -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VertexAttrs
ptr Int
40 Word32
vaMaterial

vkVertexAttrs :: [Vk.Format]
vkVertexAttrs :: [Format]
vkVertexAttrs =
  [ Format
Vk.FORMAT_R32G32_SFLOAT    -- vTexCoord0 :: vec2
  , Format
Vk.FORMAT_R32G32_SFLOAT    -- vTexCoord1 :: vec2
  , Format
Vk.FORMAT_R32G32B32_SFLOAT -- vNormal    :: vec3
  , Format
Vk.FORMAT_R32G32B32_SFLOAT -- vTangent   :: vec3
  , Format
Vk.FORMAT_R32_UINT         -- vMaterial  :: uint
  ]

type InstanceAttrs = Transform