{-# 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 (storage :: Store) pos attrs.
Indexed storage pos attrs -> Maybe Text
iLabel :: Maybe Text
, forall (storage :: Store) pos attrs.
Indexed storage pos attrs -> Allocated storage pos
iPositions :: Buffer.Allocated storage pos
, forall (storage :: Store) pos attrs.
Indexed storage pos attrs -> Allocated storage attrs
iAttrs :: Buffer.Allocated storage attrs
, forall (storage :: Store) pos attrs.
Indexed storage pos attrs -> Allocated storage Word32
iIndices :: Buffer.Allocated storage Word32
} deriving (Int -> Indexed storage pos attrs -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (storage :: Store) pos attrs.
Int -> Indexed storage pos attrs -> ShowS
forall (storage :: Store) pos attrs.
[Indexed storage pos attrs] -> ShowS
forall (storage :: Store) pos attrs.
Indexed storage pos attrs -> String
showList :: [Indexed storage pos attrs] -> ShowS
$cshowList :: forall (storage :: Store) pos attrs.
[Indexed storage pos attrs] -> ShowS
show :: Indexed storage pos attrs -> String
$cshow :: forall (storage :: Store) pos attrs.
Indexed storage pos attrs -> String
showsPrec :: Int -> Indexed storage pos attrs -> ShowS
$cshowsPrec :: forall (storage :: Store) pos attrs.
Int -> 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
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
$c== :: forall pos attrs.
(Eq pos, Eq attrs) =>
Vertex pos attrs -> Vertex pos attrs -> Bool
Eq, Vertex pos attrs -> Vertex pos attrs -> Bool
Vertex pos attrs -> Vertex pos attrs -> Ordering
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
min :: 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
max :: Vertex pos attrs -> Vertex pos attrs -> Vertex pos attrs
$cmax :: forall pos attrs.
(Ord pos, Ord attrs) =>
Vertex pos attrs -> Vertex pos attrs -> Vertex pos attrs
>= :: 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
$c< :: forall pos attrs.
(Ord pos, Ord attrs) =>
Vertex pos attrs -> Vertex pos attrs -> Bool
compare :: Vertex pos attrs -> Vertex pos attrs -> Ordering
$ccompare :: forall pos attrs.
(Ord pos, Ord attrs) =>
Vertex pos attrs -> Vertex pos attrs -> Ordering
Ord, Int -> Vertex pos attrs -> ShowS
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
showList :: [Vertex pos attrs] -> ShowS
$cshowList :: forall pos attrs.
(Show pos, Show attrs) =>
[Vertex pos attrs] -> ShowS
show :: Vertex pos attrs -> String
$cshow :: forall pos attrs.
(Show pos, Show attrs) =>
Vertex pos attrs -> String
showsPrec :: Int -> Vertex pos attrs -> ShowS
$cshowsPrec :: forall pos attrs.
(Show pos, Show attrs) =>
Int -> Vertex pos attrs -> ShowS
Show, 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
<$ :: forall a b. a -> Vertex pos b -> Vertex pos a
$c<$ :: forall pos a b. a -> Vertex pos b -> Vertex pos a
fmap :: forall a b. (a -> b) -> Vertex pos a -> Vertex pos b
$cfmap :: forall pos a b. (a -> b) -> Vertex pos a -> Vertex pos b
Functor, forall a. Vertex pos a -> Bool
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 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
product :: forall a. Num a => Vertex pos a -> a
$cproduct :: forall pos a. Num a => Vertex pos a -> a
sum :: forall a. Num a => Vertex pos a -> a
$csum :: forall pos a. Num a => Vertex pos a -> a
minimum :: forall a. Ord a => Vertex pos a -> a
$cminimum :: forall pos a. Ord a => Vertex pos a -> a
maximum :: forall a. Ord a => Vertex pos a -> a
$cmaximum :: forall pos a. Ord a => Vertex pos a -> a
elem :: forall a. Eq a => a -> Vertex pos a -> Bool
$celem :: forall pos a. Eq a => a -> Vertex pos a -> Bool
length :: forall a. Vertex pos a -> Int
$clength :: forall pos a. Vertex pos a -> Int
null :: forall a. Vertex pos a -> Bool
$cnull :: forall pos a. Vertex pos a -> Bool
toList :: forall a. Vertex pos a -> [a]
$ctoList :: forall pos a. Vertex pos a -> [a]
foldl1 :: forall a. (a -> a -> a) -> Vertex pos a -> a
$cfoldl1 :: forall pos a. (a -> a -> a) -> Vertex pos a -> a
foldr1 :: forall a. (a -> a -> a) -> Vertex pos a -> a
$cfoldr1 :: forall pos a. (a -> a -> a) -> Vertex pos a -> a
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
$cfoldl :: forall pos b a. (b -> a -> 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
$cfoldr :: forall pos a b. (a -> b -> b) -> b -> Vertex pos a -> b
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
$cfoldMap :: forall pos m a. Monoid m => (a -> m) -> Vertex pos a -> m
fold :: forall m. Monoid m => Vertex pos m -> m
$cfold :: forall pos m. Monoid m => Vertex pos m -> m
Foldable, 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 (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Vertex pos a -> f (Vertex pos b)
sequence :: forall (m :: * -> *) a.
Monad m =>
Vertex pos (m a) -> m (Vertex pos a)
$csequence :: forall pos (m :: * -> *) a.
Monad m =>
Vertex pos (m a) -> m (Vertex pos a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Vertex pos a -> m (Vertex pos b)
$cmapM :: forall pos (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Vertex pos a -> m (Vertex pos b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Vertex pos (f a) -> f (Vertex pos a)
$csequenceA :: forall pos (f :: * -> *) a.
Applicative f =>
Vertex pos (f a) -> f (Vertex pos a)
traverse :: 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)
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
vAttrs :: a
vPosition :: pos
$sel:vAttrs:Vertex :: forall pos attrs. Vertex pos attrs -> attrs
$sel:vPosition:Vertex :: forall pos attrs. Vertex pos attrs -> pos
..} <- [Vertex pos a]
vertices
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 = forall a. (Generic a, GHasVertexBuffers (Rep a)) => a -> [Buffer]
genericGetVertexBuffers
default getInstanceCount
:: ( Generic a
, GHasVertexBuffers (Rep a)
)
=> a
-> Word32
getInstanceCount = 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 HasVertexBuffers (Buffer.Allocated store a) where
type VertexBuffersOf (Buffer.Allocated store a) = a
{-# INLINE getVertexBuffers #-}
getVertexBuffers :: Allocated store a -> [Buffer]
getVertexBuffers Buffer.Allocated{Buffer
$sel:aBuffer:Allocated :: forall (s :: Store) a. Allocated s a -> Buffer
aBuffer :: Buffer
aBuffer} = [Buffer
aBuffer]
{-# INLINE getInstanceCount #-}
getInstanceCount :: Allocated store a -> Word32
getInstanceCount = forall (store :: Store) a. Allocated store a -> Word32
Buffer.aUsed
genericGetVertexBuffers
:: ( Generic a
, GHasVertexBuffers (Rep a)
)
=> a
-> [Vk.Buffer]
genericGetVertexBuffers :: forall a. (Generic a, GHasVertexBuffers (Rep a)) => a -> [Buffer]
genericGetVertexBuffers = forall (f :: * -> *) a. GHasVertexBuffers f => f a -> [Buffer]
gVertexBuffers forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (f :: * -> *) a. GHasVertexBuffers f => f a -> Word32
gInstanceCount forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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) = 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) = 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) = forall (f :: * -> *) a. GHasVertexBuffers f => f a -> [Buffer]
gVertexBuffers l a
l forall a. Semigroup a => a -> a -> a
<> 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) = forall a. Ord a => a -> a -> a
min (forall (f :: * -> *) a. GHasVertexBuffers f => f a -> Word32
gInstanceCount l a
l) (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) = forall a. HasVertexBuffers a => a -> [Buffer]
getVertexBuffers a
a
gInstanceCount :: forall a. K1 r a a -> Word32
gInstanceCount (K1 a
a) = forall a. HasVertexBuffers a => a -> Word32
getInstanceCount a
a
data IndexRange = IndexRange
{ IndexRange -> Word32
irFirstIndex :: Word32
, IndexRange -> Word32
irIndexCount :: Word32
}
deriving (IndexRange -> IndexRange -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IndexRange -> IndexRange -> Bool
$c/= :: IndexRange -> IndexRange -> Bool
== :: IndexRange -> IndexRange -> Bool
$c== :: IndexRange -> IndexRange -> Bool
Eq, Eq 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
min :: IndexRange -> IndexRange -> IndexRange
$cmin :: IndexRange -> IndexRange -> IndexRange
max :: IndexRange -> IndexRange -> IndexRange
$cmax :: IndexRange -> IndexRange -> IndexRange
>= :: IndexRange -> IndexRange -> Bool
$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
compare :: IndexRange -> IndexRange -> Ordering
$ccompare :: IndexRange -> IndexRange -> Ordering
Ord, Int -> IndexRange -> ShowS
[IndexRange] -> ShowS
IndexRange -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IndexRange] -> ShowS
$cshowList :: [IndexRange] -> ShowS
show :: IndexRange -> String
$cshow :: IndexRange -> String
showsPrec :: Int -> IndexRange -> ShowS
$cshowsPrec :: Int -> IndexRange -> ShowS
Show, 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
$cto :: forall x. Rep IndexRange x -> IndexRange
$cfrom :: forall x. IndexRange -> Rep IndexRange x
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 <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr IndexRange
ptr Int
0
Word32
irIndexCount <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr IndexRange
ptr Int
4
pure IndexRange{Word32
irIndexCount :: Word32
irFirstIndex :: Word32
$sel:irIndexCount:IndexRange :: Word32
$sel:irFirstIndex:IndexRange :: Word32
..}
poke :: Ptr IndexRange -> IndexRange -> IO ()
poke Ptr IndexRange
ptr IndexRange{Word32
irIndexCount :: Word32
irFirstIndex :: Word32
$sel:irIndexCount:IndexRange :: IndexRange -> Word32
$sel:irFirstIndex:IndexRange :: IndexRange -> Word32
..} = do
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr IndexRange
ptr Int
0 Word32
irFirstIndex
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 = 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 = forall a. Storable a => [a] -> Vector a
Storable.fromList [pos]
ps
av :: Vector attrs
av = forall a. Storable a => [a] -> Vector a
Storable.fromList [attrs]
as
iv :: Vector Word32
iv = case Maybe [Word32]
mindices of
Just [Word32]
is ->
forall a. Storable a => [a] -> Vector a
Storable.fromList [Word32]
is
Maybe [Word32]
Nothing ->
forall a. Storable a => Int -> (Int -> a) -> Vector a
Storable.generate (forall a. Storable a => Vector a -> Int
Storable.length Vector pos
pv) forall a b. (Integral a, Num b) => a -> b
fromIntegral
([pos]
ps, [attrs]
as) = forall a b. [(a, b)] -> ([a], [b])
List.unzip do
Vertex{pos
attrs
vAttrs :: attrs
vPosition :: pos
$sel:vAttrs:Vertex :: forall pos attrs. Vertex pos attrs -> attrs
$sel:vPosition:Vertex :: forall pos attrs. Vertex pos attrs -> pos
..} <- [Vertex pos attrs]
vertices
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 <- 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 forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Text
m -> 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 <- 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 forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Text
m -> 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 <- 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 forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Text
m -> 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 = forall (storage :: Store) pos attrs.
Maybe Text
-> Allocated storage pos
-> Allocated storage attrs
-> Allocated storage Word32
-> Indexed storage pos attrs
Indexed Maybe Text
label
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a env (m :: * -> *).
(MonadVulkan env m, Storable a) =>
Maybe Text
-> BufferUsageFlagBits
-> Int
-> Vector a
-> m (Allocated 'Coherent a)
Buffer.createCoherent (Maybe Text
label forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Text
m -> forall a. Monoid a => a -> a -> a
mappend Text
m Text
".positions") BufferUsageFlagBits
Vk.BUFFER_USAGE_VERTEX_BUFFER_BIT Int
initialSize forall a. Monoid a => a
mempty
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a env (m :: * -> *).
(MonadVulkan env m, Storable a) =>
Maybe Text
-> BufferUsageFlagBits
-> Int
-> Vector a
-> m (Allocated 'Coherent a)
Buffer.createCoherent (Maybe Text
label forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Text
m -> forall a. Monoid a => a -> a -> a
mappend Text
m Text
".attrs") BufferUsageFlagBits
Vk.BUFFER_USAGE_VERTEX_BUFFER_BIT Int
initialSize forall a. Monoid a => a
mempty
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a env (m :: * -> *).
(MonadVulkan env m, Storable a) =>
Maybe Text
-> BufferUsageFlagBits
-> Int
-> Vector a
-> m (Allocated 'Coherent a)
Buffer.createCoherent (Maybe Text
label forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Text
m -> forall a. Monoid a => a -> a -> a
mappend Text
m Text
".indices") BufferUsageFlagBits
Vk.BUFFER_USAGE_INDEX_BUFFER_BIT Int
initialSize forall a. Monoid a => a
mempty
registerIndexed_
:: ( MonadVulkan env m
, MonadResource m
)
=> Indexed storage pos attrs
-> m ()
registerIndexed_ :: forall env (m :: * -> *) (storage :: Store) pos attrs.
(MonadVulkan env m, MonadResource m) =>
Indexed storage pos attrs -> m ()
registerIndexed_ Indexed{Maybe Text
Allocated storage pos
Allocated storage attrs
Allocated storage Word32
iIndices :: Allocated storage Word32
iAttrs :: Allocated storage attrs
iPositions :: Allocated storage pos
iLabel :: Maybe Text
$sel:iIndices:Indexed :: forall (storage :: Store) pos attrs.
Indexed storage pos attrs -> Allocated storage Word32
$sel:iAttrs:Indexed :: forall (storage :: Store) pos attrs.
Indexed storage pos attrs -> Allocated storage attrs
$sel:iPositions:Indexed :: forall (storage :: Store) pos attrs.
Indexed storage pos attrs -> Allocated storage pos
$sel:iLabel:Indexed :: forall (storage :: Store) pos attrs.
Indexed storage pos attrs -> Maybe Text
..} = do
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$! forall env (m :: * -> *) (stage :: Store) a.
(MonadVulkan env m, MonadResource m) =>
Allocated stage a -> m ReleaseKey
Buffer.register Allocated storage pos
iPositions
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$! forall env (m :: * -> *) (stage :: Store) a.
(MonadVulkan env m, MonadResource m) =>
Allocated stage a -> m ReleaseKey
Buffer.register Allocated storage attrs
iAttrs
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$! forall env (m :: * -> *) (stage :: Store) a.
(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 env (m :: * -> *) (storage :: Store) pos attrs.
MonadVulkan env m =>
Indexed storage pos attrs -> m ()
destroyIndexed Indexed{Maybe Text
Allocated storage pos
Allocated storage attrs
Allocated storage Word32
iIndices :: Allocated storage Word32
iAttrs :: Allocated storage attrs
iPositions :: Allocated storage pos
iLabel :: Maybe Text
$sel:iIndices:Indexed :: forall (storage :: Store) pos attrs.
Indexed storage pos attrs -> Allocated storage Word32
$sel:iAttrs:Indexed :: forall (storage :: Store) pos attrs.
Indexed storage pos attrs -> Allocated storage attrs
$sel:iPositions:Indexed :: forall (storage :: Store) pos attrs.
Indexed storage pos attrs -> Allocated storage pos
$sel:iLabel:Indexed :: forall (storage :: Store) pos attrs.
Indexed storage pos attrs -> Maybe Text
..} = do
env
ctx <- forall r (m :: * -> *). MonadReader r m => m r
ask
forall (io :: * -> *) context (s :: Store) a.
(MonadUnliftIO io, HasVulkan context) =>
context -> Allocated s a -> io ()
Buffer.destroy env
ctx Allocated storage pos
iPositions
forall (io :: * -> *) context (s :: Store) a.
(MonadUnliftIO io, HasVulkan context) =>
context -> Allocated s a -> io ()
Buffer.destroy env
ctx Allocated storage attrs
iAttrs
forall (io :: * -> *) context (s :: Store) a.
(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
iIndices :: Allocated 'Coherent Word32
iAttrs :: Allocated 'Coherent attrs
iPositions :: Allocated 'Coherent pos
iLabel :: Maybe Text
$sel:iIndices:Indexed :: forall (storage :: Store) pos attrs.
Indexed storage pos attrs -> Allocated storage Word32
$sel:iAttrs:Indexed :: forall (storage :: Store) pos attrs.
Indexed storage pos attrs -> Allocated storage attrs
$sel:iPositions:Indexed :: forall (storage :: Store) pos attrs.
Indexed storage pos attrs -> Allocated storage pos
$sel:iLabel:Indexed :: forall (storage :: Store) pos attrs.
Indexed storage pos attrs -> Maybe Text
..} <- m (Indexed 'Coherent pos attrs)
pick
forall (storage :: Store) pos attrs.
Maybe Text
-> Allocated storage pos
-> Allocated storage attrs
-> Allocated storage Word32
-> Indexed storage pos attrs
Indexed Maybe Text
iLabel
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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 forall a. Ord a => a -> a -> Bool
> Int
newSize then
forall (f :: * -> *) a. Applicative f => a -> f a
pure Indexed 'Coherent pos attrs
old
else do
forall env (m :: * -> *) (storage :: Store) pos attrs.
MonadVulkan env m =>
Indexed storage pos attrs -> m ()
destroyIndexed Indexed 'Coherent pos attrs
old
forall env (m :: * -> *) pos attrs.
(MonadVulkan env m, Storable pos, Storable attrs) =>
Maybe Text -> Int -> m (Indexed 'Coherent pos attrs)
createCoherentEmpty (forall (storage :: Store) pos attrs.
Indexed storage pos attrs -> Maybe Text
iLabel Indexed 'Coherent pos attrs
old) (forall a. Ord a => a -> a -> a
max Int
newSize forall a b. (a -> b) -> a -> b
$ Int
oldSize forall a. Num a => a -> a -> a
* Int
2)
oldSize :: Int
oldSize = forall (s :: Store) a. Allocated s a -> Int
Buffer.aCapacity forall a b. (a -> b) -> a -> b
$ forall (storage :: Store) pos attrs.
Indexed storage pos attrs -> Allocated storage Word32
iIndices Indexed 'Coherent pos attrs
old
newSize :: Int
newSize = forall a. Storable a => Vector a -> Int
Storable.length Vector pos
pv
pv :: Vector pos
pv = forall a. Storable a => [a] -> Vector a
Storable.fromList [pos]
ps
av :: Vector attrs
av = forall a. Storable a => [a] -> Vector a
Storable.fromList [attrs]
as
iv :: Vector Word32
iv = forall a. Storable a => Int -> (Int -> a) -> Vector a
Storable.generate Int
newSize forall a b. (Integral a, Num b) => a -> b
fromIntegral
([pos]
ps, [attrs]
as) = forall a b. [(a, b)] -> ([a], [b])
List.unzip do
Vertex{pos
attrs
vAttrs :: attrs
vPosition :: pos
$sel:vAttrs:Vertex :: forall pos attrs. Vertex pos attrs -> attrs
$sel:vPosition:Vertex :: forall pos attrs. Vertex pos attrs -> pos
..} <- [Vertex pos attrs]
vertices
forall (f :: * -> *) a. Applicative f => a -> f a
pure (pos
vPosition, attrs
vAttrs)