module Render.Debug.Model
  ( Model
  , VertexAttrs
  , vkVertexAttrs

  , InstanceAttrs(..)
  , instanceAttrs

  , StorableAttrs
  , storableAttrs1

  , InstanceBuffers(..)

  , TextureParams(..)
  , vkInstanceTexture

    -- TODO: extract and merge with UnlitTextured
  , allocateInstancesWith
  , allocateInstancesCoherent
  , allocateInstancesCoherent_
  , updateCoherentResize_
  , Transform
  ) where

import RIO


import Foreign (Storable(..))
import Geomancy (Transform, Vec2, Vec4)
import Geomancy.Vec3 qualified as Vec3
import RIO.Vector.Storable qualified as Storable
import UnliftIO.Resource (MonadResource, ReleaseKey, ResourceT, allocate)
import Vulkan.Core10 qualified as Vk
import Vulkan.NamedType ((:::))
import Vulkan.Zero (Zero(..))

import Engine.Vulkan.Types (HasVulkan)
import Resource.Buffer qualified as Buffer
import Resource.Model qualified as Model

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

type VertexAttrs = "uv" ::: Vec2

vkVertexAttrs :: [Vk.Format]
vkVertexAttrs :: [Format]
vkVertexAttrs =
  [ Format
Vk.FORMAT_R32G32_SFLOAT -- vTexCoord :: vec2
  ]

-- | Data for a single element.
data InstanceAttrs = InstanceAttrs
  { InstanceAttrs -> TextureParams
textureParams :: TextureParams
  , InstanceAttrs -> Transform
transformMat4 :: Transform
  }

instance Zero InstanceAttrs where
  zero :: InstanceAttrs
zero = InstanceAttrs :: TextureParams -> Transform -> InstanceAttrs
InstanceAttrs
    { $sel:textureParams:InstanceAttrs :: TextureParams
textureParams = TextureParams
forall a. Zero a => a
zero
    , $sel:transformMat4:InstanceAttrs :: Transform
transformMat4 = Transform
forall a. Monoid a => a
mempty
    }

instanceAttrs :: Int32 -> Int32 -> [Transform] -> InstanceAttrs
instanceAttrs :: Int32 -> Int32 -> [Transform] -> InstanceAttrs
instanceAttrs Int32
samplerId Int32
textureId [Transform]
transforms = InstanceAttrs :: TextureParams -> Transform -> InstanceAttrs
InstanceAttrs
  { $sel:textureParams:InstanceAttrs :: TextureParams
textureParams = TextureParams
forall a. Zero a => a
zero
      { $sel:tpSamplerId:TextureParams :: Int32
tpSamplerId = Int32
samplerId
      , $sel:tpTextureId:TextureParams :: Int32
tpTextureId = Int32
textureId
      }
  , $sel:transformMat4:InstanceAttrs :: Transform
transformMat4 = [Transform] -> Transform
forall a. Monoid a => [a] -> a
mconcat [Transform]
transforms
  }

-- | Intermediate data to be shipped.
type StorableAttrs =
  ( Storable.Vector TextureParams
  , Storable.Vector Transform
  )

storableAttrs1 :: Int32 -> Int32 -> [Transform] -> StorableAttrs
storableAttrs1 :: Int32 -> Int32 -> [Transform] -> StorableAttrs
storableAttrs1 Int32
samplerId Int32
textureId [Transform]
transforms =
  ( TextureParams -> Vector TextureParams
forall a. Storable a => a -> Vector a
Storable.singleton TextureParams
textureParams
  , Transform -> Vector Transform
forall a. Storable a => a -> Vector a
Storable.singleton Transform
transformMat4
  )
  where
    InstanceAttrs{Transform
TextureParams
transformMat4 :: Transform
textureParams :: TextureParams
$sel:transformMat4:InstanceAttrs :: InstanceAttrs -> Transform
$sel:textureParams:InstanceAttrs :: InstanceAttrs -> TextureParams
..} = Int32 -> Int32 -> [Transform] -> InstanceAttrs
instanceAttrs
      Int32
samplerId
      Int32
textureId
      [Transform]
transforms

