module Render.Draw
  ( triangle_
  , triangles_
  , quads

  , indexed
  , indexedRanges
  , indexedParts

  , indexedPos
  , indexedPosRanges

  , unsafeIndexedRanges
  , unsafeIndexedParts
  ) where

import RIO

import Data.Vector qualified as Vector
import Vulkan.Core10 qualified as Vk

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

-- * Primitives

-- | Single triangle, binding nothing.
triangle_ :: MonadUnliftIO m => Vk.CommandBuffer -> Bound dsl () () m ()
triangle_ :: forall (m :: * -> *) (dsl :: [*]).
MonadUnliftIO m =>
CommandBuffer -> Bound dsl () () m ()
triangle_ CommandBuffer
cb = CommandBuffer -> Word32 -> Bound dsl () () m ()
forall (m :: * -> *) (dsl :: [*]).
MonadUnliftIO m =>
CommandBuffer -> Word32 -> Bound dsl () () m ()
triangles_ CommandBuffer
cb Word32
1

-- | Multiple shader-driven triangles without bindings.
triangles_ :: MonadUnliftIO m => Vk.CommandBuffer -> Word32 -> Bound dsl () () m ()
triangles_ :: forall (m :: * -> *) (dsl :: [*]).
MonadUnliftIO m =>
CommandBuffer -> Word32 -> Bound dsl () () m ()
triangles_ CommandBuffer
cb Word32
num =
  m () -> Bound dsl () () m ()
forall {k} {k1} {k2} (dsl :: [*]) (vertices :: k) (instances :: k1)
       (m :: k2 -> *) (a :: k2).
m a -> Bound dsl vertices instances m a
Bound (m () -> Bound dsl () () m ()) -> m () -> Bound dsl () () m ()
forall a b. (a -> b) -> a -> b
$ CommandBuffer -> Word32 -> Word32 -> Word32 -> Word32 -> m ()
forall (io :: * -> *).
MonadIO io =>
CommandBuffer -> Word32 -> Word32 -> Word32 -> Word32 -> io ()
Vk.cmdDraw CommandBuffer
cb Word32
3 Word32
num Word32
0 Word32
0

-- | Instanced quads.
quads
  :: MonadUnliftIO m
  => Vk.CommandBuffer
  -> Buffer.Allocated stage instances
  -> Bound dsl () instances m ()
quads :: forall {k1} (m :: * -> *) (stage :: Store) (instances :: k1)
       (dsl :: [*]).
MonadUnliftIO m =>
CommandBuffer
-> Allocated stage instances -> Bound dsl () instances m ()
quads CommandBuffer
cb Allocated stage instances
instances = m () -> Bound dsl () instances m ()
forall {k} {k1} {k2} (dsl :: [*]) (vertices :: k) (instances :: k1)
       (m :: k2 -> *) (a :: k2).
m a -> Bound dsl vertices instances m a
Bound do
  CommandBuffer
-> Word32
-> ("buffers" ::: Vector Buffer)
-> ("offsets" ::: Vector DeviceSize)
-> m ()
forall (io :: * -> *).
MonadIO io =>
CommandBuffer
-> Word32
-> ("buffers" ::: Vector Buffer)
-> ("offsets" ::: Vector DeviceSize)
-> io ()
Vk.cmdBindVertexBuffers CommandBuffer
cb Word32
0 (Buffer -> "buffers" ::: Vector Buffer
forall a. a -> Vector a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Buffer -> "buffers" ::: Vector Buffer)
-> Buffer -> "buffers" ::: Vector Buffer
forall a b. (a -> b) -> a -> b
$ Allocated stage instances -> Buffer
forall {k} (s :: Store) (a :: k). Allocated s a -> Buffer
Buffer.aBuffer Allocated stage instances
instances) (DeviceSize -> "offsets" ::: Vector DeviceSize
forall a. a -> Vector a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DeviceSize
0)
  CommandBuffer -> Word32 -> Word32 -> Word32 -> Word32 -> m ()
forall (io :: * -> *).
MonadIO io =>
CommandBuffer -> Word32 -> Word32 -> Word32 -> Word32 -> io ()
Vk.cmdDraw CommandBuffer
cb Word32
6 (Allocated stage instances -> Word32
forall {k} (s :: Store) (a :: k). Allocated s a -> Word32
Buffer.aUsed Allocated stage instances
instances) Word32
0 Word32
0

