module Resource.Buffer where

import RIO

import Data.Bits ((.|.))
import Data.Vector.Storable qualified as VectorS
import Foreign (Storable)
import Foreign qualified
import UnliftIO.Resource qualified as Resource
import Vulkan.Core10 qualified as Vk
import Vulkan.NamedType ((:::))
import Vulkan.Zero (zero)
import VulkanMemoryAllocator qualified as VMA

import Engine.Vulkan.Types (HasVulkan(getAllocator), Queues(qTransfer))
import Resource.CommandBuffer (oneshot_)

data Store = Staged | Coherent

data Allocated (s :: Store) a = Allocated
  { Allocated s a -> Buffer
aBuffer         :: Vk.Buffer
  , Allocated s a -> Allocation
aAllocation     :: VMA.Allocation
  , Allocated s a -> AllocationInfo
aAllocationInfo :: VMA.AllocationInfo
  , Allocated s a -> Int
aCapacity       :: Int
  , Allocated s a -> Word32
aUsed           :: Word32
  , Allocated s a -> BufferUsageFlagBits
aUsage          :: Vk.BufferUsageFlagBits
  } deriving (Int -> Allocated s a -> ShowS
[Allocated s a] -> ShowS
Allocated s a -> String
(Int -> Allocated s a -> ShowS)
-> (Allocated s a -> String)
-> ([Allocated s a] -> ShowS)
-> Show (Allocated s a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (s :: Store) a. Int -> Allocated s a -> ShowS
forall (s :: Store) a. [Allocated s a] -> ShowS
forall (s :: Store) a. Allocated s a -> String
showList :: [Allocated s a] -> ShowS
$cshowList :: forall (s :: Store) a. [Allocated s a] -> ShowS
show :: Allocated s a -> String
$cshow :: forall (s :: Store) a. Allocated s a -> String
showsPrec :: Int -> Allocated s a -> ShowS
$cshowsPrec :: forall (s :: Store) a. Int -> Allocated s a -> ShowS
Show)

allocateCoherent
  :: (Resource.MonadResource m, Storable a, HasVulkan context)
  => context
  -> Vk.BufferUsageFlagBits
  -> "initial size" ::: Int
  -> VectorS.Vector a
  -> m (Resource.ReleaseKey, Allocated 'Coherent a)
allocateCoherent :: context
-> BufferUsageFlagBits
-> Int
-> Vector a
-> m (ReleaseKey, Allocated 'Coherent a)
allocateCoherent context
context BufferUsageFlagBits
usage Int
initialSize Vector a
xs =
  IO (Allocated 'Coherent a)
-> (Allocated 'Coherent a -> IO ())
-> m (ReleaseKey, Allocated 'Coherent a)
forall (m :: * -> *) a.
MonadResource m =>
IO a -> (a -> IO ()) -> m (ReleaseKey, a)
Resource.allocate
    (context
-> BufferUsageFlagBits
-> Int
-> Vector a
-> IO (Allocated 'Coherent a)
forall a context (io :: * -> *).
(Storable a, HasVulkan context, MonadUnliftIO io) =>
context
-> BufferUsageFlagBits
-> Int
-> Vector a
-> io (Allocated 'Coherent a)
createCoherent context
context BufferUsageFlagBits
usage Int
initialSize Vector a
xs)
    (context -> Allocated 'Coherent a -> IO ()
forall (io :: * -> *) context (s :: Store) a.
(MonadUnliftIO io, HasVulkan context) =>
context -> Allocated s a -> io ()
destroy context
context)

createCoherent
  :: forall a context io . (Storable a, HasVulkan context, MonadUnliftIO io)
  => context
  -> Vk.BufferUsageFlagBits
  -> "initial size" ::: Int
  -> VectorS.Vector a
  -> io (Allocated 'Coherent a)
createCoherent :: context
-> BufferUsageFlagBits
-> Int
-> Vector a
-> io (Allocated 'Coherent a)
createCoherent context
context BufferUsageFlagBits
usage Int
initialSize Vector a
xs = do
  (Buffer
aBuffer, Allocation
aAllocation, AllocationInfo
aAllocationInfo) <- Allocator
-> BufferCreateInfo '[]
-> AllocationCreateInfo
-> io (Buffer, Allocation, AllocationInfo)
forall (a :: [*]) (io :: * -> *).
(Extendss BufferCreateInfo a, PokeChain a, MonadIO io) =>
Allocator
-> BufferCreateInfo a
-> AllocationCreateInfo
-> io (Buffer, Allocation, AllocationInfo)
VMA.createBuffer (context -> Allocator
forall a. HasVulkan a => a -> Allocator
getAllocator context
context) BufferCreateInfo '[]
bci AllocationCreateInfo
aci

  Bool -> io () -> io ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0) (io () -> io ()) -> io () -> io ()
forall a b. (a -> b) -> a -> b
$
    if AllocationInfo -> Ptr ()
VMA.mappedData AllocationInfo
aAllocationInfo Ptr () -> Ptr () -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr ()
forall a. Ptr a
Foreign.nullPtr then
      String -> io ()
forall a. HasCallStack => String -> a
error String
"TODO: recover from unmapped data and flush manually"
    else
      IO () -> io ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> io ()) -> IO () -> io ()
forall a b. (a -> b) -> a -> b
$ Vector a -> (Ptr a -> IO ()) -> IO ()
forall a b. Storable a => Vector a -> (Ptr a -> IO b) -> IO b
VectorS.unsafeWith Vector a
xs \Ptr a
src ->
        Ptr a -> Ptr a -> Int -> IO ()
forall a. Ptr a -> Ptr a -> Int -> IO ()
Foreign.copyBytes (Ptr () -> Ptr a
forall a b. Ptr a -> Ptr b
Foreign.castPtr (Ptr () -> Ptr a) -> Ptr () -> Ptr a
forall a b. (a -> b) -> a -> b
$ AllocationInfo -> Ptr ()
VMA.mappedData AllocationInfo
aAllocationInfo) Ptr a
src Int
lenBytes

  pure Allocated :: forall (s :: Store) a.
Buffer
-> Allocation
-> AllocationInfo
-> Int
-> Word32
-> BufferUsageFlagBits
-> Allocated s a
Allocated
    { $sel:aCapacity:Allocated :: Int
aCapacity = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
initialSize Int
len
    , $sel:aUsed:Allocated :: Word32
aUsed     = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len
    , $sel:aUsage:Allocated :: BufferUsageFlagBits
aUsage    = BufferUsageFlagBits
usage
    , Buffer
Allocation
AllocationInfo
aAllocationInfo :: AllocationInfo
aAllocation :: Allocation
aBuffer :: Buffer
$sel:aAllocationInfo:Allocated :: AllocationInfo
$sel:aAllocation:Allocated :: Allocation
$sel:aBuffer:Allocated :: Buffer
..
    }
  where

    len :: Int
len = Vector a -> Int
forall a. Storable a => Vector a -> Int
VectorS.length Vector a
xs
    lenBytes :: Int
lenBytes = a -> Int
forall a. Storable a => a -> Int
Foreign.sizeOf (a
forall a. HasCallStack => a
undefined :: a) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
len

    sizeBytes :: Int
sizeBytes = a -> Int
forall a. Storable a => a -> Int
Foreign.sizeOf (a
forall a. HasCallStack => a
undefined :: a) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
initialSize Int
len

    bci :: BufferCreateInfo '[]
bci = BufferCreateInfo '[]
forall a. Zero a => a
zero
      { $sel:size:BufferCreateInfo :: DeviceSize
Vk.size        = Int -> DeviceSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sizeBytes
      , $sel:usage:BufferCreateInfo :: BufferUsageFlagBits
Vk.usage       = BufferUsageFlagBits
usage
      , $sel:sharingMode:BufferCreateInfo :: SharingMode
Vk.sharingMode = SharingMode
Vk.SHARING_MODE_EXCLUSIVE
      }

    flags :: MemoryPropertyFlagBits
flags =
      MemoryPropertyFlagBits
Vk.MEMORY_PROPERTY_HOST_VISIBLE_BIT MemoryPropertyFlagBits
-> MemoryPropertyFlagBits -> MemoryPropertyFlagBits
forall a. Bits a => a -> a -> a
.|.
      MemoryPropertyFlagBits
Vk.MEMORY_PROPERTY_HOST_COHERENT_BIT

    aci :: AllocationCreateInfo
aci = AllocationCreateInfo
forall a. Zero a => a
zero
      { $sel:flags:AllocationCreateInfo :: AllocationCreateFlags
VMA.flags          = AllocationCreateFlags
VMA.ALLOCATION_CREATE_MAPPED_BIT
      , $sel:usage:AllocationCreateInfo :: MemoryUsage
VMA.usage          = MemoryUsage
VMA.MEMORY_USAGE_GPU_ONLY
      , $sel:requiredFlags:AllocationCreateInfo :: MemoryPropertyFlagBits
VMA.requiredFlags  = MemoryPropertyFlagBits
flags
      , $sel:preferredFlags:AllocationCreateInfo :: MemoryPropertyFlagBits
VMA.preferredFlags = MemoryPropertyFlagBits
Vk.MEMORY_PROPERTY_DEVICE_LOCAL_BIT
      }

createStaged
  :: forall a context io . (Storable a, HasVulkan context, MonadUnliftIO io)
  => context
  -> Queues Vk.CommandPool
  -> Vk.BufferUsageFlagBits
  -> Int
  -> VectorS.Vector a
  -> io (Allocated 'Staged a)
createStaged :: context
-> Queues CommandPool
-> BufferUsageFlagBits
-> Int
-> Vector a
-> io (Allocated 'Staged a)
createStaged context
context Queues CommandPool
commandQueues BufferUsageFlagBits
usage Int
initialSize Vector a
xs = do
  (Buffer
aBuffer, Allocation
aAllocation, AllocationInfo
aAllocationInfo) <- Allocator
-> BufferCreateInfo '[]
-> AllocationCreateInfo
-> io (Buffer, Allocation, AllocationInfo)
forall (a :: [*]) (io :: * -> *).
(Extendss BufferCreateInfo a, PokeChain a, MonadIO io) =>
Allocator
-> BufferCreateInfo a
-> AllocationCreateInfo
-> io (Buffer, Allocation, AllocationInfo)
VMA.createBuffer Allocator
vma BufferCreateInfo '[]
bci AllocationCreateInfo
aci

  Bool -> io () -> io ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0) (io () -> io ()) -> (IO () -> io ()) -> IO () -> io ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> io ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> io ()) -> IO () -> io ()
forall a b. (a -> b) -> a -> b
$
    Allocator
-> BufferCreateInfo '[]
-> AllocationCreateInfo
-> (IO (Buffer, Allocation, AllocationInfo)
    -> ((Buffer, Allocation, AllocationInfo) -> IO ())
    -> ((Buffer, Allocation, AllocationInfo) -> IO ())
    -> IO ())
-> ((Buffer, Allocation, AllocationInfo) -> IO ())
-> IO ()
forall (a :: [*]) (io :: * -> *) r.
(Extendss BufferCreateInfo a, PokeChain a, MonadIO io) =>
Allocator
-> BufferCreateInfo a
-> AllocationCreateInfo
-> (io (Buffer, Allocation, AllocationInfo)
    -> ((Buffer, Allocation, AllocationInfo) -> io ()) -> r)
-> r
VMA.withBuffer Allocator
vma BufferCreateInfo '[]
stageCI AllocationCreateInfo
stageAI IO (Buffer, Allocation, AllocationInfo)
-> ((Buffer, Allocation, AllocationInfo) -> IO ())
-> ((Buffer, Allocation, AllocationInfo) -> IO ())
-> IO ()
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket \(Buffer
staging, Allocation
_stage, AllocationInfo
stageInfo) ->
      if AllocationInfo -> Ptr ()
VMA.mappedData AllocationInfo
stageInfo Ptr () -> Ptr () -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr ()
forall a. Ptr a
Foreign.nullPtr then
        String -> IO ()
forall a. HasCallStack => String -> a
error String
"TODO: recover from unmapped data and flush manually"
      else do
        Vector a -> (Ptr a -> IO ()) -> IO ()
forall a b. Storable a => Vector a -> (Ptr a -> IO b) -> IO b
VectorS.unsafeWith Vector a
xs \Ptr a
src ->
          Ptr a -> Ptr a -> Int -> IO ()
forall a. Ptr a -> Ptr a -> Int -> IO ()
Foreign.copyBytes (Ptr () -> Ptr a
forall a b. Ptr a -> Ptr b
Foreign.castPtr (Ptr () -> Ptr a) -> Ptr () -> Ptr a
forall a b. (a -> b) -> a -> b
$ AllocationInfo -> Ptr ()
VMA.mappedData AllocationInfo
stageInfo) Ptr a
src Int
lenBytes
        context
-> Queues CommandPool -> Buffer -> Buffer -> DeviceSize -> IO ()
forall (io :: * -> *) context.
(MonadUnliftIO io, HasVulkan context) =>
context
-> Queues CommandPool -> Buffer -> Buffer -> DeviceSize -> io ()
copyBuffer_ context
context Queues CommandPool
commandQueues Buffer
aBuffer Buffer
staging (Int -> DeviceSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sizeBytes)

  pure Allocated :: forall (s :: Store) a.
Buffer
-> Allocation
-> AllocationInfo
-> Int
-> Word32
-> BufferUsageFlagBits
-> Allocated s a
Allocated
    { $sel:aCapacity:Allocated :: Int
aCapacity = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
initialSize Int
len
    , $sel:aUsed:Allocated :: Word32
aUsed     = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len
    , $sel:aUsage:Allocated :: BufferUsageFlagBits
aUsage    = BufferUsageFlagBits
usage
    , Buffer
Allocation
AllocationInfo
aAllocationInfo :: AllocationInfo
aAllocation :: Allocation
aBuffer :: Buffer
$sel:aAllocationInfo:Allocated :: AllocationInfo
$sel:aAllocation:Allocated :: Allocation
$sel:aBuffer:Allocated :: Buffer
..
    }
  where
    vma :: Allocator
vma = context -> Allocator
forall a. HasVulkan a => a -> Allocator
getAllocator context
context

    len :: Int
len = Vector a -> Int
forall a. Storable a => Vector a -> Int
VectorS.length Vector a
xs
    lenBytes :: Int
lenBytes = a -> Int
forall a. Storable a => a -> Int
Foreign.sizeOf (a
forall a. HasCallStack => a
undefined :: a) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
len

    sizeBytes :: Int
sizeBytes = a -> Int
forall a. Storable a => a -> Int
Foreign.sizeOf (a
forall a. HasCallStack => a
undefined :: a) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
initialSize Int
len

    bci :: BufferCreateInfo '[]
bci = BufferCreateInfo '[]
forall a. Zero a => a
zero
      { $sel:size:BufferCreateInfo :: DeviceSize
Vk.size        = Int -> DeviceSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sizeBytes
      , $sel:usage:BufferCreateInfo :: BufferUsageFlagBits
Vk.usage       = BufferUsageFlagBits
Vk.BUFFER_USAGE_TRANSFER_DST_BIT BufferUsageFlagBits -> BufferUsageFlagBits -> BufferUsageFlagBits
forall a. Bits a => a -> a -> a
.|. BufferUsageFlagBits
usage
      , $sel:sharingMode:BufferCreateInfo :: SharingMode
Vk.sharingMode = SharingMode
Vk.SHARING_MODE_EXCLUSIVE
      }

    aci :: AllocationCreateInfo
aci = AllocationCreateInfo
forall a. Zero a => a
zero
      { $sel:usage:AllocationCreateInfo :: MemoryUsage
VMA.usage         = MemoryUsage
VMA.MEMORY_USAGE_GPU_ONLY
      , $sel:requiredFlags:AllocationCreateInfo :: MemoryPropertyFlagBits
VMA.requiredFlags = MemoryPropertyFlagBits
Vk.MEMORY_PROPERTY_DEVICE_LOCAL_BIT
      }

    stageCI :: BufferCreateInfo '[]
stageCI = BufferCreateInfo '[]
forall a. Zero a => a
zero
      { $sel:size:BufferCreateInfo :: DeviceSize
Vk.size        = Int -> DeviceSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sizeBytes
      , $sel:usage:BufferCreateInfo :: BufferUsageFlagBits
Vk.usage       = BufferUsageFlagBits
Vk.BUFFER_USAGE_TRANSFER_SRC_BIT
      , $sel:sharingMode:BufferCreateInfo :: SharingMode
Vk.sharingMode = SharingMode
Vk.SHARING_MODE_EXCLUSIVE
      }

    stageAI :: AllocationCreateInfo
stageAI = AllocationCreateInfo
forall a. Zero a => a
zero
      { $sel:flags:AllocationCreateInfo :: AllocationCreateFlags
VMA.flags         = AllocationCreateFlags
VMA.ALLOCATION_CREATE_MAPPED_BIT
      , $sel:usage:AllocationCreateInfo :: MemoryUsage
VMA.usage         = MemoryUsage
VMA.MEMORY_USAGE_CPU_TO_GPU
      , $sel:requiredFlags:AllocationCreateInfo :: MemoryPropertyFlagBits
VMA.requiredFlags = MemoryPropertyFlagBits
Vk.MEMORY_PROPERTY_HOST_VISIBLE_BIT
      }

destroy
  :: (MonadUnliftIO io, HasVulkan context)
  => context
  -> Allocated s a
  -> io ()
destroy :: context -> Allocated s a -> io ()
destroy context
context Allocated s a
a =
  Allocator -> Buffer -> Allocation -> io ()
forall (io :: * -> *).
MonadIO io =>
Allocator -> Buffer -> Allocation -> io ()
VMA.destroyBuffer (context -> Allocator
forall a. HasVulkan a => a -> Allocator
getAllocator context
context) (Allocated s a -> Buffer
forall (s :: Store) a. Allocated s a -> Buffer
aBuffer Allocated s a
a) (Allocated s a -> Allocation
forall (s :: Store) a. Allocated s a -> Allocation
aAllocation Allocated s a
a)

destroyAll
  :: (MonadUnliftIO io, HasVulkan context, Foldable t)
  => context
  -> t (Allocated s a)
  -> io ()
destroyAll :: context -> t (Allocated s a) -> io ()
destroyAll context
context =
  (Allocated s a -> io ()) -> t (Allocated s a) -> io ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ \Allocated s a
a ->
    Allocator -> Buffer -> Allocation -> io ()
forall (io :: * -> *).
MonadIO io =>
Allocator -> Buffer -> Allocation -> io ()
VMA.destroyBuffer (context -> Allocator
forall a. HasVulkan a => a -> Allocator
getAllocator context
context) (Allocated s a -> Buffer
forall (s :: Store) a. Allocated s a -> Buffer
aBuffer Allocated s a
a) (Allocated s a -> Allocation
forall (s :: Store) a. Allocated s a -> Allocation
aAllocation Allocated s a
a)

peekCoherent :: (MonadIO m, Storable a) => Word32 -> Allocated 'Coherent a -> m (Maybe a)
peekCoherent :: Word32 -> Allocated 'Coherent a -> m (Maybe a)
peekCoherent Word32
ix Allocated{Int
Word32
BufferUsageFlagBits
Buffer
Allocation
AllocationInfo
aUsage :: BufferUsageFlagBits
aUsed :: Word32
aCapacity :: Int
aAllocationInfo :: AllocationInfo
aAllocation :: Allocation
aBuffer :: Buffer
$sel:aUsage:Allocated :: forall (s :: Store) a. Allocated s a -> BufferUsageFlagBits
$sel:aUsed:Allocated :: forall (s :: Store) a. Allocated s a -> Word32
$sel:aCapacity:Allocated :: forall (s :: Store) a. Allocated s a -> Int
$sel:aAllocationInfo:Allocated :: forall (s :: Store) a. Allocated s a -> AllocationInfo
$sel:aAllocation:Allocated :: forall (s :: Store) a. Allocated s a -> Allocation
$sel:aBuffer:Allocated :: forall (s :: Store) a. Allocated s a -> Buffer
..} =
  case AllocationInfo -> Ptr ()
VMA.mappedData AllocationInfo
aAllocationInfo of
    Ptr ()
_ | Word32
ix Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
1 Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
> Word32
aUsed ->
      Maybe a -> m (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
    Ptr ()
ptr | Ptr ()
ptr Ptr () -> Ptr () -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr ()
forall a. Ptr a
Foreign.nullPtr ->
      Maybe a -> m (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
    Ptr ()
ptr ->
      IO (Maybe a) -> m (Maybe a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe a) -> m (Maybe a))
-> (IO a -> IO (Maybe a)) -> IO a -> m (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Maybe a) -> IO a -> IO (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe a
forall a. a -> Maybe a
Just (IO a -> m (Maybe a)) -> IO a -> m (Maybe a)
forall a b. (a -> b) -> a -> b
$
        Ptr a -> Int -> IO a
forall a. Storable a => Ptr a -> Int -> IO a
Foreign.peekElemOff (Ptr () -> Ptr a
forall a b. Ptr a -> Ptr b
Foreign.castPtr Ptr ()
ptr) (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
ix)

updateCoherent
  :: (Foreign.Storable a, MonadUnliftIO io)
  => VectorS.Vector a
  -> Allocated 'Coherent a
  -> io (Allocated 'Coherent a)
updateCoherent :: Vector a -> Allocated 'Coherent a -> io (Allocated 'Coherent a)
updateCoherent Vector a
xs Allocated 'Coherent a
old = do
  IO () -> io ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> io ()) -> IO () -> io ()
forall a b. (a -> b) -> a -> b
$ Vector a -> (Ptr a -> IO ()) -> IO ()
forall a b. Storable a => Vector a -> (Ptr a -> IO b) -> IO b
VectorS.unsafeWith Vector a
xs \Ptr a
src ->
    Ptr a -> Ptr a -> Int -> IO ()
forall a. Ptr a -> Ptr a -> Int -> IO ()
Foreign.copyBytes Ptr a
dst Ptr a
src Int
lenBytes
  pure Allocated 'Coherent a
old
    { $sel:aUsed:Allocated :: Word32
aUsed = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len
    }
  where
    dst :: Ptr a
dst = Ptr () -> Ptr a
forall a b. Ptr a -> Ptr b
Foreign.castPtr (Ptr () -> Ptr a) -> Ptr () -> Ptr a
forall a b. (a -> b) -> a -> b
$ AllocationInfo -> Ptr ()
VMA.mappedData (Allocated 'Coherent a -> AllocationInfo
forall (s :: Store) a. Allocated s a -> AllocationInfo
aAllocationInfo Allocated 'Coherent a
old)
    len :: Int
len = Vector a -> Int
forall a. Storable a => Vector a -> Int
VectorS.length Vector a
xs
    lenBytes :: Int
lenBytes = Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
* a -> Int
forall a. Storable a => a -> Int
Foreign.sizeOf (Vector a -> a
forall a. Storable a => Vector a -> a
VectorS.head Vector a
xs)

updateCoherentResize_
  :: (Storable a, HasVulkan context, MonadUnliftIO io)
  => context
  -> Allocated 'Coherent a
  -> VectorS.Vector a
  -> io (Allocated 'Coherent a)
updateCoherentResize_ :: context
-> Allocated 'Coherent a -> Vector a -> io (Allocated 'Coherent a)
updateCoherentResize_ context
ctx Allocated 'Coherent a
old Vector a
xs =
  if Int
newSize Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
oldSize then
    Vector a -> Allocated 'Coherent a -> io (Allocated 'Coherent a)
forall a (io :: * -> *).
(Storable a, MonadUnliftIO io) =>
Vector a -> Allocated 'Coherent a -> io (Allocated 'Coherent a)
updateCoherent Vector a
xs Allocated 'Coherent a
old
  else do
    context -> [Allocated 'Coherent a] -> io ()
forall (io :: * -> *) context (t :: * -> *) (s :: Store) a.
(MonadUnliftIO io, HasVulkan context, Foldable t) =>
context -> t (Allocated s a) -> io ()
destroyAll context
ctx [Allocated 'Coherent a
old]
    context
-> BufferUsageFlagBits
-> Int
-> Vector a
-> io (Allocated 'Coherent a)
forall a context (io :: * -> *).
(Storable a, HasVulkan context, MonadUnliftIO io) =>
context
-> BufferUsageFlagBits
-> Int
-> Vector a
-> io (Allocated 'Coherent a)
createCoherent context
ctx (Allocated 'Coherent a -> BufferUsageFlagBits
forall (s :: Store) a. Allocated s a -> BufferUsageFlagBits
aUsage Allocated 'Coherent a
old) Int
newSize Vector a
xs
  where
    oldSize :: Int
oldSize = Allocated 'Coherent a -> Int
forall (s :: Store) a. Allocated s a -> Int
aCapacity Allocated 'Coherent a
old
    newSize :: Int
newSize = Vector a -> Int
forall a. Storable a => Vector a -> Int
VectorS.length Vector a
xs

-- TODO: add a staged buffer to check out the transfer queue
copyBuffer_
  :: (MonadUnliftIO io, HasVulkan context)
  => context
  -> Queues Vk.CommandPool
  -> ("dstBuffer" ::: Vk.Buffer)
  -> ("srcBuffer" ::: Vk.Buffer)
  -> Vk.DeviceSize
  -> io ()
copyBuffer_ :: context
-> Queues CommandPool -> Buffer -> Buffer -> DeviceSize -> io ()
copyBuffer_ context
context Queues CommandPool
commandQueues Buffer
dst Buffer
src DeviceSize
sizeBytes =
  context
-> Queues CommandPool
-> (forall a. Queues a -> a)
-> (CommandBuffer -> io ())
-> io ()
forall context (m :: * -> *).
(HasVulkan context, MonadUnliftIO m) =>
context
-> Queues CommandPool
-> (forall a. Queues a -> a)
-> (CommandBuffer -> m ())
-> m ()
oneshot_ context
context Queues CommandPool
commandQueues forall a. Queues a -> a
qTransfer \CommandBuffer
cmd ->
    CommandBuffer
-> Buffer -> Buffer -> ("regions" ::: Vector BufferCopy) -> io ()
forall (io :: * -> *).
MonadIO io =>
CommandBuffer
-> Buffer -> Buffer -> ("regions" ::: Vector BufferCopy) -> io ()
Vk.cmdCopyBuffer CommandBuffer
cmd Buffer
src Buffer
dst
      (BufferCopy -> "regions" ::: Vector BufferCopy
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BufferCopy -> "regions" ::: Vector BufferCopy)
-> BufferCopy -> "regions" ::: Vector BufferCopy
forall a b. (a -> b) -> a -> b
$ DeviceSize -> DeviceSize -> DeviceSize -> BufferCopy
Vk.BufferCopy DeviceSize
0 DeviceSize
0 DeviceSize
sizeBytes)