{-# OPTIONS_GHC -fplugin Foreign.Storable.Generic.Plugin #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE OverloadedRecordDot #-}
module Render.Debug.Model
( Model
, Vertex
, VertexAttrs
, AttrsF(..)
, Attrs
, attrs
, Stores
, stores1
, Buffers
, TextureParams(..)
, ObserverCoherent
) where
import RIO
import Foreign.Storable.Generic (GStorable)
import Geomancy (Transform, Vec2)
import Geomancy.Vec3 qualified as Vec3
import RIO.Vector.Storable qualified as Storable
import Vulkan.NamedType ((:::))
import Vulkan.Zero (Zero(..))
import Engine.Types (HKD)
import Engine.Vulkan.Pipeline.Graphics (HasVertexInputBindings(..), instanceFormat)
import Engine.Worker qualified as Worker
import Render.Unlit.Textured.Model (TextureParams(..))
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 GStorable 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
}
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