{-# LANGUAGE AllowAmbiguousTypes #-}

module Resource.Model where

import RIO
import GHC.Generics

import Codec.Serialise qualified as CBOR
import Data.Kind (Constraint, Type)
import Data.List qualified as List
import Data.Vector.Storable qualified as Storable
import Foreign (Storable(..))
import Geomancy (Vec2)
import Geomancy.Vec3 qualified as Vec3
import UnliftIO.Resource (MonadResource)
import Vulkan.Core10 qualified as Vk

import Engine.Vulkan.Pipeline.Graphics (HasVertexInputBindings(..))
import Engine.Vulkan.Format (HasVkFormat(..))
import Engine.Vulkan.Pipeline.Graphics qualified as Graphics
import Engine.Vulkan.Types (MonadVulkan, Queues(..))
import Resource.Buffer qualified as Buffer

data Indexed storage pos attrs = Indexed
  { forall {k} {k} (storage :: Store) (pos :: k) (attrs :: k).
Indexed storage pos attrs -> Maybe Text
iLabel     :: Maybe Text
  , forall {k} {k} (storage :: Store) (pos :: k) (attrs :: k).
Indexed storage pos attrs -> Allocated storage pos
iPositions :: Buffer.Allocated storage pos
  , forall {k} {k} (storage :: Store) (pos :: k) (attrs :: k).
Indexed storage pos attrs -> Allocated storage attrs
iAttrs     :: Buffer.Allocated storage attrs
  , forall {k} {k} (storage :: Store) (pos :: k) (attrs :: k).
Indexed storage pos attrs -> Allocated storage Word32
iIndices   :: Buffer.Allocated storage Word32
  } deriving (Int -> Indexed storage pos attrs -> ShowS
[Indexed storage pos attrs] -> ShowS
Indexed storage pos attrs -> String
(Int -> Indexed storage pos attrs -> ShowS)
-> (Indexed storage pos attrs -> String)
-> ([Indexed storage pos attrs] -> ShowS)
-> Show (Indexed storage pos attrs)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (storage :: Store) k (pos :: k) k (attrs :: k).
Int -> Indexed storage pos attrs -> ShowS
forall (storage :: Store) k (pos :: k) k (attrs :: k).
[Indexed storage pos attrs] -> ShowS
forall (storage :: Store) k (pos :: k) k (attrs :: k).
Indexed storage pos attrs -> String
$cshowsPrec :: forall (storage :: Store) k (pos :: k) k (attrs :: k).
Int -> Indexed storage pos attrs -> ShowS
showsPrec :: Int -> Indexed storage pos attrs -> ShowS
$cshow :: forall (storage :: Store) k (pos :: k) k (attrs :: k).
Indexed storage pos attrs -> String
show :: Indexed storage pos attrs -> String
$cshowList :: forall (storage :: Store) k (pos :: k) k (attrs :: k).
[Indexed storage pos attrs] -> ShowS
showList :: [Indexed storage pos attrs] -> ShowS
Show)

type Vertex2d attrs = Vertex Vec2 attrs
type Vertex3d attrs = Vertex Vec3.Packed attrs

data Vertex pos attrs = Vertex
  { forall pos attrs. Vertex pos attrs -> pos
vPosition :: pos
  , forall pos attrs. Vertex pos attrs -> attrs
vAttrs    :: attrs
  } deriving (Vertex pos attrs -> Vertex pos attrs -> Bool
(Vertex pos attrs -> Vertex pos attrs -> Bool)
-> (Vertex pos attrs -> Vertex pos attrs -> Bool)
-> Eq (Vertex pos attrs)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall pos attrs.
(Eq pos, Eq attrs) =>
Vertex pos attrs -> Vertex pos attrs -> Bool
$c== :: forall pos attrs.
(Eq pos, Eq attrs) =>
Vertex pos attrs -> Vertex pos attrs -> Bool
== :: Vertex pos attrs -> Vertex pos attrs -> Bool
$c/= :: forall pos attrs.
(Eq pos, Eq attrs) =>
Vertex pos attrs -> Vertex pos attrs -> Bool
/= :: Vertex pos attrs -> Vertex pos attrs -> Bool
Eq, Eq (Vertex pos attrs)
Eq (Vertex pos attrs)
-> (Vertex pos attrs -> Vertex pos attrs -> Ordering)
-> (Vertex pos attrs -> Vertex pos attrs -> Bool)
-> (Vertex pos attrs -> Vertex pos attrs -> Bool)
-> (Vertex pos attrs -> Vertex pos attrs -> Bool)
-> (Vertex pos attrs -> Vertex pos attrs -> Bool)
-> (Vertex pos attrs -> Vertex pos attrs -> Vertex pos attrs)
-> (Vertex pos attrs -> Vertex pos attrs -> Vertex pos attrs)
-> Ord (Vertex pos attrs)
Vertex pos attrs -> Vertex pos attrs -> Bool
Vertex pos attrs -> Vertex pos attrs -> Ordering
Vertex pos attrs -> Vertex pos attrs -> Vertex pos attrs
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
forall {pos} {attrs}. (Ord pos, Ord attrs) => Eq (Vertex pos attrs)
forall pos attrs.
(Ord pos, Ord attrs) =>
Vertex pos attrs -> Vertex pos attrs -> Bool
forall pos attrs.
(Ord pos, Ord attrs) =>
Vertex pos attrs -> Vertex pos attrs -> Ordering
forall pos attrs.
(Ord pos, Ord attrs) =>
Vertex pos attrs -> Vertex pos attrs -> Vertex pos attrs
$ccompare :: forall pos attrs.
(Ord pos, Ord attrs) =>
Vertex pos attrs -> Vertex pos attrs -> Ordering
compare :: Vertex pos attrs -> Vertex pos attrs -> Ordering
$c< :: forall pos attrs.
(Ord pos, Ord attrs) =>
Vertex pos attrs -> Vertex pos attrs -> Bool
< :: Vertex pos attrs -> Vertex pos attrs -> Bool
$c<= :: forall pos attrs.
(Ord pos, Ord attrs) =>
Vertex pos attrs -> Vertex pos attrs -> Bool
<= :: Vertex pos attrs -> Vertex pos attrs -> Bool
$c> :: forall pos attrs.
(Ord pos, Ord attrs) =>
Vertex pos attrs -> Vertex pos attrs -> Bool
> :: Vertex pos attrs -> Vertex pos attrs -> Bool
$c>= :: forall pos attrs.
(Ord pos, Ord attrs) =>
Vertex pos attrs -> Vertex pos attrs -> Bool
>= :: Vertex pos attrs -> Vertex pos attrs -> Bool
$cmax :: forall pos attrs.
(Ord pos, Ord attrs) =>
Vertex pos attrs -> Vertex pos attrs -> Vertex pos attrs
max :: Vertex pos attrs -> Vertex pos attrs -> Vertex pos attrs
$cmin :: forall pos attrs.
(Ord pos, Ord attrs) =>
Vertex pos attrs -> Vertex pos attrs -> Vertex pos attrs
min :: Vertex pos attrs -> Vertex pos attrs -> Vertex pos attrs
Ord, Int -> Vertex pos attrs -> ShowS
[Vertex pos attrs] -> ShowS
Vertex pos attrs -> String
(Int -> Vertex pos attrs -> ShowS)
-> (Vertex pos attrs -> String)
-> ([Vertex pos attrs] -> ShowS)
-> Show (Vertex pos attrs)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall pos attrs.
(Show pos, Show attrs) =>
Int -> Vertex pos attrs -> ShowS
forall pos attrs.
(Show pos, Show attrs) =>
[Vertex pos attrs] -> ShowS
forall pos attrs.
(Show pos, Show attrs) =>
Vertex pos attrs -> String
$cshowsPrec :: forall pos attrs.
(Show pos, Show attrs) =>
Int -> Vertex pos attrs -> ShowS
showsPrec :: Int -> Vertex pos attrs -> ShowS
$cshow :: forall pos attrs.
(Show pos, Show attrs) =>
Vertex pos attrs -> String
show :: Vertex pos attrs -> String
$cshowList :: forall pos attrs.
(Show pos, Show attrs) =>
[Vertex pos attrs] -> ShowS
showList :: [Vertex pos attrs] -> ShowS
Show, (forall a b. (a -> b) -> Vertex pos a -> Vertex pos b)
-> (forall a b. a -> Vertex pos b -> Vertex pos a)
-> Functor (Vertex pos)
forall a b. a -> Vertex pos b -> Vertex pos a
forall a b. (a -> b) -> Vertex pos a -> Vertex pos b
forall pos a b. a -> Vertex pos b -> Vertex pos a
forall pos a b. (a -> b) -> Vertex pos a -> Vertex pos b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall pos a b. (a -> b) -> Vertex pos a -> Vertex pos b
fmap :: forall a b. (a -> b) -> Vertex pos a -> Vertex pos b
$c<$ :: forall pos a b. a -> Vertex pos b -> Vertex pos a
<$ :: forall a b. a -> Vertex pos b -> Vertex pos a
Functor, (forall m. Monoid m => Vertex pos m -> m)
-> (forall m a. Monoid m => (a -> m) -> Vertex pos a -> m)
-> (forall m a. Monoid m => (a -> m) -> Vertex pos a -> m)
-> (forall a b. (a -> b -> b) -> b -> Vertex pos a -> b)
-> (forall a b. (a -> b -> b) -> b -> Vertex pos a -> b)
-> (forall b a. (b -> a -> b) -> b -> Vertex pos a -> b)
-> (forall b a. (b -> a -> b) -> b -> Vertex pos a -> b)
-> (forall a. (a -> a -> a) -> Vertex pos a -> a)
-> (forall a. (a -> a -> a) -> Vertex pos a -> a)
-> (forall a. Vertex pos a -> [a])
-> (forall a. Vertex pos a -> Bool)
-> (forall a. Vertex pos a -> Int)
-> (forall a. Eq a => a -> Vertex pos a -> Bool)
-> (forall a. Ord a => Vertex pos a -> a)
-> (forall a. Ord a => Vertex pos a -> a)
-> (forall a. Num a => Vertex pos a -> a)
-> (forall a. Num a => Vertex pos a -> a)
-> Foldable (Vertex pos)
forall a. Eq a => a -> Vertex pos a -> Bool
forall a. Num a => Vertex pos a -> a
forall a. Ord a => Vertex pos a -> a
forall m. Monoid m => Vertex pos m -> m
forall a. Vertex pos a -> Bool
forall a. Vertex pos a -> Int
forall a. Vertex pos a -> [a]
forall a. (a -> a -> a) -> Vertex pos a -> a
forall pos a. Eq a => a -> Vertex pos a -> Bool
forall pos a. Num a => Vertex pos a -> a
forall pos a. Ord a => Vertex pos a -> a
forall m a. Monoid m => (a -> m) -> Vertex pos a -> m
forall pos m. Monoid m => Vertex pos m -> m
forall pos a. Vertex pos a -> Bool
forall pos a. Vertex pos a -> Int
forall pos a. Vertex pos a -> [a]
forall b a. (b -> a -> b) -> b -> Vertex pos a -> b
forall a b. (a -> b -> b) -> b -> Vertex pos a -> b
forall pos a. (a -> a -> a) -> Vertex pos a -> a
forall pos m a. Monoid m => (a -> m) -> Vertex pos a -> m
forall pos b a. (b -> a -> b) -> b -> Vertex pos a -> b
forall pos a b. (a -> b -> b) -> b -> Vertex pos a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall pos m. Monoid m => Vertex pos m -> m
fold :: forall m. Monoid m => Vertex pos m -> m
$cfoldMap :: forall pos m a. Monoid m => (a -> m) -> Vertex pos a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Vertex pos a -> m
$cfoldMap' :: forall pos m a. Monoid m => (a -> m) -> Vertex pos a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Vertex pos a -> m
$cfoldr :: forall pos a b. (a -> b -> b) -> b -> Vertex pos a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Vertex pos a -> b
$cfoldr' :: forall pos a b. (a -> b -> b) -> b -> Vertex pos a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Vertex pos a -> b
$cfoldl :: forall pos b a. (b -> a -> b) -> b -> Vertex pos a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Vertex pos a -> b
$cfoldl' :: forall pos b a. (b -> a -> b) -> b -> Vertex pos a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Vertex pos a -> b
$cfoldr1 :: forall pos a. (a -> a -> a) -> Vertex pos a -> a
foldr1 :: forall a. (a -> a -> a) -> Vertex pos a -> a
$cfoldl1 :: forall pos a. (a -> a -> a) -> Vertex pos a -> a
foldl1 :: forall a. (a -> a -> a) -> Vertex pos a -> a
$ctoList :: forall pos a. Vertex pos a -> [a]
toList :: forall a. Vertex pos a -> [a]
$cnull :: forall pos a. Vertex pos a -> Bool
null :: forall a. Vertex pos a -> Bool
$clength :: forall pos a. Vertex pos a -> Int
length :: forall a. Vertex pos a -> Int
$celem :: forall pos a. Eq a => a -> Vertex pos a -> Bool
elem :: forall a. Eq a => a -> Vertex pos a -> Bool
$cmaximum :: forall pos a. Ord a => Vertex pos a -> a
maximum :: forall a. Ord a => Vertex pos a -> a
$cminimum :: forall pos a. Ord a => Vertex pos a -> a
minimum :: forall a. Ord a => Vertex pos a -> a
$csum :: forall pos a. Num a => Vertex pos a -> a
sum :: forall a. Num a => Vertex pos a -> a
$cproduct :: forall pos a. Num a => Vertex pos a -> a
product :: forall a. Num a => Vertex pos a -> a
Foldable, Functor (Vertex pos)
Foldable (Vertex pos)
Functor (Vertex pos)
-> Foldable (Vertex pos)
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Vertex pos a -> f (Vertex pos b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Vertex pos (f a) -> f (Vertex pos a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Vertex pos a -> m (Vertex pos b))
-> (forall (m :: * -> *) a.
    Monad m =>
    Vertex pos (m a) -> m (Vertex pos a))
-> Traversable (Vertex pos)
forall pos. Functor (Vertex pos)
forall pos. Foldable (Vertex pos)
forall pos (m :: * -> *) a.
Monad m =>
Vertex pos (m a) -> m (Vertex pos a)
forall pos (f :: * -> *) a.
Applicative f =>
Vertex pos (f a) -> f (Vertex pos a)
forall pos (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Vertex pos a -> m (Vertex pos b)
forall pos (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Vertex pos a -> f (Vertex pos b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
Vertex pos (m a) -> m (Vertex pos a)
forall (f :: * -> *) a.
Applicative f =>
Vertex pos (f a) -> f (Vertex pos a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Vertex pos a -> m (Vertex pos b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Vertex pos a -> f (Vertex pos b)
$ctraverse :: forall pos (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Vertex pos a -> f (Vertex pos b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Vertex pos a -> f (Vertex pos b)
$csequenceA :: forall pos (f :: * -> *) a.
Applicative f =>
Vertex pos (f a) -> f (Vertex pos a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Vertex pos (f a) -> f (Vertex pos a)
$cmapM :: forall pos (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Vertex pos a -> m (Vertex pos b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Vertex pos a -> m (Vertex pos b)
$csequence :: forall pos (m :: * -> *) a.
Monad m =>
Vertex pos (m a) -> m (Vertex pos a)
sequence :: forall (m :: * -> *) a.
Monad m =>
Vertex pos (m a) -> m (Vertex pos a)
Traversable)

{-# INLINEABLE vertexAttrs #-}
vertexAttrs :: (pos -> a -> b) -> [Vertex pos a] -> [Vertex pos b]
vertexAttrs :: forall pos a b. (pos -> a -> b) -> [Vertex pos a] -> [Vertex pos b]
vertexAttrs pos -> a -> b
inject [Vertex pos a]
vertices = do
  v :: Vertex pos a
v@Vertex{pos
a
$sel:vPosition:Vertex :: forall pos attrs. Vertex pos attrs -> pos
$sel:vAttrs:Vertex :: forall pos attrs. Vertex pos attrs -> attrs
vPosition :: pos
vAttrs :: a
..} <- [Vertex pos a]
vertices
  Vertex pos b -> [Vertex pos b]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure Vertex pos a
v
    { $sel:vAttrs:Vertex :: b
vAttrs = pos -> a -> b
inject pos
vPosition a
vAttrs
    }

{-# INLINEABLE vertexAttrsPos #-}
vertexAttrsPos :: (pos -> a) -> [pos] -> [Vertex pos a]
vertexAttrsPos :: forall pos a. (pos -> a) -> [pos] -> [Vertex pos a]
vertexAttrsPos pos -> a
inject [pos]
positions = do
  pos
pos <- [pos]
positions
  pure Vertex
    { $sel:vPosition:Vertex :: pos
vPosition = pos
pos
    , $sel:vAttrs:Vertex :: a
vAttrs    = pos -> a
inject pos
pos
    }

instance
  ( HasVkFormat pos
  , HasVkFormat attrs
  ) =>
  Graphics.HasVertexInputBindings (Vertex pos attrs) where
    vertexInputBindings :: [VertexInputBinding]
vertexInputBindings =
      [ forall a. HasVkFormat a => VertexInputBinding
Graphics.vertexFormat @pos
      , forall a. HasVkFormat a => VertexInputBinding
Graphics.vertexFormat @attrs
      ]

class HasVertexBuffers a where
  type VertexBuffersOf a
  getVertexBuffers :: a -> [Vk.Buffer]
  getInstanceCount :: a -> Word32

  default getVertexBuffers
    :: ( Generic a
       , GHasVertexBuffers (Rep a)
       )
    => a
    -> [Vk.Buffer]
  getVertexBuffers = a -> [Buffer]
forall a. (Generic a, GHasVertexBuffers (Rep a)) => a -> [Buffer]
genericGetVertexBuffers

  default getInstanceCount
    :: ( Generic a
       , GHasVertexBuffers (Rep a)
       )
    => a
    -> Word32
  getInstanceCount = a -> Word32
forall a. (Generic a, GHasVertexBuffers (Rep a)) => a -> Word32
genericGetInstanceCount

instance HasVertexBuffers () where
  type VertexBuffersOf () = ()

  {-# INLINE getVertexBuffers #-}
  getVertexBuffers :: () -> [Buffer]
getVertexBuffers () = []

  {-# INLINE getInstanceCount #-}
  getInstanceCount :: () -> Word32
getInstanceCount () = Word32
1

instance forall (a :: Type) (store :: Buffer.Store) . HasVertexBuffers (Buffer.Allocated store a) where
  type VertexBuffersOf (Buffer.Allocated store a) = a

  {-# INLINE getVertexBuffers #-}
  getVertexBuffers :: Allocated store a -> [Buffer]
getVertexBuffers Buffer.Allocated{Buffer
aBuffer :: Buffer
$sel:aBuffer:Allocated :: forall {k} (s :: Store) (a :: k). Allocated s a -> Buffer
aBuffer} = [Buffer
aBuffer]

  {-# INLINE getInstanceCount #-}
  getInstanceCount :: Allocated store a -> Word32
getInstanceCount = Allocated store a -> Word32
forall {k} (s :: Store) (a :: k). Allocated s a -> Word32
Buffer.aUsed

genericGetVertexBuffers
  :: ( Generic a
     , GHasVertexBuffers (Rep a)
     )
  => a
  -> [Vk.Buffer]
genericGetVertexBuffers :: forall a. (Generic a, GHasVertexBuffers (Rep a)) => a -> [Buffer]
genericGetVertexBuffers = Rep a Any -> [Buffer]
forall a. Rep a a -> [Buffer]
forall (f :: * -> *) a. GHasVertexBuffers f => f a -> [Buffer]
gVertexBuffers (Rep a Any -> [Buffer]) -> (a -> Rep a Any) -> a -> [Buffer]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Rep a Any
forall x. a -> Rep a x
forall a x. Generic a => a -> Rep a x
GHC.Generics.from

genericGetInstanceCount
  :: ( Generic a
     , GHasVertexBuffers (Rep a)
     )
  => a
  -> Word32
genericGetInstanceCount :: forall a. (Generic a, GHasVertexBuffers (Rep a)) => a -> Word32
genericGetInstanceCount = Rep a Any -> Word32
forall a. Rep a a -> Word32
forall (f :: * -> *) a. GHasVertexBuffers f => f a -> Word32
gInstanceCount (Rep a Any -> Word32) -> (a -> Rep a Any) -> a -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Rep a Any
forall x. a -> Rep a x
forall a x. Generic a => a -> Rep a x
GHC.Generics.from

type GHasVertexBuffers :: (Type -> Type) -> Constraint
class GHasVertexBuffers f where
  gVertexBuffers  :: forall a . f a -> [Vk.Buffer]
  gInstanceCount :: forall a . f a -> Word32

instance GHasVertexBuffers f => GHasVertexBuffers (M1 c cb f) where
  gVertexBuffers :: forall a. M1 c cb f a -> [Buffer]
gVertexBuffers (M1 f a
f) = f a -> [Buffer]
forall a. f a -> [Buffer]
forall (f :: * -> *) a. GHasVertexBuffers f => f a -> [Buffer]
gVertexBuffers f a
f
  gInstanceCount :: forall a. M1 c cb f a -> Word32
gInstanceCount (M1 f a
f) = f a -> Word32
forall a. f a -> Word32
forall (f :: * -> *) a. GHasVertexBuffers f => f a -> Word32
gInstanceCount f a
f

instance (GHasVertexBuffers l, GHasVertexBuffers r) => GHasVertexBuffers (l :*: r) where
  gVertexBuffers :: forall a. (:*:) l r a -> [Buffer]
gVertexBuffers (l a
l :*: r a
r) = l a -> [Buffer]
forall a. l a -> [Buffer]
forall (f :: * -> *) a. GHasVertexBuffers f => f a -> [Buffer]
gVertexBuffers l a
l [Buffer] -> [Buffer] -> [Buffer]
forall a. Semigroup a => a -> a -> a
<> r a -> [Buffer]
forall a. r a -> [Buffer]
forall (f :: * -> *) a. GHasVertexBuffers f => f a -> [Buffer]
gVertexBuffers r a
r
  gInstanceCount :: forall a. (:*:) l r a -> Word32
gInstanceCount (l a
l :*: r a
r) = Word32 -> Word32 -> Word32
forall a. Ord a => a -> a -> a
min (l a -> Word32
forall a. l a -> Word32
forall (f :: * -> *) a. GHasVertexBuffers f => f a -> Word32
gInstanceCount l a
l) (r a -> Word32
forall a. r a -> Word32
forall (f :: * -> *) a. GHasVertexBuffers f => f a -> Word32
gInstanceCount r a
r)

instance HasVertexBuffers a => GHasVertexBuffers (K1 r a) where
  gVertexBuffers :: forall a. K1 r a a -> [Buffer]
gVertexBuffers (K1 a
a) = a -> [Buffer]
forall a. HasVertexBuffers a => a -> [Buffer]
getVertexBuffers a
a
  gInstanceCount :: forall a. K1 r a a -> Word32
gInstanceCount (K1 a
a) = a -> Word32
forall a. HasVertexBuffers a => a -> Word32
getInstanceCount a
a

data IndexRange = IndexRange
  { IndexRange -> Word32
irFirstIndex :: Word32
  , IndexRange -> Word32
irIndexCount :: Word32
  }
  deriving (IndexRange -> IndexRange -> Bool
(IndexRange -> IndexRange -> Bool)
-> (IndexRange -> IndexRange -> Bool) -> Eq IndexRange
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IndexRange -> IndexRange -> Bool
== :: IndexRange -> IndexRange -> Bool
$c/= :: IndexRange -> IndexRange -> Bool
/= :: IndexRange -> IndexRange -> Bool
Eq, Eq IndexRange
Eq IndexRange
-> (IndexRange -> IndexRange -> Ordering)
-> (IndexRange -> IndexRange -> Bool)
-> (IndexRange -> IndexRange -> Bool)
-> (IndexRange -> IndexRange -> Bool)
-> (IndexRange -> IndexRange -> Bool)
-> (IndexRange -> IndexRange -> IndexRange)
-> (IndexRange -> IndexRange -> IndexRange)
-> Ord IndexRange
IndexRange -> IndexRange -> Bool
IndexRange -> IndexRange -> Ordering
IndexRange -> IndexRange -> IndexRange
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 :: IndexRange -> IndexRange -> Ordering
compare :: IndexRange -> IndexRange -> Ordering
$c< :: IndexRange -> IndexRange -> Bool
< :: IndexRange -> IndexRange -> Bool
$c<= :: IndexRange -> IndexRange -> Bool
<= :: IndexRange -> IndexRange -> Bool
$c> :: IndexRange -> IndexRange -> Bool
> :: IndexRange -> IndexRange -> Bool
$c>= :: IndexRange -> IndexRange -> Bool
>= :: IndexRange -> IndexRange -> Bool
$cmax :: IndexRange -> IndexRange -> IndexRange
max :: IndexRange -> IndexRange -> IndexRange
$cmin :: IndexRange -> IndexRange -> IndexRange
min :: IndexRange -> IndexRange -> IndexRange
Ord, Int -> IndexRange -> ShowS
[IndexRange] -> ShowS
IndexRange -> String
(Int -> IndexRange -> ShowS)
-> (IndexRange -> String)
-> ([IndexRange] -> ShowS)
-> Show IndexRange
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IndexRange -> ShowS
showsPrec :: Int -> IndexRange -> ShowS
$cshow :: IndexRange -> String
show :: IndexRange -> String
$cshowList :: [IndexRange] -> ShowS
showList :: [IndexRange] -> ShowS
Show, (forall x. IndexRange -> Rep IndexRange x)
-> (forall x. Rep IndexRange x -> IndexRange) -> Generic IndexRange
forall x. Rep IndexRange x -> IndexRange
forall x. IndexRange -> Rep IndexRange x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. IndexRange -> Rep IndexRange x
from :: forall x. IndexRange -> Rep IndexRange x
$cto :: forall x. Rep IndexRange x -> IndexRange
to :: forall x. Rep IndexRange x -> IndexRange
Generic)

instance CBOR.Serialise IndexRange

instance Storable IndexRange where
  alignment :: IndexRange -> Int
alignment ~IndexRange
_ = Int
4

  sizeOf :: IndexRange -> Int
sizeOf ~IndexRange
_ = Int
8

  peek :: Ptr IndexRange -> IO IndexRange
peek Ptr IndexRange
ptr = do
    Word32
irFirstIndex <- Ptr IndexRange -> Int -> IO Word32
forall b. Ptr b -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr IndexRange
ptr Int
0
    Word32
irIndexCount <- Ptr IndexRange -> Int -> IO Word32
forall b. Ptr b -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr IndexRange
ptr Int
4
    pure IndexRange{Word32
$sel:irFirstIndex:IndexRange :: Word32
$sel:irIndexCount:IndexRange :: Word32
irFirstIndex :: Word32
irIndexCount :: Word32
..}

  poke :: Ptr IndexRange -> IndexRange -> IO ()
poke Ptr IndexRange
ptr IndexRange{Word32
$sel:irFirstIndex:IndexRange :: IndexRange -> Word32
$sel:irIndexCount:IndexRange :: IndexRange -> Word32
irFirstIndex :: Word32
irIndexCount :: Word32
..} = do
    Ptr IndexRange -> Int -> Word32 -> IO ()
forall b. Ptr b -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr IndexRange
ptr Int
0 Word32
irFirstIndex
    Ptr IndexRange -> Int -> Word32 -> IO ()
forall b. Ptr b -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr IndexRange
ptr Int
4 Word32
irIndexCount

createStagedL
  :: ( MonadVulkan env m
     , Storable pos
     , Storable attrs
     )
  => Maybe Text
  -> Queues Vk.CommandPool
  -> [Vertex pos attrs]
  -> Maybe [Word32]
  -> m (Indexed 'Buffer.Staged pos attrs)
createStagedL :: forall env (m :: * -> *) pos attrs.
(MonadVulkan env m, Storable pos, Storable attrs) =>
Maybe Text
-> Queues CommandPool
-> [Vertex pos attrs]
-> Maybe [Word32]
-> m (Indexed 'Staged pos attrs)
createStagedL Maybe Text
label Queues CommandPool
pool [Vertex pos attrs]
vertices Maybe [Word32]
mindices = Maybe Text
-> Queues CommandPool
-> Vector pos
-> Vector attrs
-> Vector Word32
-> m (Indexed 'Staged pos attrs)
forall env (m :: * -> *) pos attrs.
(MonadVulkan env m, Storable pos, Storable attrs) =>
Maybe Text
-> Queues CommandPool
-> Vector pos
-> Vector attrs
-> Vector Word32
-> m (Indexed 'Staged pos attrs)
createStaged Maybe Text
label Queues CommandPool
pool Vector pos
pv Vector attrs
av Vector Word32
iv
  where
    pv :: Vector pos
pv = [pos] -> Vector pos
forall a. Storable a => [a] -> Vector a
Storable.fromList [pos]
ps
    av :: Vector attrs
av = [attrs] -> Vector attrs
forall a. Storable a => [a] -> Vector a
Storable.fromList [attrs]
as

    iv :: Vector Word32
iv = case Maybe [Word32]
mindices of
      Just [Word32]
is ->
        [Word32] -> Vector Word32
forall a. Storable a => [a] -> Vector a
Storable.fromList [Word32]
is
      Maybe [Word32]
Nothing ->
        -- TODO: add vertex deduplication
        Int -> (Int -> Word32) -> Vector Word32
forall a. Storable a => Int -> (Int -> a) -> Vector a
Storable.generate (Vector pos -> Int
forall a. Storable a => Vector a -> Int
Storable.length Vector pos
pv) Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral

    ([pos]
ps, [attrs]
as) = [(pos, attrs)] -> ([pos], [attrs])
forall a b. [(a, b)] -> ([a], [b])
List.unzip do
      Vertex{pos
attrs
$sel:vPosition:Vertex :: forall pos attrs. Vertex pos attrs -> pos
$sel:vAttrs:Vertex :: forall pos attrs. Vertex pos attrs -> attrs
vPosition :: pos
vAttrs :: attrs
..} <- [Vertex pos attrs]
vertices
      (pos, attrs) -> [(pos, attrs)]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (pos
vPosition, attrs
vAttrs)

createStaged
  :: ( MonadVulkan env m
     , Storable pos
     , Storable attrs
     )
  => Maybe Text
  -> Queues Vk.CommandPool
  -> Storable.Vector pos
  -> Storable.Vector attrs
  -> Storable.Vector Word32
  -> m (Indexed 'Buffer.Staged pos attrs)
createStaged :: forall env (m :: * -> *) pos attrs.
(MonadVulkan env m, Storable pos, Storable attrs) =>
Maybe Text
-> Queues CommandPool
-> Vector pos
-> Vector attrs
-> Vector Word32
-> m (Indexed 'Staged pos attrs)
createStaged Maybe Text
label Queues CommandPool
pool Vector pos
pv Vector attrs
av Vector Word32
iv = do
  Allocated 'Staged pos
positions <- Maybe Text
-> Queues CommandPool
-> BufferUsageFlagBits
-> Int
-> Vector pos
-> m (Allocated 'Staged pos)
forall a env (m :: * -> *).
(Storable a, MonadVulkan env m) =>
Maybe Text
-> Queues CommandPool
-> BufferUsageFlagBits
-> Int
-> Vector a
-> m (Allocated 'Staged a)
Buffer.createStaged (Maybe Text
label Maybe Text -> (Text -> Text) -> Maybe Text
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Text
m -> Text -> Text -> Text
forall a. Monoid a => a -> a -> a
mappend Text
m Text
".positions") Queues CommandPool
pool BufferUsageFlagBits
Vk.BUFFER_USAGE_VERTEX_BUFFER_BIT Int
0 Vector pos
pv
  Allocated 'Staged attrs
attrs     <- Maybe Text
-> Queues CommandPool
-> BufferUsageFlagBits
-> Int
-> Vector attrs
-> m (Allocated 'Staged attrs)
forall a env (m :: * -> *).
(Storable a, MonadVulkan env m) =>
Maybe Text
-> Queues CommandPool
-> BufferUsageFlagBits
-> Int
-> Vector a
-> m (Allocated 'Staged a)
Buffer.createStaged (Maybe Text
label Maybe Text -> (Text -> Text) -> Maybe Text
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Text
m -> Text -> Text -> Text
forall a. Monoid a => a -> a -> a
mappend Text
m Text
".attrs") Queues CommandPool
pool BufferUsageFlagBits
Vk.BUFFER_USAGE_VERTEX_BUFFER_BIT Int
0 Vector attrs
av
  Allocated 'Staged Word32
indices   <- Maybe Text
-> Queues CommandPool
-> BufferUsageFlagBits
-> Int
-> Vector Word32
-> m (Allocated 'Staged Word32)
forall a env (m :: * -> *).
(Storable a, MonadVulkan env m) =>
Maybe Text
-> Queues CommandPool
-> BufferUsageFlagBits
-> Int
-> Vector a
-> m (Allocated 'Staged a)
Buffer.createStaged (Maybe Text
label Maybe Text -> (Text -> Text) -> Maybe Text
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Text
m -> Text -> Text -> Text
forall a. Monoid a => a -> a -> a
mappend Text
m Text
".indices") Queues CommandPool
pool BufferUsageFlagBits
Vk.BUFFER_USAGE_INDEX_BUFFER_BIT  Int
0 Vector Word32
iv
  pure Indexed
    { $sel:iLabel:Indexed :: Maybe Text
iLabel     = Maybe Text
label
    , $sel:iPositions:Indexed :: Allocated 'Staged pos
iPositions = Allocated 'Staged pos
positions
    , $sel:iAttrs:Indexed :: Allocated 'Staged attrs
iAttrs     = Allocated 'Staged attrs
attrs
    , $sel:iIndices:Indexed :: Allocated 'Staged Word32
iIndices   = Allocated 'Staged Word32
indices
    }

createCoherentEmpty
  :: ( MonadVulkan env m
     , Storable pos
     , Storable attrs
     )
  => Maybe Text
  -> Int
  -> m (Indexed 'Buffer.Coherent pos attrs)
createCoherentEmpty :: forall env (m :: * -> *) pos attrs.
(MonadVulkan env m, Storable pos, Storable attrs) =>
Maybe Text -> Int -> m (Indexed 'Coherent pos attrs)
createCoherentEmpty Maybe Text
label Int
initialSize = Maybe Text
-> Allocated 'Coherent pos
-> Allocated 'Coherent attrs
-> Allocated 'Coherent Word32
-> Indexed 'Coherent pos attrs
forall {k} {k} (storage :: Store) (pos :: k) (attrs :: k).
Maybe Text
-> Allocated storage pos
-> Allocated storage attrs
-> Allocated storage Word32
-> Indexed storage pos attrs
Indexed Maybe Text
label
  (Allocated 'Coherent pos
 -> Allocated 'Coherent attrs
 -> Allocated 'Coherent Word32
 -> Indexed 'Coherent pos attrs)
-> m (Allocated 'Coherent pos)
-> m (Allocated 'Coherent attrs
      -> Allocated 'Coherent Word32 -> Indexed 'Coherent pos attrs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
-> BufferUsageFlagBits
-> Int
-> Vector pos
-> m (Allocated 'Coherent pos)
forall a env (m :: * -> *).
(MonadVulkan env m, Storable a) =>
Maybe Text
-> BufferUsageFlagBits
-> Int
-> Vector a
-> m (Allocated 'Coherent a)
Buffer.createCoherent (Maybe Text
label Maybe Text -> (Text -> Text) -> Maybe Text
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Text
m -> Text -> Text -> Text
forall a. Monoid a => a -> a -> a
mappend Text
m Text
".positions") BufferUsageFlagBits
Vk.BUFFER_USAGE_VERTEX_BUFFER_BIT Int
initialSize Vector pos
forall a. Monoid a => a
mempty
  m (Allocated 'Coherent attrs
   -> Allocated 'Coherent Word32 -> Indexed 'Coherent pos attrs)
-> m (Allocated 'Coherent attrs)
-> m (Allocated 'Coherent Word32 -> Indexed 'Coherent pos attrs)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Text
-> BufferUsageFlagBits
-> Int
-> Vector attrs
-> m (Allocated 'Coherent attrs)
forall a env (m :: * -> *).
(MonadVulkan env m, Storable a) =>
Maybe Text
-> BufferUsageFlagBits
-> Int
-> Vector a
-> m (Allocated 'Coherent a)
Buffer.createCoherent (Maybe Text
label Maybe Text -> (Text -> Text) -> Maybe Text
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Text
m -> Text -> Text -> Text
forall a. Monoid a => a -> a -> a
mappend Text
m Text
".attrs") BufferUsageFlagBits
Vk.BUFFER_USAGE_VERTEX_BUFFER_BIT Int
initialSize Vector attrs
forall a. Monoid a => a
mempty
  m (Allocated 'Coherent Word32 -> Indexed 'Coherent pos attrs)
-> m (Allocated 'Coherent Word32)
-> m (Indexed 'Coherent pos attrs)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Text
-> BufferUsageFlagBits
-> Int
-> Vector Word32
-> m (Allocated 'Coherent Word32)
forall a env (m :: * -> *).
(MonadVulkan env m, Storable a) =>
Maybe Text
-> BufferUsageFlagBits
-> Int
-> Vector a
-> m (Allocated 'Coherent a)
Buffer.createCoherent (Maybe Text
label Maybe Text -> (Text -> Text) -> Maybe Text
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Text
m -> Text -> Text -> Text
forall a. Monoid a => a -> a -> a
mappend Text
m Text
".indices") BufferUsageFlagBits
Vk.BUFFER_USAGE_INDEX_BUFFER_BIT  Int
initialSize Vector Word32
forall a. Monoid a => a
mempty

registerIndexed_
  :: ( MonadVulkan env m
     , MonadResource m
     )
  => Indexed storage pos attrs
  -> m ()
registerIndexed_ :: forall {k} {k} env (m :: * -> *) (storage :: Store) (pos :: k)
       (attrs :: k).
(MonadVulkan env m, MonadResource m) =>
Indexed storage pos attrs -> m ()
registerIndexed_ Indexed{Maybe Text
Allocated storage pos
Allocated storage attrs
Allocated storage Word32
$sel:iLabel:Indexed :: forall {k} {k} (storage :: Store) (pos :: k) (attrs :: k).
Indexed storage pos attrs -> Maybe Text
$sel:iPositions:Indexed :: forall {k} {k} (storage :: Store) (pos :: k) (attrs :: k).
Indexed storage pos attrs -> Allocated storage pos
$sel:iAttrs:Indexed :: forall {k} {k} (storage :: Store) (pos :: k) (attrs :: k).
Indexed storage pos attrs -> Allocated storage attrs
$sel:iIndices:Indexed :: forall {k} {k} (storage :: Store) (pos :: k) (attrs :: k).
Indexed storage pos attrs -> Allocated storage Word32
iLabel :: Maybe Text
iPositions :: Allocated storage pos
iAttrs :: Allocated storage attrs
iIndices :: Allocated storage Word32
..} = do
  m ReleaseKey -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m ReleaseKey -> m ()) -> m ReleaseKey -> m ()
forall a b. (a -> b) -> a -> b
$! Allocated storage pos -> m ReleaseKey
forall {k} env (m :: * -> *) (stage :: Store) (a :: k).
(MonadVulkan env m, MonadResource m) =>
Allocated stage a -> m ReleaseKey
Buffer.register Allocated storage pos
iPositions
  m ReleaseKey -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m ReleaseKey -> m ()) -> m ReleaseKey -> m ()
forall a b. (a -> b) -> a -> b
$! Allocated storage attrs -> m ReleaseKey
forall {k} env (m :: * -> *) (stage :: Store) (a :: k).
(MonadVulkan env m, MonadResource m) =>
Allocated stage a -> m ReleaseKey
Buffer.register Allocated storage attrs
iAttrs
  m ReleaseKey -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m ReleaseKey -> m ()) -> m ReleaseKey -> m ()
forall a b. (a -> b) -> a -> b
$! Allocated storage Word32 -> m ReleaseKey
forall {k} env (m :: * -> *) (stage :: Store) (a :: k).
(MonadVulkan env m, MonadResource m) =>
Allocated stage a -> m ReleaseKey
Buffer.register Allocated storage Word32
iIndices

destroyIndexed
  :: MonadVulkan env m
  => Indexed storage pos attrs
  -> m ()
destroyIndexed :: forall {k} {k} env (m :: * -> *) (storage :: Store) (pos :: k)
       (attrs :: k).
MonadVulkan env m =>
Indexed storage pos attrs -> m ()
destroyIndexed Indexed{Maybe Text
Allocated storage pos
Allocated storage attrs
Allocated storage Word32
$sel:iLabel:Indexed :: forall {k} {k} (storage :: Store) (pos :: k) (attrs :: k).
Indexed storage pos attrs -> Maybe Text
$sel:iPositions:Indexed :: forall {k} {k} (storage :: Store) (pos :: k) (attrs :: k).
Indexed storage pos attrs -> Allocated storage pos
$sel:iAttrs:Indexed :: forall {k} {k} (storage :: Store) (pos :: k) (attrs :: k).
Indexed storage pos attrs -> Allocated storage attrs
$sel:iIndices:Indexed :: forall {k} {k} (storage :: Store) (pos :: k) (attrs :: k).
Indexed storage pos attrs -> Allocated storage Word32
iLabel :: Maybe Text
iPositions :: Allocated storage pos
iAttrs :: Allocated storage attrs
iIndices :: Allocated storage Word32
..} = do
  env
ctx <- m env
forall r (m :: * -> *). MonadReader r m => m r
ask
  env -> Allocated storage pos -> m ()
forall {k} (io :: * -> *) context (s :: Store) (a :: k).
(MonadUnliftIO io, HasVulkan context) =>
context -> Allocated s a -> io ()
Buffer.destroy env
ctx Allocated storage pos
iPositions
  env -> Allocated storage attrs -> m ()
forall {k} (io :: * -> *) context (s :: Store) (a :: k).
(MonadUnliftIO io, HasVulkan context) =>
context -> Allocated s a -> io ()
Buffer.destroy env
ctx Allocated storage attrs
iAttrs
  env -> Allocated storage Word32 -> m ()
forall {k} (io :: * -> *) context (s :: Store) (a :: k).
(MonadUnliftIO io, HasVulkan context) =>
context -> Allocated s a -> io ()
Buffer.destroy env
ctx Allocated storage Word32
iIndices

updateCoherent
  :: ( MonadVulkan env m
     , Storable pos
     , Storable attrs
     )
  => [Vertex pos attrs]
  -> Indexed 'Buffer.Coherent pos attrs
  -> m (Indexed 'Buffer.Coherent pos attrs)
updateCoherent :: forall env (m :: * -> *) pos attrs.
(MonadVulkan env m, Storable pos, Storable attrs) =>
[Vertex pos attrs]
-> Indexed 'Coherent pos attrs -> m (Indexed 'Coherent pos attrs)
updateCoherent [Vertex pos attrs]
vertices Indexed 'Coherent pos attrs
old = do
  Indexed{Maybe Text
Allocated 'Coherent pos
Allocated 'Coherent attrs
Allocated 'Coherent Word32
$sel:iLabel:Indexed :: forall {k} {k} (storage :: Store) (pos :: k) (attrs :: k).
Indexed storage pos attrs -> Maybe Text
$sel:iPositions:Indexed :: forall {k} {k} (storage :: Store) (pos :: k) (attrs :: k).
Indexed storage pos attrs -> Allocated storage pos
$sel:iAttrs:Indexed :: forall {k} {k} (storage :: Store) (pos :: k) (attrs :: k).
Indexed storage pos attrs -> Allocated storage attrs
$sel:iIndices:Indexed :: forall {k} {k} (storage :: Store) (pos :: k) (attrs :: k).
Indexed storage pos attrs -> Allocated storage Word32
iLabel :: Maybe Text
iPositions :: Allocated 'Coherent pos
iAttrs :: Allocated 'Coherent attrs
iIndices :: Allocated 'Coherent Word32
..} <- m (Indexed 'Coherent pos attrs)
pick
  Maybe Text
-> Allocated 'Coherent pos
-> Allocated 'Coherent attrs
-> Allocated 'Coherent Word32
-> Indexed 'Coherent pos attrs
forall {k} {k} (storage :: Store) (pos :: k) (attrs :: k).
Maybe Text
-> Allocated storage pos
-> Allocated storage attrs
-> Allocated storage Word32
-> Indexed storage pos attrs
Indexed Maybe Text
iLabel
    (Allocated 'Coherent pos
 -> Allocated 'Coherent attrs
 -> Allocated 'Coherent Word32
 -> Indexed 'Coherent pos attrs)
-> m (Allocated 'Coherent pos)
-> m (Allocated 'Coherent attrs
      -> Allocated 'Coherent Word32 -> Indexed 'Coherent pos attrs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector pos
-> Allocated 'Coherent pos -> m (Allocated 'Coherent pos)
forall (io :: * -> *) a.
(MonadUnliftIO io, Storable a) =>
Vector a -> Allocated 'Coherent a -> io (Allocated 'Coherent a)
Buffer.updateCoherent Vector pos
pv Allocated 'Coherent pos
iPositions
    m (Allocated 'Coherent attrs
   -> Allocated 'Coherent Word32 -> Indexed 'Coherent pos attrs)
-> m (Allocated 'Coherent attrs)
-> m (Allocated 'Coherent Word32 -> Indexed 'Coherent pos attrs)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Vector attrs
-> Allocated 'Coherent attrs -> m (Allocated 'Coherent attrs)
forall (io :: * -> *) a.
(MonadUnliftIO io, Storable a) =>
Vector a -> Allocated 'Coherent a -> io (Allocated 'Coherent a)
Buffer.updateCoherent Vector attrs
av Allocated 'Coherent attrs
iAttrs
    m (Allocated 'Coherent Word32 -> Indexed 'Coherent pos attrs)
-> m (Allocated 'Coherent Word32)
-> m (Indexed 'Coherent pos attrs)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Vector Word32
-> Allocated 'Coherent Word32 -> m (Allocated 'Coherent Word32)
forall (io :: * -> *) a.
(MonadUnliftIO io, Storable a) =>
Vector a -> Allocated 'Coherent a -> io (Allocated 'Coherent a)
Buffer.updateCoherent Vector Word32
iv Allocated 'Coherent Word32
iIndices
  where
    pick :: m (Indexed 'Coherent pos attrs)
pick =
      if Int
oldSize Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
newSize then
        Indexed 'Coherent pos attrs -> m (Indexed 'Coherent pos attrs)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Indexed 'Coherent pos attrs
old
      else do
        Indexed 'Coherent pos attrs -> m ()
forall {k} {k} env (m :: * -> *) (storage :: Store) (pos :: k)
       (attrs :: k).
MonadVulkan env m =>
Indexed storage pos attrs -> m ()
destroyIndexed Indexed 'Coherent pos attrs
old
        Maybe Text -> Int -> m (Indexed 'Coherent pos attrs)
forall env (m :: * -> *) pos attrs.
(MonadVulkan env m, Storable pos, Storable attrs) =>
Maybe Text -> Int -> m (Indexed 'Coherent pos attrs)
createCoherentEmpty (Indexed 'Coherent pos attrs -> Maybe Text
forall {k} {k} (storage :: Store) (pos :: k) (attrs :: k).
Indexed storage pos attrs -> Maybe Text
iLabel Indexed 'Coherent pos attrs
old) (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
newSize (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
oldSize Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2)

    oldSize :: Int
oldSize = Allocated 'Coherent Word32 -> Int
forall {k} (s :: Store) (a :: k). Allocated s a -> Int
Buffer.aCapacity (Allocated 'Coherent Word32 -> Int)
-> Allocated 'Coherent Word32 -> Int
forall a b. (a -> b) -> a -> b
$ Indexed 'Coherent pos attrs -> Allocated 'Coherent Word32
forall {k} {k} (storage :: Store) (pos :: k) (attrs :: k).
Indexed storage pos attrs -> Allocated storage Word32
iIndices Indexed 'Coherent pos attrs
old
    newSize :: Int
newSize = Vector pos -> Int
forall a. Storable a => Vector a -> Int
Storable.length Vector pos
pv

    pv :: Vector pos
pv = [pos] -> Vector pos
forall a. Storable a => [a] -> Vector a
Storable.fromList [pos]
ps
    av :: Vector attrs
av = [attrs] -> Vector attrs
forall a. Storable a => [a] -> Vector a
Storable.fromList [attrs]
as

    iv :: Vector Word32
iv = Int -> (Int -> Word32) -> Vector Word32
forall a. Storable a => Int -> (Int -> a) -> Vector a
Storable.generate Int
newSize Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral

    ([pos]
ps, [attrs]
as) = [(pos, attrs)] -> ([pos], [attrs])
forall a b. [(a, b)] -> ([a], [b])
List.unzip do
      Vertex{pos
attrs
$sel:vPosition:Vertex :: forall pos attrs. Vertex pos attrs -> pos
$sel:vAttrs:Vertex :: forall pos attrs. Vertex pos attrs -> attrs
vPosition :: pos
vAttrs :: attrs
..} <- [Vertex pos attrs]
vertices
      (pos, attrs) -> [(pos, attrs)]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (pos
vPosition, attrs
vAttrs)