{-# LANGUAGE DeriveAnyClass #-}

module Render.Lit.Colored.Model
  ( Model
  , Vertex
  , VertexAttrs(..)
  , InstanceAttrs
  ) where

import RIO

import Geomancy (Transform, Vec2, Vec4)
import Geomancy.Gl.Block (Block)
import Geomancy.Gl.Block qualified as Block
import Geomancy.Vec3 qualified as Vec3
import Resource.Model qualified as Model

import Engine.Vulkan.Format (HasVkFormat)

type Model buf = Model.Indexed buf Vec3.Packed VertexAttrs
type Vertex = Model.Vertex3d 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
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
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
Ord, Int -> VertexAttrs -> ShowS
[VertexAttrs] -> ShowS
VertexAttrs -> String
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. 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, forall b.
(forall (proxy :: * -> *). proxy b -> Int)
-> (forall (proxy :: * -> *). proxy b -> Int)
-> (forall (proxy :: * -> *). proxy b -> Bool)
-> (forall (m :: * -> *) a. MonadIO m => Ptr a -> Diff a b -> m b)
-> (forall (m :: * -> *) a.
    MonadIO m =>
    Ptr a -> Diff a b -> b -> m ())
-> (forall (proxy :: * -> *). proxy b -> Int)
-> (forall (proxy :: * -> *). proxy b -> Int)
-> (forall (m :: * -> *) a. MonadIO m => Ptr a -> Diff a b -> m b)
-> (forall (m :: * -> *) a.
    MonadIO m =>
    Ptr a -> Diff a b -> b -> m ())
-> (forall (proxy :: * -> *). proxy b -> Int)
-> (forall (m :: * -> *) a. MonadIO m => Ptr a -> Diff a b -> m b)
-> (forall (m :: * -> *) a.
    MonadIO m =>
    Ptr a -> Diff a b -> b -> m ())
-> Block b
forall (proxy :: * -> *). proxy VertexAttrs -> Bool
forall (proxy :: * -> *). proxy VertexAttrs -> Int
forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a VertexAttrs -> m VertexAttrs
forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a VertexAttrs -> VertexAttrs -> m ()
writePacked :: forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a VertexAttrs -> VertexAttrs -> m ()
$cwritePacked :: forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a VertexAttrs -> VertexAttrs -> m ()
readPacked :: forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a VertexAttrs -> m VertexAttrs
$creadPacked :: forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a VertexAttrs -> m VertexAttrs
sizeOfPacked :: forall (proxy :: * -> *). proxy VertexAttrs -> Int
$csizeOfPacked :: forall (proxy :: * -> *). proxy VertexAttrs -> Int
write430 :: forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a VertexAttrs -> VertexAttrs -> m ()
$cwrite430 :: forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a VertexAttrs -> VertexAttrs -> m ()
read430 :: forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a VertexAttrs -> m VertexAttrs
$cread430 :: forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a VertexAttrs -> m VertexAttrs
sizeOf430 :: forall (proxy :: * -> *). proxy VertexAttrs -> Int
$csizeOf430 :: forall (proxy :: * -> *). proxy VertexAttrs -> Int
alignment430 :: forall (proxy :: * -> *). proxy VertexAttrs -> Int
$calignment430 :: forall (proxy :: * -> *). proxy VertexAttrs -> Int
write140 :: forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a VertexAttrs -> VertexAttrs -> m ()
$cwrite140 :: forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a VertexAttrs -> VertexAttrs -> m ()
read140 :: forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a VertexAttrs -> m VertexAttrs
$cread140 :: forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a VertexAttrs -> m VertexAttrs
isStruct :: forall (proxy :: * -> *). proxy VertexAttrs -> Bool
$cisStruct :: forall (proxy :: * -> *). proxy VertexAttrs -> Bool
sizeOf140 :: forall (proxy :: * -> *). proxy VertexAttrs -> Int
$csizeOf140 :: forall (proxy :: * -> *). proxy VertexAttrs -> Int
alignment140 :: forall (proxy :: * -> *). proxy VertexAttrs -> Int
$calignment140 :: forall (proxy :: * -> *). proxy VertexAttrs -> Int
Block, [Format]
forall a. [Format] -> HasVkFormat a
getVkFormat :: [Format]
$cgetVkFormat :: [Format]
HasVkFormat)
  deriving Ptr VertexAttrs -> IO VertexAttrs
Ptr VertexAttrs -> Int -> IO VertexAttrs
Ptr VertexAttrs -> Int -> VertexAttrs -> IO ()
Ptr VertexAttrs -> VertexAttrs -> IO ()
VertexAttrs -> Int
forall b. Ptr b -> Int -> IO VertexAttrs
forall b. Ptr b -> Int -> VertexAttrs -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr VertexAttrs -> VertexAttrs -> IO ()
$cpoke :: Ptr VertexAttrs -> VertexAttrs -> IO ()
peek :: Ptr VertexAttrs -> IO VertexAttrs
$cpeek :: Ptr VertexAttrs -> IO VertexAttrs
pokeByteOff :: forall b. Ptr b -> Int -> VertexAttrs -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> VertexAttrs -> IO ()
peekByteOff :: forall b. Ptr b -> Int -> IO VertexAttrs
$cpeekByteOff :: forall b. Ptr b -> Int -> IO VertexAttrs
pokeElemOff :: Ptr VertexAttrs -> Int -> VertexAttrs -> IO ()
$cpokeElemOff :: Ptr VertexAttrs -> Int -> VertexAttrs -> IO ()
peekElemOff :: Ptr VertexAttrs -> Int -> IO VertexAttrs
$cpeekElemOff :: Ptr VertexAttrs -> Int -> IO VertexAttrs
alignment :: VertexAttrs -> Int
$calignment :: VertexAttrs -> Int
sizeOf :: VertexAttrs -> Int
$csizeOf :: VertexAttrs -> Int
Storable via (Block.Packed VertexAttrs)

type InstanceAttrs = Transform