{-# LANGUAGE DeriveAnyClass #-}

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

import RIO

import Geomancy (Transform, Vec2)
import Geomancy.Vec3 qualified as Vec3
import Graphics.Gl.Block (Block)
import Graphics.Gl.Block qualified as Block

import Engine.Vulkan.Format (HasVkFormat)
import Render.Lit.Material (Material)
import Resource.Model qualified as Model

type Model buf = Model.Indexed buf Vec3.Packed VertexAttrs
type Vertex = Model.Vertex3d 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
$c== :: VertexAttrs -> VertexAttrs -> Bool
== :: VertexAttrs -> VertexAttrs -> Bool
$c/= :: VertexAttrs -> VertexAttrs -> Bool
/= :: 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
$ccompare :: VertexAttrs -> VertexAttrs -> Ordering
compare :: VertexAttrs -> VertexAttrs -> Ordering
$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
>= :: VertexAttrs -> VertexAttrs -> Bool
$cmax :: VertexAttrs -> VertexAttrs -> VertexAttrs
max :: VertexAttrs -> VertexAttrs -> VertexAttrs
$cmin :: VertexAttrs -> VertexAttrs -> VertexAttrs
min :: VertexAttrs -> VertexAttrs -> 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
$cshowsPrec :: Int -> VertexAttrs -> ShowS
showsPrec :: Int -> VertexAttrs -> ShowS
$cshow :: VertexAttrs -> String
show :: VertexAttrs -> String
$cshowList :: [VertexAttrs] -> ShowS
showList :: [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
$cfrom :: forall x. VertexAttrs -> Rep VertexAttrs x
from :: forall x. VertexAttrs -> Rep VertexAttrs x
$cto :: forall x. Rep VertexAttrs x -> VertexAttrs
to :: forall x. Rep VertexAttrs x -> VertexAttrs
Generic, (forall (proxy :: * -> *). proxy VertexAttrs -> Int)
-> (forall (proxy :: * -> *). proxy VertexAttrs -> Int)
-> (forall (proxy :: * -> *). proxy VertexAttrs -> Bool)
-> (forall (m :: * -> *) a.
    MonadIO m =>
    Ptr a -> Diff a VertexAttrs -> m VertexAttrs)
-> (forall (m :: * -> *) a.
    MonadIO m =>
    Ptr a -> Diff a VertexAttrs -> VertexAttrs -> m ())
-> (forall (proxy :: * -> *). proxy VertexAttrs -> Int)
-> (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 ())
-> (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 ())
-> Block VertexAttrs
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 ()
$calignment140 :: forall (proxy :: * -> *). proxy VertexAttrs -> Int
alignment140 :: forall (proxy :: * -> *). proxy VertexAttrs -> Int
$csizeOf140 :: forall (proxy :: * -> *). proxy VertexAttrs -> Int
sizeOf140 :: forall (proxy :: * -> *). proxy VertexAttrs -> Int
$cisStruct :: forall (proxy :: * -> *). proxy VertexAttrs -> Bool
isStruct :: forall (proxy :: * -> *). proxy VertexAttrs -> Bool
$cread140 :: forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a VertexAttrs -> m VertexAttrs
read140 :: forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a VertexAttrs -> m VertexAttrs
$cwrite140 :: forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a VertexAttrs -> VertexAttrs -> m ()
write140 :: forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a VertexAttrs -> VertexAttrs -> m ()
$calignment430 :: forall (proxy :: * -> *). proxy VertexAttrs -> Int
alignment430 :: forall (proxy :: * -> *). proxy VertexAttrs -> Int
$csizeOf430 :: forall (proxy :: * -> *). proxy VertexAttrs -> Int
sizeOf430 :: forall (proxy :: * -> *). proxy VertexAttrs -> Int
$cread430 :: forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a VertexAttrs -> m VertexAttrs
read430 :: forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a VertexAttrs -> m VertexAttrs
$cwrite430 :: forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a VertexAttrs -> VertexAttrs -> m ()
write430 :: forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a VertexAttrs -> VertexAttrs -> m ()
$csizeOfPacked :: forall (proxy :: * -> *). proxy VertexAttrs -> Int
sizeOfPacked :: forall (proxy :: * -> *). proxy VertexAttrs -> Int
$creadPacked :: forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a VertexAttrs -> m VertexAttrs
readPacked :: forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a VertexAttrs -> m VertexAttrs
$cwritePacked :: 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 ()
Block, [Format]
[Format] -> HasVkFormat VertexAttrs
forall a. [Format] -> HasVkFormat a
$cgetVkFormat :: [Format]
getVkFormat :: [Format]
HasVkFormat)
  deriving Ptr VertexAttrs -> IO VertexAttrs
Ptr VertexAttrs -> Int -> IO VertexAttrs
Ptr VertexAttrs -> Int -> VertexAttrs -> IO ()
Ptr VertexAttrs -> VertexAttrs -> IO ()
VertexAttrs -> Int
(VertexAttrs -> Int)
-> (VertexAttrs -> Int)
-> (Ptr VertexAttrs -> Int -> IO VertexAttrs)
-> (Ptr VertexAttrs -> Int -> VertexAttrs -> IO ())
-> (forall b. Ptr b -> Int -> IO VertexAttrs)
-> (forall b. Ptr b -> Int -> VertexAttrs -> IO ())
-> (Ptr VertexAttrs -> IO VertexAttrs)
-> (Ptr VertexAttrs -> VertexAttrs -> IO ())
-> Storable VertexAttrs
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
$csizeOf :: VertexAttrs -> Int
sizeOf :: VertexAttrs -> Int
$calignment :: VertexAttrs -> Int
alignment :: VertexAttrs -> Int
$cpeekElemOff :: Ptr VertexAttrs -> Int -> IO VertexAttrs
peekElemOff :: Ptr VertexAttrs -> Int -> IO VertexAttrs
$cpokeElemOff :: Ptr VertexAttrs -> Int -> VertexAttrs -> IO ()
pokeElemOff :: Ptr VertexAttrs -> Int -> VertexAttrs -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO VertexAttrs
peekByteOff :: forall b. Ptr b -> Int -> IO VertexAttrs
$cpokeByteOff :: forall b. Ptr b -> Int -> VertexAttrs -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> VertexAttrs -> IO ()
$cpeek :: Ptr VertexAttrs -> IO VertexAttrs
peek :: Ptr VertexAttrs -> IO VertexAttrs
$cpoke :: Ptr VertexAttrs -> VertexAttrs -> IO ()
poke :: Ptr VertexAttrs -> VertexAttrs -> IO ()
Storable via (Block.Packed VertexAttrs)

type InstanceAttrs = Transform