{-# OPTIONS_GHC -fplugin Foreign.Storable.Generic.Plugin #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE OverloadedRecordDot #-}
module Render.Unlit.Textured.Model
( Model
, Vertex
, VertexAttrs
, AttrsF(..)
, Attrs
, attrs
, Stores
, attrStores
, stores1
, Buffers
, TextureParams(..)
, ObserverCoherent
) where
import RIO
import Geomancy (Transform, Vec2, Vec4)
import Geomancy.Vec3 qualified as Vec3
import Graphics.Gl.Block (Block)
import Graphics.Gl.Block qualified as Block
import RIO.Vector.Storable qualified as Storable
import Vulkan.Core10 qualified as Vk
import Vulkan.NamedType ((:::))
import Vulkan.Zero (Zero(..))
import Engine.Types (HKD)
import Engine.Vulkan.Format (HasVkFormat(..))
import Engine.Vulkan.Pipeline.Graphics (HasVertexInputBindings(..), instanceFormat)
import Engine.Worker qualified as Worker
import Resource.Buffer qualified as Buffer
import Resource.Model qualified as Model
import Resource.Model.Observer qualified as Observer
type Model buf = Model.Indexed buf Vec3.Packed VertexAttrs
type Vertex = Model.Vertex3d VertexAttrs
type VertexAttrs = "uv" ::: Vec2
data AttrsF f = Attrs
{ forall (f :: * -> *). AttrsF f -> HKD f TextureParams
params :: HKD f TextureParams
, forall (f :: * -> *). AttrsF f -> HKD f Transform
transforms :: HKD f Transform
}
deriving ((forall x. AttrsF f -> Rep (AttrsF f) x)
-> (forall x. Rep (AttrsF f) x -> AttrsF f) -> Generic (AttrsF f)
forall x. Rep (AttrsF f) x -> AttrsF f
forall x. AttrsF f -> Rep (AttrsF f) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: * -> *) x. Rep (AttrsF f) x -> AttrsF f
forall (f :: * -> *) x. AttrsF f -> Rep (AttrsF f) x
$cfrom :: forall (f :: * -> *) x. AttrsF f -> Rep (AttrsF f) x
from :: forall x. AttrsF f -> Rep (AttrsF f) x
$cto :: forall (f :: * -> *) x. Rep (AttrsF f) x -> AttrsF f
to :: forall x. Rep (AttrsF f) x -> AttrsF f
Generic)
type Attrs = AttrsF Identity
deriving instance Show Attrs
instance HasVertexInputBindings Attrs where
vertexInputBindings :: [VertexInputBinding]
vertexInputBindings =
[ forall a. HasVkFormat a => VertexInputBinding
instanceFormat @TextureParams
, forall a. HasVkFormat a => VertexInputBinding
instanceFormat @Transform
]
type Stores = AttrsF Storable.Vector
deriving instance Show Stores
type Buffers = AttrsF (Buffer.Allocated 'Buffer.Coherent)
deriving instance Show Buffers
instance Observer.VertexBuffers Buffers
type ObserverCoherent = Worker.ObserverIO Buffers
instance Observer.UpdateCoherent Buffers Stores
instance Model.HasVertexBuffers Buffers where
type VertexBuffersOf Buffers = Attrs
instance Zero Attrs where
zero :: Attrs
zero = Attrs
{ $sel:params:Attrs :: HKD Identity TextureParams
params = HKD Identity TextureParams
TextureParams
forall a. Zero a => a
zero
, $sel:transforms:Attrs :: HKD Identity Transform
transforms = Transform
HKD Identity Transform
forall a. Monoid a => a
mempty
}
attrs :: Int32 -> Int32 -> [Transform] -> Attrs
attrs :: Int32 -> Int32 -> [Transform] -> Attrs
attrs Int32
samplerId Int32
textureId [Transform]
transforms = Attrs
{ $sel:params:Attrs :: HKD Identity TextureParams
params = TextureParams
forall a. Zero a => a
zero
{ $sel:tpSamplerId:TextureParams :: Int32
tpSamplerId = Int32
samplerId
, $sel:tpTextureId:TextureParams :: Int32
tpTextureId = Int32
textureId
}
, $sel:transforms:Attrs :: HKD Identity Transform
transforms = [Transform] -> Transform
forall a. Monoid a => [a] -> a
mconcat [Transform]
transforms
}
attrStores :: Foldable t => t Attrs -> Stores
attrStores :: forall (t :: * -> *). Foldable t => t Attrs -> Stores
attrStores t Attrs
source = Attrs
{ $sel:params:Attrs :: HKD Vector TextureParams
params = [TextureParams] -> Vector TextureParams
forall a. Storable a => [a] -> Vector a
Storable.fromList ([TextureParams] -> Vector TextureParams)
-> [TextureParams] -> Vector TextureParams
forall a b. (a -> b) -> a -> b
$ (Attrs -> TextureParams) -> [Attrs] -> [TextureParams]
forall a b. (a -> b) -> [a] -> [b]
map (.params) ([Attrs] -> [TextureParams]) -> [Attrs] -> [TextureParams]
forall a b. (a -> b) -> a -> b
$ t Attrs -> [Attrs]
forall a. t a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t Attrs
source
, $sel:transforms:Attrs :: HKD Vector Transform
transforms = [Transform] -> Vector Transform
forall a. Storable a => [a] -> Vector a
Storable.fromList ([Transform] -> Vector Transform)
-> [Transform] -> Vector Transform
forall a b. (a -> b) -> a -> b
$ (Attrs -> Transform) -> [Attrs] -> [Transform]
forall a b. (a -> b) -> [a] -> [b]
map (.transforms) ([Attrs] -> [Transform]) -> [Attrs] -> [Transform]
forall a b. (a -> b) -> a -> b
$ t Attrs -> [Attrs]
forall a. t a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t Attrs
source
}
stores1 :: Int32 -> Int32 -> [Transform] -> Stores
stores1 :: Int32 -> Int32 -> [Transform] -> Stores
stores1 Int32
samplerId Int32
textureId [Transform]
transforms =
Attrs
{ $sel:params:Attrs :: HKD Vector TextureParams
params = TextureParams -> Vector TextureParams
forall a. Storable a => a -> Vector a
Storable.singleton Attrs
attrs1.params
, $sel:transforms:Attrs :: HKD Vector Transform
transforms = Transform -> Vector Transform
forall a. Storable a => a -> Vector a
Storable.singleton Attrs
attrs1.transforms
}
where
attrs1 :: Attrs
attrs1 = Int32 -> Int32 -> [Transform] -> Attrs
attrs
Int32
samplerId
Int32
textureId
[Transform]
transforms
data TextureParams = TextureParams
{ TextureParams -> Vec2
tpScale :: Vec2
, TextureParams -> Vec2
tpOffset :: Vec2
, TextureParams -> Vec4
tpGamma :: Vec4
, TextureParams -> Int32
tpSamplerId :: Int32
, TextureParams -> Int32
tpTextureId :: Int32
}
deriving ((forall x. TextureParams -> Rep TextureParams x)
-> (forall x. Rep TextureParams x -> TextureParams)
-> Generic TextureParams
forall x. Rep TextureParams x -> TextureParams
forall x. TextureParams -> Rep TextureParams x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TextureParams -> Rep TextureParams x
from :: forall x. TextureParams -> Rep TextureParams x
$cto :: forall x. Rep TextureParams x -> TextureParams
to :: forall x. Rep TextureParams x -> TextureParams
Generic, Int -> TextureParams -> ShowS
[TextureParams] -> ShowS
TextureParams -> String
(Int -> TextureParams -> ShowS)
-> (TextureParams -> String)
-> ([TextureParams] -> ShowS)
-> Show TextureParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TextureParams -> ShowS
showsPrec :: Int -> TextureParams -> ShowS
$cshow :: TextureParams -> String
show :: TextureParams -> String
$cshowList :: [TextureParams] -> ShowS
showList :: [TextureParams] -> ShowS
Show, (forall (proxy :: * -> *). proxy TextureParams -> Int)
-> (forall (proxy :: * -> *). proxy TextureParams -> Int)
-> (forall (proxy :: * -> *). proxy TextureParams -> Bool)
-> (forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a TextureParams -> m TextureParams)
-> (forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a TextureParams -> TextureParams -> m ())
-> (forall (proxy :: * -> *). proxy TextureParams -> Int)
-> (forall (proxy :: * -> *). proxy TextureParams -> Int)
-> (forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a TextureParams -> m TextureParams)
-> (forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a TextureParams -> TextureParams -> m ())
-> (forall (proxy :: * -> *). proxy TextureParams -> Int)
-> (forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a TextureParams -> m TextureParams)
-> (forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a TextureParams -> TextureParams -> m ())
-> Block TextureParams
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 TextureParams -> Bool
forall (proxy :: * -> *). proxy TextureParams -> Int
forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a TextureParams -> m TextureParams
forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a TextureParams -> TextureParams -> m ()
$calignment140 :: forall (proxy :: * -> *). proxy TextureParams -> Int
alignment140 :: forall (proxy :: * -> *). proxy TextureParams -> Int
$csizeOf140 :: forall (proxy :: * -> *). proxy TextureParams -> Int
sizeOf140 :: forall (proxy :: * -> *). proxy TextureParams -> Int
$cisStruct :: forall (proxy :: * -> *). proxy TextureParams -> Bool
isStruct :: forall (proxy :: * -> *). proxy TextureParams -> Bool
$cread140 :: forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a TextureParams -> m TextureParams
read140 :: forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a TextureParams -> m TextureParams
$cwrite140 :: forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a TextureParams -> TextureParams -> m ()
write140 :: forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a TextureParams -> TextureParams -> m ()
$calignment430 :: forall (proxy :: * -> *). proxy TextureParams -> Int
alignment430 :: forall (proxy :: * -> *). proxy TextureParams -> Int
$csizeOf430 :: forall (proxy :: * -> *). proxy TextureParams -> Int
sizeOf430 :: forall (proxy :: * -> *). proxy TextureParams -> Int
$cread430 :: forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a TextureParams -> m TextureParams
read430 :: forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a TextureParams -> m TextureParams
$cwrite430 :: forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a TextureParams -> TextureParams -> m ()
write430 :: forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a TextureParams -> TextureParams -> m ()
$csizeOfPacked :: forall (proxy :: * -> *). proxy TextureParams -> Int
sizeOfPacked :: forall (proxy :: * -> *). proxy TextureParams -> Int
$creadPacked :: forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a TextureParams -> m TextureParams
readPacked :: forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a TextureParams -> m TextureParams
$cwritePacked :: forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a TextureParams -> TextureParams -> m ()
writePacked :: forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a TextureParams -> TextureParams -> m ()
Block)
deriving Ptr TextureParams -> IO TextureParams
Ptr TextureParams -> Int -> IO TextureParams
Ptr TextureParams -> Int -> TextureParams -> IO ()
Ptr TextureParams -> TextureParams -> IO ()
TextureParams -> Int
(TextureParams -> Int)
-> (TextureParams -> Int)
-> (Ptr TextureParams -> Int -> IO TextureParams)
-> (Ptr TextureParams -> Int -> TextureParams -> IO ())
-> (forall b. Ptr b -> Int -> IO TextureParams)
-> (forall b. Ptr b -> Int -> TextureParams -> IO ())
-> (Ptr TextureParams -> IO TextureParams)
-> (Ptr TextureParams -> TextureParams -> IO ())
-> Storable TextureParams
forall b. Ptr b -> Int -> IO TextureParams
forall b. Ptr b -> Int -> TextureParams -> 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 :: TextureParams -> Int
sizeOf :: TextureParams -> Int
$calignment :: TextureParams -> Int
alignment :: TextureParams -> Int
$cpeekElemOff :: Ptr TextureParams -> Int -> IO TextureParams
peekElemOff :: Ptr TextureParams -> Int -> IO TextureParams
$cpokeElemOff :: Ptr TextureParams -> Int -> TextureParams -> IO ()
pokeElemOff :: Ptr TextureParams -> Int -> TextureParams -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO TextureParams
peekByteOff :: forall b. Ptr b -> Int -> IO TextureParams
$cpokeByteOff :: forall b. Ptr b -> Int -> TextureParams -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> TextureParams -> IO ()
$cpeek :: Ptr TextureParams -> IO TextureParams
peek :: Ptr TextureParams -> IO TextureParams
$cpoke :: Ptr TextureParams -> TextureParams -> IO ()
poke :: Ptr TextureParams -> TextureParams -> IO ()
Storable via (Block.Packed TextureParams)
instance Zero TextureParams where
zero :: TextureParams
zero = TextureParams
{ $sel:tpScale:TextureParams :: Vec2
tpScale = Vec2
1.0
, $sel:tpOffset:TextureParams :: Vec2
tpOffset = Vec2
0.0
, $sel:tpGamma:TextureParams :: Vec4
tpGamma = Vec4
1.0
, $sel:tpSamplerId:TextureParams :: Int32
tpSamplerId = Int32
forall a. Bounded a => a
minBound
, $sel:tpTextureId:TextureParams :: Int32
tpTextureId = Int32
forall a. Bounded a => a
minBound
}
instance HasVkFormat TextureParams where
getVkFormat :: [Format]
getVkFormat =
[ Format
Vk.FORMAT_R32G32B32A32_SFLOAT
, Format
Vk.FORMAT_R32G32B32A32_SFLOAT
, Format
Vk.FORMAT_R32G32_SINT
]