-- * Indexed models

-- ** Positions + attributes

-- | Draw whole-model instances.
indexed
  :: (MonadUnliftIO m, Model.HasVertexBuffers instances)
  => Vk.CommandBuffer
  -> Model.Indexed storage pos attrs
  -> instances
  -> Bound dsl (Model.Vertex pos attrs) (Model.VertexBuffersOf instances) m ()
indexed :: forall (m :: * -> *) instances (storage :: Store) pos attrs
       (dsl :: [*]).
(MonadUnliftIO m, HasVertexBuffers instances) =>
CommandBuffer
-> Indexed storage pos attrs
-> instances
-> Bound dsl (Vertex pos attrs) (VertexBuffersOf instances) m ()
indexed CommandBuffer
cmd Indexed storage pos attrs
model instances
instances = CommandBuffer
-> Indexed storage pos attrs
-> instances
-> [IndexRange]
-> Bound dsl (Vertex pos attrs) (VertexBuffersOf instances) m ()
forall (m :: * -> *) instances (storage :: Store) pos attrs
       (dsl :: [*]).
(MonadUnliftIO m, HasVertexBuffers instances) =>
CommandBuffer
-> Indexed storage pos attrs
-> instances
-> [IndexRange]
-> Bound dsl (Vertex pos attrs) (VertexBuffersOf instances) m ()
indexedRanges CommandBuffer
cmd Indexed storage pos attrs
model instances
instances [IndexRange
wholeIndexed]
  where
    wholeIndexed :: IndexRange
wholeIndexed = Model.IndexRange
      { $sel:irFirstIndex:IndexRange :: Word32
irFirstIndex = Word32
0
      , $sel:irIndexCount:IndexRange :: Word32
irIndexCount = Allocated storage Word32 -> Word32
forall {k} (s :: Store) (a :: k). Allocated s a -> Word32
Buffer.aUsed (Indexed storage pos attrs -> Allocated storage Word32
forall {k1} {k2} (storage :: Store) (pos :: k1) (attrs :: k2).
Indexed storage pos attrs -> Allocated storage Word32
Model.iIndices Indexed storage pos attrs
model)
      }

{- |
  Draw subrange of each instance.

  E.g. chunks of the same material drawn in different places.
-}
indexedRanges
  :: (MonadUnliftIO m, Model.HasVertexBuffers instances)
  => Vk.CommandBuffer
  -> Model.Indexed storage pos attrs
  -> instances
  -> [Model.IndexRange]
  -> Bound dsl (Model.Vertex pos attrs) (Model.VertexBuffersOf instances) m ()
indexedRanges :: forall (m :: * -> *) instances (storage :: Store) pos attrs
       (dsl :: [*]).
(MonadUnliftIO m, HasVertexBuffers instances) =>
CommandBuffer
-> Indexed storage pos attrs
-> instances
-> [IndexRange]
-> Bound dsl (Vertex pos attrs) (VertexBuffersOf instances) m ()
indexedRanges CommandBuffer
cmd Indexed storage pos attrs
model instances
instances [IndexRange]
ranges = do
  [IndexRange]
checkedRanges <- (IndexRange
 -> Bound
      dsl (Vertex pos attrs) (VertexBuffersOf instances) m IndexRange)
-> [IndexRange]
-> Bound
     dsl (Vertex pos attrs) (VertexBuffersOf instances) m [IndexRange]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse IndexRange
-> Bound
     dsl (Vertex pos attrs) (VertexBuffersOf instances) m IndexRange
check [IndexRange]
ranges
  m ()
-> Bound dsl (Vertex pos attrs) (VertexBuffersOf instances) m ()
forall {k} {k1} {k2} (dsl :: [*]) (vertices :: k) (instances :: k1)
       (m :: k2 -> *) (a :: k2).
m a -> Bound dsl vertices instances m a
Bound (m ()
 -> Bound dsl (Vertex pos attrs) (VertexBuffersOf instances) m ())
