-- | Integer-friendly user data: stash an entity\/index id in the engine's
-- @void* userData@ slots without manual pointer casts. The id travels as the
-- pointer's bit pattern (it is never dereferenced), so any 'Int' that fits a
-- word round-trips — which makes contact events and queries resolvable back
-- to your entities.
module Box2D.UserData
  ( HasUserData (..)
  , setUserIndex
  , getUserIndex
  , userIndexToPtr
  , ptrToUserIndex
  ) where

import Foreign.Ptr (IntPtr (..), Ptr, intPtrToPtr, ptrToIntPtr)

import Box2D.Body qualified as Body
import Box2D.Id (BodyId, JointId, ShapeId)
import Box2D.Joint qualified as Joint
import Box2D.Shape qualified as Shape

-- | Handles carrying a @userData@ pointer slot.
class HasUserData id where
  setUserData :: id -> Ptr () -> IO ()
  getUserData :: id -> IO (Ptr ())

instance HasUserData BodyId where
  setUserData :: BodyId -> Ptr () -> IO ()
setUserData = BodyId -> Ptr () -> IO ()
Body.setUserData
  getUserData :: BodyId -> IO (Ptr ())
getUserData = BodyId -> IO (Ptr ())
Body.getUserData

instance HasUserData ShapeId where
  setUserData :: ShapeId -> Ptr () -> IO ()
setUserData = ShapeId -> Ptr () -> IO ()
Shape.setUserData
  getUserData :: ShapeId -> IO (Ptr ())
getUserData = ShapeId -> IO (Ptr ())
Shape.getUserData

instance HasUserData JointId where
  setUserData :: JointId -> Ptr () -> IO ()
setUserData = JointId -> Ptr () -> IO ()
Joint.setUserData
  getUserData :: JointId -> IO (Ptr ())
getUserData = JointId -> IO (Ptr ())
Joint.getUserData

-- | Encode an id as a user-data pointer (also for the @*Def@ records'
-- @userData@ fields).
userIndexToPtr :: Int -> Ptr ()
userIndexToPtr :: Int -> Ptr ()
userIndexToPtr = IntPtr -> Ptr ()
forall a. IntPtr -> Ptr a
intPtrToPtr (IntPtr -> Ptr ()) -> (Int -> IntPtr) -> Int -> Ptr ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> IntPtr
IntPtr

-- | Decode a user-data pointer written by 'userIndexToPtr'.
ptrToUserIndex :: Ptr () -> Int
ptrToUserIndex :: Ptr () -> Int
ptrToUserIndex Ptr ()
p = case Ptr () -> IntPtr
forall a. Ptr a -> IntPtr
ptrToIntPtr Ptr ()
p of IntPtr Int
i -> Int
i

-- | Stash an entity\/index id on a body, shape or joint.
setUserIndex :: (HasUserData id) => id -> Int -> IO ()
setUserIndex :: forall id. HasUserData id => id -> Int -> IO ()
setUserIndex id
x = id -> Ptr () -> IO ()
forall id. HasUserData id => id -> Ptr () -> IO ()
setUserData id
x (Ptr () -> IO ()) -> (Int -> Ptr ()) -> Int -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Ptr ()
userIndexToPtr

-- | Read back an id stored with 'setUserIndex'.
getUserIndex :: (HasUserData id) => id -> IO Int
getUserIndex :: forall id. HasUserData id => id -> IO Int
getUserIndex id
x = Ptr () -> Int
ptrToUserIndex (Ptr () -> Int) -> IO (Ptr ()) -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> id -> IO (Ptr ())
forall id. HasUserData id => id -> IO (Ptr ())
getUserData id
x