-- | GPU-bound data.
data InstanceBuffers textureStage transformStage = InstanceBuffers
  { forall (textureStage :: Store) (transformStage :: Store).
InstanceBuffers textureStage transformStage
-> InstanceTexture textureStage
ibTexture   :: InstanceTexture textureStage
  , forall (textureStage :: Store) (transformStage :: Store).
InstanceBuffers textureStage transformStage
-> InstanceTransform transformStage
ibTransform :: InstanceTransform transformStage
  }

type InstanceTexture stage = Buffer.Allocated stage TextureParams

type InstanceTransform stage = Buffer.Allocated stage Transform

instance Model.HasVertexBuffers (InstanceBuffers textureStage transformStage) where
  type VertexBuffersOf (InstanceBuffers textureStage transformStage) = InstanceAttrs

  {-# INLINE getVertexBuffers #-}
  getVertexBuffers :: InstanceBuffers textureStage transformStage -> [Buffer]
getVertexBuffers InstanceBuffers{InstanceTexture textureStage
InstanceTransform transformStage
ibTransform :: InstanceTransform transformStage
ibTexture :: InstanceTexture textureStage
$sel:ibTransform:InstanceBuffers :: forall (textureStage :: Store) (transformStage :: Store).
InstanceBuffers textureStage transformStage
-> InstanceTransform transformStage
$sel:ibTexture:InstanceBuffers :: forall (textureStage :: Store) (transformStage :: Store).
InstanceBuffers textureStage transformStage
-> InstanceTexture textureStage
..} =
    [ InstanceTexture textureStage -> Buffer
forall (s :: Store) a. Allocated s a -> Buffer
Buffer.aBuffer InstanceTexture textureStage
ibTexture
    , InstanceTransform transformStage -> Buffer
forall (s :: Store) a. Allocated s a -> Buffer
Buffer.aBuffer InstanceTransform transformStage
ibTransform
    ]

  {-# INLINE getInstanceCount #-}
  getInstanceCount :: InstanceBuffers textureStage transformStage -> Word32
getInstanceCount InstanceBuffers{InstanceTexture textureStage
InstanceTransform transformStage
ibTransform :: InstanceTransform transformStage
ibTexture :: InstanceTexture textureStage
$sel:ibTransform:InstanceBuffers :: forall (textureStage :: Store) (transformStage :: Store).
InstanceBuffers textureStage transformStage
-> InstanceTransform transformStage
$sel:ibTexture:InstanceBuffers :: forall (textureStage :: Store) (transformStage :: Store).
InstanceBuffers textureStage transformStage
-> InstanceTexture textureStage
..} =
    Word32 -> Word32 -> Word32
forall a. Ord a => a -> a -> a
min
      (InstanceTexture textureStage -> Word32
forall (s :: Store) a. Allocated s a -> Word32
Buffer.aUsed InstanceTexture textureStage
ibTexture)
      (InstanceTransform transformStage -> Word32
forall (s :: Store) a. Allocated s a -> Word32
Buffer.aUsed InstanceTransform transformStage
ibTransform)

data TextureParams = TextureParams
  { TextureParams -> Vec2
tpScale     :: Vec2
  , TextureParams -> Vec2
tpOffset    :: Vec2
  , TextureParams -> Vec4
tpGamma     :: Vec4
  , TextureParams -> Int32
tpSamplerId :: Int32
  , TextureParams -> Int32
tpTextureId :: Int32
  }
  deriving (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
showList :: [TextureParams] -> ShowS
$cshowList :: [TextureParams] -> ShowS
show :: TextureParams -> String
$cshow :: TextureParams -> String
showsPrec :: Int -> TextureParams -> ShowS
$cshowsPrec :: Int -> TextureParams -> ShowS
Show)

instance Zero TextureParams where
  zero :: TextureParams
zero = TextureParams :: Vec2 -> Vec2 -> Vec4 -> Int32 -> Int32 -> TextureParams
TextureParams
    { $sel:tpScale:TextureParams :: Vec2
tpScale     = Vec2
1
    , $sel:tpOffset:TextureParams :: Vec2
tpOffset    = Vec2
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 Storable TextureParams where
  alignment :: TextureParams -> Int
alignment ~TextureParams
_ = Int
4

  sizeOf :: TextureParams -> Int
sizeOf ~TextureParams
_ = 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
16 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4

  poke :: Ptr TextureParams -> TextureParams -> IO ()
poke Ptr TextureParams
ptr TextureParams{Int32
Vec2
Vec4
tpTextureId :: Int32
tpSamplerId :: Int32
tpGamma :: Vec4
tpOffset :: Vec2
tpScale :: Vec2
$sel:tpGamma:TextureParams :: TextureParams -> Vec4
$sel:tpOffset:TextureParams :: TextureParams -> Vec2
$sel:tpScale:TextureParams :: TextureParams -> Vec2
$sel:tpTextureId:TextureParams :: TextureParams -> Int32
$sel:tpSamplerId:TextureParams :: TextureParams -> Int32
..} = do
    Ptr TextureParams -> Int -> Vec2 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr TextureParams
ptr  Int
0 Vec2
tpScale
    Ptr TextureParams -> Int -> Vec2 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr TextureParams
ptr  Int
8 Vec2
tpOffset
    Ptr TextureParams -> Int -> Vec4 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr TextureParams
ptr Int
16 Vec4
tpGamma
    Ptr TextureParams -> Int -> Int32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr TextureParams
ptr Int
32 Int32
tpSamplerId
    Ptr TextureParams -> Int -> Int32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr TextureParams
ptr Int
36 Int32
tpTextureId

  peek :: Ptr TextureParams -> IO TextureParams
peek Ptr TextureParams
ptr = do
    Vec2
tpScale     <- Ptr TextureParams -> Int -> IO Vec2
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr TextureParams
ptr  Int
0
    Vec2
tpOffset    <- Ptr TextureParams -> Int -> IO Vec2
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr TextureParams
ptr  Int
8
    Vec4
tpGamma     <- Ptr TextureParams -> Int -> IO Vec4
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr TextureParams
ptr Int
16
    Int32
tpSamplerId <- Ptr TextureParams -> Int -> IO Int32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr TextureParams
ptr Int
32
    Int32
tpTextureId <- Ptr TextureParams -> Int -> IO Int32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr TextureParams
ptr Int
36
    pure TextureParams :: Vec2 -> Vec2 -> Vec4 -> Int32 -> Int32 -> TextureParams
TextureParams{Int32
Vec2
Vec4
tpTextureId :: Int32
tpSamplerId :: Int32
tpGamma :: Vec4
tpOffset :: Vec2
tpScale :: Vec2
$sel:tpGamma:TextureParams :: Vec4
$sel:tpOffset:TextureParams :: Vec2
$sel:tpScale:TextureParams :: Vec2
$sel:tpTextureId:TextureParams :: Int32
$sel:tpSamplerId:TextureParams :: Int32
..}

vkInstanceTexture :: [Vk.Format]
vkInstanceTexture :: [Format]
vkInstanceTexture =
  [ Format
Vk.FORMAT_R32G32B32A32_SFLOAT -- iTextureScaleOffset :: vec4
  , Format
Vk.FORMAT_R32G32B32A32_SFLOAT -- iTextureGamma       :: vec4
  , Format
Vk.FORMAT_R32G32_SINT         -- iTextureIds         :: ivec2
  ]

allocateInstancesWith
  :: ( MonadResource m
     , MonadUnliftIO m
     )
  => (Vk.BufferUsageFlagBits -> Int -> Storable.Vector TextureParams -> m (InstanceTexture texture))
  -> (Vk.BufferUsageFlagBits -> Int -> Storable.Vector Transform -> m (InstanceTransform transform))
  -> (forall stage a . Buffer.Allocated stage a -> m ())
  -> [InstanceAttrs]
  -> m (ReleaseKey, InstanceBuffers texture transform)
allocateInstancesWith :: forall (m :: * -> *) (texture :: Store) (transform :: Store).
(MonadResource m, MonadUnliftIO m) =>
(BufferUsageFlagBits
 -> Int -> Vector TextureParams -> m (InstanceTexture texture))
-> (BufferUsageFlagBits
    -> Int -> Vector Transform -> m (InstanceTransform transform))
-> (forall (stage :: Store) a. Allocated stage a -> m ())
-> [InstanceAttrs]
-> m (ReleaseKey, InstanceBuffers texture transform)
allocateInstancesWith BufferUsageFlagBits
-> Int -> Vector TextureParams -> m (InstanceTexture texture)
createTextures BufferUsageFlagBits
-> Int -> Vector Transform -> m (InstanceTransform transform)
createTransforms forall (stage :: Store) a. Allocated stage a -> m ()
bufferDestroy [InstanceAttrs]
instances = do
  UnliftIO m
ul <- m (UnliftIO m)
forall (m :: * -> *). MonadUnliftIO m => m (UnliftIO m)
askUnliftIO
  IO (InstanceBuffers texture transform)
-> (InstanceBuffers texture transform -> IO ())
-> m (ReleaseKey, InstanceBuffers texture transform)
forall (m :: * -> *) a.
MonadResource m =>
IO a -> (a -> IO ()) -> m (ReleaseKey, a)
allocate (UnliftIO m -> IO (InstanceBuffers texture transform)
create UnliftIO m
ul) (UnliftIO m -> InstanceBuffers texture transform -> IO ()
destroy UnliftIO m
ul)
  where
    textures :: Vector TextureParams
textures   = [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
$ (InstanceAttrs -> TextureParams)
-> [InstanceAttrs] -> [TextureParams]
forall a b. (a -> b) -> [a] -> [b]
map InstanceAttrs -> TextureParams
textureParams [InstanceAttrs]
instances
    transforms :: 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
$ (InstanceAttrs -> Transform) -> [InstanceAttrs] -> [Transform]
forall a b. (a -> b) -> [a] -> [b]
map InstanceAttrs -> Transform
transformMat4 [InstanceAttrs]
instances
    numInstances :: Int
numInstances = Vector TextureParams -> Int
forall a. Storable a => Vector a -> Int
Storable.length Vector TextureParams
textures

    create :: UnliftIO m -> IO (InstanceBuffers texture transform)
create (UnliftIO forall a. m a -> IO a
ul) = m (InstanceBuffers texture transform)
-> IO (InstanceBuffers texture transform)
forall a. m a -> IO a
ul do
      InstanceTexture texture
ibTexture   <- BufferUsageFlagBits
-> Int -> Vector TextureParams -> m (InstanceTexture texture)
createTextures   BufferUsageFlagBits
Vk.BUFFER_USAGE_VERTEX_BUFFER_BIT Int
numInstances Vector TextureParams
textures
      InstanceTransform transform
ibTransform <- BufferUsageFlagBits
-> Int -> Vector Transform -> m (InstanceTransform transform)
createTransforms BufferUsageFlagBits
Vk.BUFFER_USAGE_VERTEX_BUFFER_BIT Int
numInstances Vector Transform
transforms
      pure InstanceBuffers :: forall (textureStage :: Store) (transformStage :: Store).
InstanceTexture textureStage
-> InstanceTransform transformStage
-> InstanceBuffers textureStage transformStage
InstanceBuffers{InstanceTexture texture
InstanceTransform transform
ibTransform :: InstanceTransform transform
ibTexture :: InstanceTexture texture
$sel:ibTransform:InstanceBuffers :: InstanceTransform transform
$sel:ibTexture:InstanceBuffers :: InstanceTexture texture
..}

    destroy :: UnliftIO m -> InstanceBuffers texture transform -> IO ()
destroy (UnliftIO forall a. m a -> IO a
ul) InstanceBuffers{InstanceTexture texture
InstanceTransform transform
ibTransform :: InstanceTransform transform
ibTexture :: InstanceTexture texture
$sel:ibTransform:InstanceBuffers :: forall (textureStage :: Store) (transformStage :: Store).
InstanceBuffers textureStage transformStage
-> InstanceTransform transformStage
$sel:ibTexture:InstanceBuffers :: forall (textureStage :: Store) (transformStage :: Store).
InstanceBuffers textureStage transformStage
-> InstanceTexture textureStage
..} = m () -> IO ()
forall a. m a -> IO a
ul do
      InstanceTexture texture -> m ()
forall (stage :: Store) a. Allocated stage a -> m ()
bufferDestroy InstanceTexture texture
ibTexture
      InstanceTransform transform -> m ()
forall (stage :: Store) a. Allocated stage a -> m ()
bufferDestroy InstanceTransform transform
ibTransform

allocateInstancesCoherent
  :: ( MonadReader env m
     , HasVulkan env
     , MonadResource m
     , MonadUnliftIO m
     )
  => [InstanceAttrs]
  -> m (ReleaseKey, InstanceBuffers 'Buffer.Coherent 'Buffer.Coherent)
allocateInstancesCoherent :: forall env (m :: * -> *).
(MonadReader env m, HasVulkan env, MonadResource m,
 MonadUnliftIO m) =>
[InstanceAttrs]
-> m (ReleaseKey, InstanceBuffers 'Coherent 'Coherent)
allocateInstancesCoherent [InstanceAttrs]
instances = do
  env
context <- m env
forall r (m :: * -> *). MonadReader r m => m r
ask
  (BufferUsageFlagBits
 -> Int -> Vector TextureParams -> m (InstanceTexture 'Coherent))
-> (BufferUsageFlagBits
    -> Int -> Vector Transform -> m (InstanceTransform 'Coherent))
-> (forall (stage :: Store) a. Allocated stage a -> m ())
-> [InstanceAttrs]
-> m (ReleaseKey, InstanceBuffers 'Coherent 'Coherent)
forall (m :: * -> *) (texture :: Store) (transform :: Store).
(MonadResource m, MonadUnliftIO m) =>
(BufferUsageFlagBits
 -> Int -> Vector TextureParams -> m (InstanceTexture texture))
-> (BufferUsageFlagBits
    -> Int -> Vector Transform -> m (InstanceTransform transform))
-> (forall (stage :: Store) a. Allocated stage a -> m ())
-> [InstanceAttrs]
-> m (ReleaseKey, InstanceBuffers texture transform)
allocateInstancesWith
    (env
-> BufferUsageFlagBits
-> Int
-> Vector TextureParams
-> m (InstanceTexture 'Coherent)
forall a context (io :: * -> *).
(Storable a, HasVulkan context, MonadUnliftIO io) =>
context
-> BufferUsageFlagBits
-> Int
-> Vector a
-> io (Allocated 'Coherent a)
Buffer.createCoherent env
context)
    (env
-> BufferUsageFlagBits
-> Int
-> Vector Transform
-> m (InstanceTransform 'Coherent)
forall a context (io :: * -> *).
(Storable a, HasVulkan context, MonadUnliftIO io) =>
context
-> BufferUsageFlagBits
-> Int
-> Vector a
-> io (Allocated 'Coherent a)
Buffer.createCoherent env
context)
    (env -> Allocated stage a -> m ()
forall (io :: * -> *) context (s :: Store) a.
(MonadUnliftIO io, HasVulkan context) =>
context -> Allocated s a -> io ()
Buffer.destroy env
context)
    [InstanceAttrs]
instances

allocateInstancesCoherent_
  :: (HasVulkan env)
  => Int
  -> ResourceT (RIO env) (InstanceBuffers 'Buffer.Coherent 'Buffer.Coherent)
allocateInstancesCoherent_ :: forall env.
HasVulkan env =>
Int -> ResourceT (RIO env) (InstanceBuffers 'Coherent 'Coherent)
allocateInstancesCoherent_ Int
n =
  ((ReleaseKey, InstanceBuffers 'Coherent 'Coherent)
 -> InstanceBuffers 'Coherent 'Coherent)
-> ResourceT
     (RIO env) (ReleaseKey, InstanceBuffers 'Coherent 'Coherent)
-> ResourceT (RIO env) (InstanceBuffers 'Coherent 'Coherent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ReleaseKey, InstanceBuffers 'Coherent 'Coherent)
-> InstanceBuffers 'Coherent 'Coherent
forall a b. (a, b) -> b
snd (ResourceT
   (RIO env) (ReleaseKey, InstanceBuffers 'Coherent 'Coherent)
 -> ResourceT (RIO env) (InstanceBuffers 'Coherent 'Coherent))
-> ResourceT
     (RIO env) (ReleaseKey, InstanceBuffers 'Coherent 'Coherent)
-> ResourceT (RIO env) (InstanceBuffers 'Coherent 'Coherent)
forall a b. (a -> b) -> a -> b
$ [InstanceAttrs]
-> ResourceT
     (RIO env) (ReleaseKey, InstanceBuffers 'Coherent 'Coherent)
forall env (m :: * -> *).
(MonadReader env m, HasVulkan env, MonadResource m,
 MonadUnliftIO m) =>
[InstanceAttrs]
-> m (ReleaseKey, InstanceBuffers 'Coherent 'Coherent)
allocateInstancesCoherent (Int -> InstanceAttrs -> [InstanceAttrs]
forall a. Int -> a -> [a]
replicate Int
n InstanceAttrs
forall a. Zero a => a
zero)

updateCoherentResize_
  :: ( HasVulkan context
     , MonadUnliftIO m
     )
  => context
  -> InstanceBuffers 'Buffer.Coherent 'Buffer.Coherent
  -> (Storable.Vector TextureParams, Storable.Vector Transform)
  -> m (InstanceBuffers 'Buffer.Coherent 'Buffer.Coherent)
updateCoherentResize_ :: forall context (m :: * -> *).
(HasVulkan context, MonadUnliftIO m) =>
context
-> InstanceBuffers 'Coherent 'Coherent
-> StorableAttrs
-> m (InstanceBuffers 'Coherent 'Coherent)
updateCoherentResize_ context
context InstanceBuffers{InstanceTransform 'Coherent
InstanceTexture 'Coherent
ibTransform :: InstanceTransform 'Coherent
ibTexture :: InstanceTexture 'Coherent
$sel:ibTransform:InstanceBuffers :: forall (textureStage :: Store) (transformStage :: Store).
InstanceBuffers textureStage transformStage
-> InstanceTransform transformStage
$sel:ibTexture:InstanceBuffers :: forall (textureStage :: Store) (transformStage :: Store).
InstanceBuffers textureStage transformStage
-> InstanceTexture textureStage
..} (Vector TextureParams
textures, Vector Transform
transforms) =
  InstanceTexture 'Coherent
-> InstanceTransform 'Coherent
-> InstanceBuffers 'Coherent 'Coherent
forall (textureStage :: Store) (transformStage :: Store).
InstanceTexture textureStage
-> InstanceTransform transformStage
-> InstanceBuffers textureStage transformStage
InstanceBuffers
    (InstanceTexture 'Coherent
 -> InstanceTransform 'Coherent
 -> InstanceBuffers 'Coherent 'Coherent)
-> m (InstanceTexture 'Coherent)
-> m (InstanceTransform 'Coherent
      -> InstanceBuffers 'Coherent 'Coherent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> context
-> InstanceTexture 'Coherent
-> Vector TextureParams
-> m (InstanceTexture 'Coherent)
forall a context (io :: * -> *).
(Storable a, HasVulkan context, MonadUnliftIO io) =>
context
-> Allocated 'Coherent a -> Vector a -> io (Allocated 'Coherent a)
Buffer.updateCoherentResize_ context
context InstanceTexture 'Coherent
ibTexture Vector TextureParams
textures
    m (InstanceTransform 'Coherent
   -> InstanceBuffers 'Coherent 'Coherent)
-> m (InstanceTransform 'Coherent)
-> m (InstanceBuffers 'Coherent 'Coherent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> context
-> InstanceTransform 'Coherent
-> Vector Transform
-> m (InstanceTransform 'Coherent)
forall a context (io :: * -> *).
(Storable a, HasVulkan context, MonadUnliftIO io) =>
context
-> Allocated 'Coherent a -> Vector a -> io (Allocated 'Coherent a)
Buffer.updateCoherentResize_ context
context InstanceTransform 'Coherent
ibTransform Vector Transform
transforms