-> m ()
-> Bound dsl (Vertex pos attrs) (VertexBuffersOf instances) m ()
forall a b. (a -> b) -> a -> b
$ Bool
-> CommandBuffer
-> Indexed storage pos attrs
-> instances
-> [IndexRange]
-> m ()
forall {k} {k1} (io :: * -> *) instances (t :: * -> *)
       (storage :: Store) (pos :: k) (attrs :: k1).
(MonadUnliftIO io, HasVertexBuffers instances, Foldable t) =>
Bool
-> CommandBuffer
-> Indexed storage pos attrs
-> instances
-> t IndexRange
-> io ()
unsafeIndexedRanges Bool
True CommandBuffer
cmd Indexed storage pos attrs
model instances
instances [IndexRange]
checkedRanges
  where
    check :: IndexRange
-> Bound
     dsl (Vertex pos attrs) (VertexBuffersOf instances) m IndexRange
check ir :: IndexRange
ir@Model.IndexRange{Word32
$sel:irFirstIndex:IndexRange :: IndexRange -> Word32
$sel:irIndexCount:IndexRange :: IndexRange -> Word32
irFirstIndex :: Word32
irIndexCount :: Word32
..}
      | Word32
irFirstIndex Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
> Word32
maxIndex =
          String
-> Bound
     dsl (Vertex pos attrs) (VertexBuffersOf instances) m IndexRange
forall (m :: * -> *) a. (MonadIO m, HasCallStack) => String -> m a
throwString String
"firstIndex is over the actual buffer size"
      | Word32
irFirstIndex Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
irIndexCount Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
> Word32
maxIndex =
          String
-> Bound
     dsl (Vertex pos attrs) (VertexBuffersOf instances) m IndexRange
forall (m :: * -> *) a. (MonadIO m, HasCallStack) => String -> m a
throwString String
"firstIndex + indexCount is over the actual buffer size"
      | Bool
otherwise =
          IndexRange
-> Bound
     dsl (Vertex pos attrs) (VertexBuffersOf instances) m IndexRange
forall a.
a -> Bound dsl (Vertex pos attrs) (VertexBuffersOf instances) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure IndexRange
ir

    maxIndex :: Word32
maxIndex = Allocated storage Word32 -> Word32
forall {k} (s :: Store) (a :: k). Allocated s a -> Word32
Buffer.aUsed (Indexed storage pos attrs -> Allocated storage Word32
forall {k1} {k2} (storage :: Store) (pos :: k1) (attrs :: k2).
Indexed storage pos attrs -> Allocated storage Word32
Model.iIndices Indexed storage pos attrs
model)

{- |
  Draw ranges and instances zipped.

  E.g. range materials stored in instances.
-}
indexedParts
  :: (MonadUnliftIO m, Model.HasVertexBuffers instances, Foldable t)
  => Bool
  -> Vk.CommandBuffer
  -> Model.Indexed storage pos attrs
  -> instances
  -> Int
  -> t Model.IndexRange
  -> Bound dsl (Model.Vertex pos attrs) (Model.VertexBuffersOf instances) m ()
indexedParts :: forall (m :: * -> *) instances (t :: * -> *) (storage :: Store) pos
       attrs (dsl :: [*]).
(MonadUnliftIO m, HasVertexBuffers instances, Foldable t) =>
Bool
-> CommandBuffer
-> Indexed storage pos attrs
-> instances
-> Int
-> t IndexRange
-> Bound dsl (Vertex pos attrs) (VertexBuffersOf instances) m ()
indexedParts Bool
drawAttrs CommandBuffer
cmd Indexed storage pos attrs
model instances
instances Int
startInstance t IndexRange
parts =
  m ()
-> Bound dsl (Vertex pos attrs) (VertexBuffersOf instances) m ()
forall {k} {k1} {k2} (dsl :: [*]) (vertices :: k) (instances :: k1)
       (m :: k2 -> *) (a :: k2).
m a -> Bound dsl vertices instances m a
Bound (m ()
 -> Bound dsl (Vertex pos attrs) (VertexBuffersOf instances) m ())
-> m ()
-> Bound dsl (Vertex pos attrs) (VertexBuffersOf instances) m ()
forall a b. (a -> b) -> a -> b
$ Bool
-> CommandBuffer
-> Indexed storage pos attrs
-> instances
-> Int
-> t IndexRange
-> m ()
forall {k} {k1} (io :: * -> *) instances (t :: * -> *)
       (storage :: Store) (pos :: k) (attrs :: k1).
