{-| Marshalling helpers shared by the binding modules.

By-value calls involving float structs or defs go through the shim as
pointers (ids pass directly as words), so the same two idioms recur: read
a struct back from an out parameter, and decode a C boolean returned for
a marshalled argument.
-}
module Box2D.Internal
  ( allocaOut
  , withValid
  , copyVector
  , unsafeViewVector
  ) where

import Data.Vector.Storable qualified as VS
import Foreign
import Foreign.C.Types (CBool)

-- | Run a shim call that writes its result to an out parameter and read it.
{-# INLINE allocaOut #-}
allocaOut :: (Storable a) => (Ptr a -> IO ()) -> IO a
allocaOut :: forall a. Storable a => (Ptr a -> IO ()) -> IO a
allocaOut Ptr a -> IO ()
f = (Ptr a -> IO a) -> IO a
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr a -> IO a) -> IO a) -> (Ptr a -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Ptr a
p -> Ptr a -> IO ()
f Ptr a
p IO () -> IO a -> IO a
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr a -> IO a
forall a. Storable a => Ptr a -> IO a
peek Ptr a
p

-- | Marshal a value in and decode the returned C boolean.
{-# INLINE withValid #-}
withValid :: (Storable a) => (Ptr a -> IO CBool) -> a -> IO Bool
withValid :: forall a. Storable a => (Ptr a -> IO CBool) -> a -> IO Bool
withValid Ptr a -> IO CBool
f a
a = a -> (Ptr a -> IO Bool) -> IO Bool
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with a
a ((CBool -> Bool) -> IO CBool -> IO Bool
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (CBool -> CBool -> Bool
forall a. Eq a => a -> a -> Bool
/= CBool
0) (IO CBool -> IO Bool) -> (Ptr a -> IO CBool) -> Ptr a -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr a -> IO CBool
f)

-- | Copy a C-owned array into a Haskell-owned storable vector: one @memcpy@,
-- no per-element marshalling. Safe to keep after the source is invalidated.
{-# INLINE copyVector #-}
copyVector :: (Storable a) => Int -> Ptr a -> IO (VS.Vector a)
copyVector :: forall a. Storable a => Int -> Ptr a -> IO (Vector a)
copyVector Int
n Ptr a
src = do
  fp <- Int -> IO (ForeignPtr a)
forall a. Storable a => Int -> IO (ForeignPtr a)
mallocForeignPtrArray Int
n
  withForeignPtr fp $ \Ptr a
dst -> Ptr a -> Ptr a -> Int -> IO ()
forall a. Storable a => Ptr a -> Ptr a -> Int -> IO ()
copyArray Ptr a
dst Ptr a
src Int
n
  pure (VS.unsafeFromForeignPtr0 fp n)

-- | View a C-owned array as a storable vector without copying. The vector
-- aliases engine memory and carries no finalizer: it is only valid while the
-- source buffer is (for event buffers, until the next world step). Prefer
-- 'copyVector' unless the copy shows up in a profile.
{-# INLINE unsafeViewVector #-}
unsafeViewVector :: Int -> Ptr a -> IO (VS.Vector a)
unsafeViewVector :: forall a. Int -> Ptr a -> IO (Vector a)
unsafeViewVector Int
n Ptr a
p = do
  fp <- Ptr a -> IO (ForeignPtr a)
forall a. Ptr a -> IO (ForeignPtr a)
newForeignPtr_ Ptr a
p
  pure (VS.unsafeFromForeignPtr0 fp n)