(MonadUnliftIO io, HasVertexBuffers instances, Foldable t) =>
Bool
-> CommandBuffer
-> Indexed storage pos attrs
-> instances
-> Int
-> t IndexRange
-> io ()
unsafeIndexedParts Bool
drawAttrs CommandBuffer
cmd Indexed storage pos attrs
model instances
instances Int
startInstance t IndexRange
parts

-- ** Position-only draws

-- | Draw whole-model instances, ignoring attributes.
indexedPos
  :: (MonadUnliftIO m, Model.HasVertexBuffers instances)
  => Vk.CommandBuffer
  -> Model.Indexed storage pos unusedAttrs
  -> instances
  -> Bound dsl (Model.Vertex pos ignoreAttrs) (Model.VertexBuffersOf instances) m ()
indexedPos :: forall {k1} (m :: * -> *) instances (storage :: Store) pos
       (unusedAttrs :: k1) (dsl :: [*]) ignoreAttrs.
(MonadUnliftIO m, HasVertexBuffers instances) =>
CommandBuffer
-> Indexed storage pos unusedAttrs
-> instances
-> Bound
     dsl (Vertex pos ignoreAttrs) (VertexBuffersOf instances) m ()
indexedPos CommandBuffer
cmd Indexed storage pos unusedAttrs
model instances
instances = CommandBuffer
-> Indexed storage pos unusedAttrs
-> instances
-> [IndexRange]
-> Bound
     dsl (Vertex pos ignoreAttrs) (VertexBuffersOf instances) m ()
forall {k1} (m :: * -> *) instances (storage :: Store) pos
       (unusedAttrs :: k1) (dsl :: [*]) ignoreAttrs.
(MonadUnliftIO m, HasVertexBuffers instances) =>
CommandBuffer
-> Indexed storage pos unusedAttrs
-> instances
-> [IndexRange]
-> Bound
     dsl (Vertex pos ignoreAttrs) (VertexBuffersOf instances) m ()
indexedPosRanges CommandBuffer
cmd Indexed storage pos unusedAttrs
model instances
instances [IndexRange
wholeIndexed]
  where
    wholeIndexed :: IndexRange
wholeIndexed = Model.IndexRange
      { $sel:irFirstIndex:IndexRange :: Word32
irFirstIndex = Word32
0
      , $sel:irIndexCount:IndexRange :: Word32
irIndexCount = Allocated storage Word32 -> Word32
forall {k} (s :: Store) (a :: k). Allocated s a -> Word32
Buffer.aUsed (Indexed storage pos unusedAttrs -> Allocated storage Word32
forall {k1} {k2} (storage :: Store) (pos :: k1) (attrs :: k2).
Indexed storage pos attrs -> Allocated storage Word32
Model.iIndices Indexed storage pos unusedAttrs
model)
      }

-- | Draw subrange of each instances, ignoring attributes.
indexedPosRanges
  :: (MonadUnliftIO m, Model.HasVertexBuffers instances)
  => Vk.CommandBuffer
  -> Model.Indexed storage pos unusedAttrs
  -> instances
  -> [Model.IndexRange]
  -> Bound dsl (Model.Vertex pos ignoreAttrs) (Model.VertexBuffersOf instances) m ()
indexedPosRanges :: forall {k1} (m :: * -> *) instances (storage :: Store) pos
       (unusedAttrs :: k1) (dsl :: [*]) ignoreAttrs.
(MonadUnliftIO m, HasVertexBuffers instances) =>
CommandBuffer
-> Indexed storage pos unusedAttrs
-> instances
-> [IndexRange]
-> Bound
     dsl (Vertex pos ignoreAttrs) (VertexBuffersOf instances) m ()
indexedPosRanges CommandBuffer
cmd Indexed storage pos unusedAttrs
model instances
instances [IndexRange]
ranges = do
  [IndexRange]
checkedRanges <- (IndexRange
 -> Bound
      dsl
      (Vertex pos ignoreAttrs)
      (VertexBuffersOf instances)
      m
      IndexRange)
-> [IndexRange]
-> Bound
     dsl
     (Vertex pos ignoreAttrs)
     (VertexBuffersOf instances)
     m
     [IndexRange]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse IndexRange
-> Bound
     dsl
     (Vertex pos ignoreAttrs)
     (VertexBuffersOf instances)
     m
     IndexRange
check [IndexRange]
ranges
  m ()
-> Bound
     dsl (Vertex pos ignoreAttrs) (VertexBuffersOf instances) m ()
forall {k} {k1} {k2} (dsl :: [*]) (vertices :: k) (instances :: k1)
       (m :: k2 -> *) (a :: k2).
m a -> Bound dsl vertices instances m a
Bound (m ()
 -> Bound
      dsl (Vertex pos ignoreAttrs) (VertexBuffersOf instances) m ())
-> m ()
-> Bound
     dsl (Vertex pos ignoreAttrs) (VertexBuffersOf instances) m ()
forall a b. (a -> b) -> a -> b
$ Bool
-> CommandBuffer
-> Indexed storage pos unusedAttrs
-> instances
-> [IndexRange]
-> m ()
forall {k} {k1} (io :: * -> *) instances (t :: * -> *)
       (storage :: Store) (pos :: k) (attrs :: k1).
(MonadUnliftIO io, HasVertexBuffers instances, Foldable t) =>
Bool
-> CommandBuffer
-> Indexed storage pos attrs
-> instances
-> t IndexRange
-> io ()
unsafeIndexedRanges Bool
False CommandBuffer
cmd Indexed storage pos unusedAttrs
model instances
instances [IndexRange]
checkedRanges
  where
    check :: IndexRange
-> Bound
     dsl
     (Vertex pos ignoreAttrs)
     (VertexBuffersOf instances)
     m
     IndexRange
check ir :: IndexRange
ir@Model.IndexRange{Word32
$sel:irFirstIndex:IndexRange :: IndexRange -> Word32
$sel:irIndexCount:IndexRange :: IndexRange -> Word32
irFirstIndex :: Word32
irIndexCount :: Word32
..}
      | Word32
irFirstIndex Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
> Word32
maxIndex =
          String
-> Bound
     dsl
     (Vertex pos ignoreAttrs)
     (VertexBuffersOf instances)
     m
     IndexRange
forall (m :: * -> *) a. (MonadIO m, HasCallStack) => String -> m a
throwString String
"firstIndex is over the actual buffer size"
      | Word32
irFirstIndex Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
irIndexCount Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
> Word32
maxIndex =
          String
-> Bound
     dsl
     (Vertex pos ignoreAttrs)
     (VertexBuffersOf instances)
     m
     IndexRange
forall (m :: * -> *) a. (MonadIO m, HasCallStack) => String -> m a
throwString String
"firstIndex + indexCount is over the actual buffer size"
      | Bool
otherwise =
          IndexRange
-> Bound
     dsl
     (Vertex pos ignoreAttrs)
     (VertexBuffersOf instances)
     m
     IndexRange
forall a.
a
-> Bound
     dsl (Vertex pos ignoreAttrs) (VertexBuffersOf instances) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure IndexRange
ir

    maxIndex :: Word32
maxIndex = Allocated storage Word32 -> Word32
forall {k} (s :: Store) (a :: k). Allocated s a -> Word32
Buffer.aUsed (Indexed storage pos unusedAttrs -> Allocated storage Word32
forall {k1} {k2} (storage :: Store) (pos :: k1) (attrs :: k2).
Indexed storage pos attrs -> Allocated storage Word32
Model.iIndices Indexed storage pos unusedAttrs
model)

-- * Unchecked implementations

-- | Common unchecked part for pos/attrs
unsafeIndexedRanges
  :: (MonadUnliftIO io, Model.HasVertexBuffers instances, Foldable t)
  => Bool
  -> Vk.CommandBuffer
  -> Model.Indexed storage pos attrs
  -> instances
  -> t Model.IndexRange
  -> io ()
unsafeIndexedRanges :: forall {k} {k1} (io :: * -> *) instances (t :: * -> *)
       (storage :: Store) (pos :: k) (attrs :: k1).
(MonadUnliftIO io, HasVertexBuffers instances, Foldable t) =>
Bool
-> CommandBuffer
-> Indexed storage pos attrs
-> instances
-> t IndexRange
-> io ()
unsafeIndexedRanges Bool
drawAttrs CommandBuffer
cmd Model.Indexed{Maybe Text
Allocated storage pos
Allocated storage attrs
Allocated storage Word32
$sel:iIndices:Indexed :: forall {k1} {k2} (storage :: Store) (pos :: k1) (attrs :: k2).
Indexed storage pos attrs -> Allocated storage Word32
iLabel :: Maybe Text
iPositions :: Allocated storage pos
iAttrs :: Allocated storage attrs
iIndices :: Allocated storage Word32
$sel:iLabel:Indexed :: forall {k1} {k2} (storage :: Store) (pos :: k1) (attrs :: k2).
Indexed storage pos attrs -> Maybe Text
$sel:iPositions:Indexed :: forall {k1} {k2} (storage :: Store) (pos :: k1) (attrs :: k2).
Indexed storage pos attrs -> Allocated storage pos
$sel:iAttrs:Indexed :: forall {k1} {k2} (storage :: Store) (pos :: k1) (attrs :: k2).
Indexed storage pos attrs -> Allocated storage attrs
..} instances
instances t IndexRange
indexRanges =
  case t IndexRange -> [IndexRange]
forall a. t a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t IndexRange
indexRanges of
    [] ->
      () -> io ()
forall a. a -> io a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

    [IndexRange]
_skip | Word32
instanceCount Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
< Word32
1 ->
      () -> io ()
forall a. a -> io a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

    [IndexRange]
someRanges -> IO () -> io ()
forall a. IO a -> io a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
      CommandBuffer
-> Word32
-> ("buffers" ::: Vector Buffer)
-> ("offsets" ::: Vector DeviceSize)
-> IO ()
forall (io :: * -> *).
MonadIO io =>
CommandBuffer
-> Word32
-> ("buffers" ::: Vector Buffer)
-> ("offsets" ::: Vector DeviceSize)
-> io ()
Vk.cmdBindVertexBuffers CommandBuffer
cmd Word32
0 "buffers" ::: Vector Buffer
vertexBuffers "offsets" ::: Vector DeviceSize
bufferOffsets
      CommandBuffer -> Buffer -> DeviceSize -> IndexType -> IO ()
forall (io :: * -> *).
MonadIO io =>
CommandBuffer -> Buffer -> DeviceSize -> IndexType -> io ()
Vk.cmdBindIndexBuffer CommandBuffer
cmd (Allocated storage Word32 -> Buffer
forall {k} (s :: Store) (a :: k). Allocated s a -> Buffer
Buffer.aBuffer Allocated storage Word32
iIndices) DeviceSize
indexBufferOffset IndexType
Vk.INDEX_TYPE_UINT32
      [IndexRange] -> (IndexRange -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [IndexRange]
someRanges \Model.IndexRange{Word32
$sel:irFirstIndex:IndexRange :: IndexRange -> Word32
$sel:irIndexCount:IndexRange :: IndexRange -> Word32
irFirstIndex :: Word32
irIndexCount :: Word32
..} ->
        CommandBuffer
-> Word32
-> Word32
-> Word32
-> ("vertexOffset" ::: Int32)
-> Word32
-> IO ()
forall (io :: * -> *).
MonadIO io =>
CommandBuffer
-> Word32
-> Word32
-> Word32
-> ("vertexOffset" ::: Int32)
-> Word32
-> io ()
Vk.cmdDrawIndexed CommandBuffer
cmd Word32
irIndexCount Word32
instanceCount Word32
irFirstIndex "vertexOffset" ::: Int32
vertexOffset Word32
firstInstance

  where
    indexBufferOffset :: DeviceSize
indexBufferOffset = DeviceSize
0
    vertexOffset :: "vertexOffset" ::: Int32
vertexOffset = "vertexOffset" ::: Int32
0

    instanceCount :: Word32
instanceCount = instances -> Word32
forall a. HasVertexBuffers a => a -> Word32
Model.getInstanceCount instances
instances
    firstInstance :: Word32
firstInstance = Word32
0

    vertexBuffers :: "buffers" ::: Vector Buffer
vertexBuffers = [Buffer] -> "buffers" ::: Vector Buffer
forall a. [a] -> Vector a
Vector.fromList ([Buffer] -> "buffers" ::: Vector Buffer)
-> [Buffer] -> "buffers" ::: Vector Buffer
forall a b. (a -> b) -> a -> b
$
      if Bool
drawAttrs then
        Allocated storage pos -> Buffer
forall {k} (s :: Store) (a :: k). Allocated s a -> Buffer
Buffer.aBuffer Allocated storage pos
iPositions Buffer -> [Buffer] -> [Buffer]
forall a. a -> [a] -> [a]
:
        Allocated storage attrs -> Buffer
forall {k} (s :: Store) (a :: k). Allocated s a -> Buffer
Buffer.aBuffer Allocated storage attrs
iAttrs Buffer -> [Buffer] -> [Buffer]
forall a. a -> [a] -> [a]
:
        instances -> [Buffer]
forall a. HasVertexBuffers a => a -> [Buffer]
Model.getVertexBuffers instances
instances
      else
        Allocated storage pos -> Buffer
forall {k} (s :: Store) (a :: k). Allocated s a -> Buffer
Buffer.aBuffer Allocated storage pos
iPositions Buffer -> [Buffer] -> [Buffer]
forall a. a -> [a] -> [a]
:
        instances -> [Buffer]
forall a. HasVertexBuffers a => a -> [Buffer]
Model.getVertexBuffers instances
instances

    bufferOffsets :: "offsets" ::: Vector DeviceSize
bufferOffsets =
      Int -> DeviceSize -> "offsets" ::: Vector DeviceSize
forall a. Int -> a -> Vector a
Vector.replicate (("buffers" ::: Vector Buffer) -> Int
forall a. Vector a -> Int
Vector.length "buffers" ::: Vector Buffer
vertexBuffers) DeviceSize
0

-- | Instance/range zipped
unsafeIndexedParts
  :: (MonadUnliftIO io, Model.HasVertexBuffers instances, Foldable t)
  => Bool
  -> Vk.CommandBuffer
  -> Model.Indexed storage pos attrs
  -> instances
  -> Int
  -> t Model.IndexRange
  -> io ()
unsafeIndexedParts :: forall {k} {k1} (io :: * -> *) instances (t :: * -> *)
       (storage :: Store) (pos :: k) (attrs :: k1).
(MonadUnliftIO io, HasVertexBuffers instances, Foldable t) =>
Bool
-> CommandBuffer
-> Indexed storage pos attrs
-> instances
-> Int
-> t IndexRange
-> io ()
unsafeIndexedParts Bool
drawAttrs CommandBuffer
cmd Model.Indexed{Maybe Text
Allocated storage pos
Allocated storage attrs
Allocated storage Word32
$sel:iIndices:Indexed :: forall {k1} {k2} (storage :: Store) (pos :: k1) (attrs :: k2).
Indexed storage pos attrs -> Allocated storage Word32
$sel:iLabel:Indexed :: forall {k1} {k2} (storage :: Store) (pos :: k1) (attrs :: k2).
Indexed storage pos attrs -> Maybe Text
$sel:iPositions:Indexed :: forall {k1} {k2} (storage :: Store) (pos :: k1) (attrs :: k2).
Indexed storage pos attrs -> Allocated storage pos
$sel:iAttrs:Indexed :: forall {k1} {k2} (storage :: Store) (pos :: k1) (attrs :: k2).
Indexed storage pos attrs -> Allocated storage attrs
iLabel :: Maybe Text
iPositions :: Allocated storage pos
iAttrs :: Allocated storage attrs
iIndices :: Allocated storage Word32
..} instances
instances Int
startInstance t IndexRange
parts =
  case Int -> [IndexRange] -> [IndexRange]
forall a. Int -> [a] -> [a]
drop Int
startInstance (t IndexRange -> [IndexRange]
forall a. t a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t IndexRange
parts) of
    [] ->
      () -> io ()
forall a. a -> io a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

    [IndexRange]
_skip | Word32
instanceCount Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
< Word32
1 ->
      () -> io ()
forall a. a -> io a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

    [IndexRange]
someRanges -> IO () -> io ()
forall a. IO a -> io a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
      CommandBuffer
-> Word32
-> ("buffers" ::: Vector Buffer)
-> ("offsets" ::: Vector DeviceSize)
-> IO ()
forall (io :: * -> *).
MonadIO io =>
CommandBuffer
-> Word32
-> ("buffers" ::: Vector Buffer)
-> ("offsets" ::: Vector DeviceSize)
-> io ()
Vk.cmdBindVertexBuffers CommandBuffer
cmd Word32
0 "buffers" ::: Vector Buffer
vertexBuffers "offsets" ::: Vector DeviceSize
bufferOffsets
      CommandBuffer -> Buffer -> DeviceSize -> IndexType -> IO ()
forall (io :: * -> *).
MonadIO io =>
CommandBuffer -> Buffer -> DeviceSize -> IndexType -> io ()
Vk.cmdBindIndexBuffer CommandBuffer
cmd (Allocated storage Word32 -> Buffer
forall {k} (s :: Store) (a :: k). Allocated s a -> Buffer
Buffer.aBuffer Allocated storage Word32
iIndices) DeviceSize
indexBufferOffset IndexType
Vk.INDEX_TYPE_UINT32
      [(Word32, IndexRange)] -> ((Word32, IndexRange) -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ ([Word32] -> [IndexRange] -> [(Word32, IndexRange)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
startInstance ..] [IndexRange]
someRanges) \(Word32
firstInstance, Model.IndexRange{Word32
$sel:irFirstIndex:IndexRange :: IndexRange -> Word32
$sel:irIndexCount:IndexRange :: IndexRange -> Word32
irFirstIndex :: Word32
irIndexCount :: Word32
..}) ->
        CommandBuffer
-> Word32
-> Word32
-> Word32
-> ("vertexOffset" ::: Int32)
-> Word32
-> IO ()
forall (io :: * -> *).
MonadIO io =>
CommandBuffer
-> Word32
-> Word32
-> Word32
-> ("vertexOffset" ::: Int32)
-> Word32
-> io ()
Vk.cmdDrawIndexed CommandBuffer
cmd Word32
irIndexCount Word32
instanceCount Word32
irFirstIndex "vertexOffset" ::: Int32
vertexOffset Word32
firstInstance

  where
    indexBufferOffset :: DeviceSize
indexBufferOffset = DeviceSize
0
    vertexOffset :: "vertexOffset" ::: Int32
vertexOffset = "vertexOffset" ::: Int32
0

    instanceCount :: Word32
instanceCount = Word32
1 -- Model.getInstanceCount instances
    -- firstInstance = 0

    vertexBuffers :: "buffers" ::: Vector Buffer
vertexBuffers = [Buffer] -> "buffers" ::: Vector Buffer
forall a. [a] -> Vector a
Vector.fromList ([Buffer] -> "buffers" ::: Vector Buffer)
-> [Buffer] -> "buffers" ::: Vector Buffer
forall a b. (a -> b) -> a -> b
$
      if Bool
drawAttrs then
        Allocated storage pos -> Buffer
forall {k} (s :: Store) (a :: k). Allocated s a -> Buffer
Buffer.aBuffer Allocated storage pos
iPositions Buffer -> [Buffer] -> [Buffer]
forall a. a -> [a] -> [a]
:
        Allocated storage attrs -> Buffer
forall {k} (s :: Store) (a :: k). Allocated s a -> Buffer
Buffer.aBuffer Allocated storage attrs
iAttrs Buffer -> [Buffer] -> [Buffer]
forall a. a -> [a] -> [a]
:
        instances -> [Buffer]
forall a. HasVertexBuffers a => a -> [Buffer]
Model.getVertexBuffers instances
instances
      else
        Allocated storage pos -> Buffer
forall {k} (s :: Store) (a :: k). Allocated s a -> Buffer
Buffer.aBuffer Allocated storage pos
iPositions Buffer -> [Buffer] -> [Buffer]
forall a. a -> [a] -> [a]
:
        instances -> [Buffer]
forall a. HasVertexBuffers a => a -> [Buffer]
Model.getVertexBuffers instances
instances

    bufferOffsets :: "offsets" ::: Vector DeviceSize
bufferOffsets =
      Int -> DeviceSize -> "offsets" ::: Vector DeviceSize
forall a. Int -> a -> Vector a
Vector.replicate (("buffers" ::: Vector Buffer) -> Int
forall a. Vector a -> Int
Vector.length "buffers" ::: Vector Buffer
vertexBuffers) DeviceSize
0