{-# LINE 1 "Physics/Hipmunk/Internal.hsc" #-}
-----------------------------------------------------------------------------
{-# LINE 2 "Physics/Hipmunk/Internal.hsc" #-}
-- |
-- Module      :  Physics/Hipmunk/Internal.hsc
-- Copyright   :  (c) Felipe A. Lessa 2008
-- License     :  MIT (see LICENSE)
--
-- Maintainer  :  felipe.lessa@gmail.com
-- Stability   :  provisional
-- Portability :  portable (needs FFI)
--
-----------------------------------------------------------------------------

module Physics.Hipmunk.Internal
    (VectorPtr,

     BodyPtr,
     Body(..),
     unB,

     ShapePtr,
     Shape(..),
     unS,

     JointPtr,
     Joint(..),
     unJ,

     SpacePtr,
     Space(..),
     unP,

     Contact(..),
     ContactPtr
    )
    where

import Data.IORef
import Data.Map (Map)
import Foreign

{-# LINE 41 "Physics/Hipmunk/Internal.hsc" #-}

import Physics.Hipmunk.Common


type VectorPtr = Ptr Vector



-- | A rigid body representing the physical properties of an object,
--   but without a shape. It may help to think as a particle that
--   is able to rotate.
newtype Body = B (ForeignPtr Body)
type BodyPtr = Ptr Body

unB :: Body -> ForeignPtr Body
unB (B b) = b

instance Eq Body where
    B b1 == B b2 = b1 == b2

instance Ord Body where
    B b1 `compare` B b2 = b1 `compare` b2



-- | A collision shape is attached to a @Body@ to define its
--   shape. Multiple shapes may be attached, including
--   overlapping ones (shapes of a body don't generate collisions
--   with each other).
--
--   Note that to have any effect, a 'Shape' must also be
--   added to a 'Space', even if the body was already added.
data Shape = S !(ForeignPtr Shape) !Body
type ShapePtr = Ptr Shape

-- Note also that we have to maintain a reference to the
-- 'Body' to avoid garbage collection in the case that
-- the user doesn't add the body to a space and don't keep
-- a reference (common when adding bodies with infinite mass).
--
-- However, the body doesn't need to keep references to
-- the attached shapes because cpBody do not reference them,
-- so it wouldn't notice at all if they disappeared =).
-- A space would notice, but then the space will keep its
-- own reference the the shape.

unS :: Shape -> ForeignPtr Shape
unS (S s _) = s

instance Eq Shape where
    S s1 _ == S s2 _ = s1 == s2

instance Ord Shape where
    S s1 _ `compare` S s2 _ = s1 `compare` s2



-- | A joint represents a constrain between two bodies. Don't
--   forget to add the bodies and the joint to the space.
data Joint = J !(ForeignPtr Joint) !Body !Body
type JointPtr = Ptr Joint

unJ :: Joint -> ForeignPtr Joint
unJ (J j _ _) = j

instance Eq Joint where
    J j1 _ _ == J j2 _ _ = j1 == j2

instance Ord Joint where
    J j1 _ _ `compare` J j2 _ _ = j1 `compare` j2



-- | A space is where the simulation really occurs. You add
--   bodies, shapes and joints to a space and then step it
--   to update it as whole.
data Space = P !(ForeignPtr Space)
               !(IORef Entities)   -- Active and static entities
               !(IORef Callbacks)  -- Added callbacks
type SpacePtr  = Ptr Space
type Entities  = Map (Ptr ()) (Either (ForeignPtr ()) Shape)
type Callbacks = (Maybe (FunPtr ()), -- Default
                  Map (Word32, Word32)
{-# LINE 124 "Physics/Hipmunk/Internal.hsc" #-}
                      (FunPtr ()))

unP :: Space -> ForeignPtr Space
unP (P sp _ _) = sp

instance Eq Space where
    P s1 _ _ == P s2 _ _ = s1 == s2

instance Ord Space where
    P s1 _ _ `compare` P s2 _ _ = s1 `compare` s2



-- 'Contact's are an exception to the pattern we've been following
-- as we're going to use StorableArray with them, so we need
-- them to be Storable (like Vector).

-- | A 'Contact' contains information about a collision.
--   It is passed to 'Physics.Hipmunk.Space.Full'.
--
--   The fields 'ctJnAcc' and 'ctJtAcc' do not have any meaningfull
--   value until 'Physics.Hipmunk.Space.step' has returned
--   (i.e. during a call to a callback this information
--   contains garbage), and by extension you can only know
--   the impulse sum after @step@ returns as well.
--
--   /IMPORTANT:/ You may maintain a reference to an array
--   of @Contact@s that was passed to a callback to do any other
--   processing later. However, /a new call to /@step@/ will
--   invalidate any of those arrays/! Be careful.
data Contact = Contact {
      ctPos    :: Position,
      -- ^ Position of the collision in world's coordinates.

      ctNormal :: Vector,
      -- ^ Normal of the collision.

      ctDist   :: CpFloat,
      -- ^ Penetration distance of the collision.

      ctJnAcc  :: CpFloat,
      -- ^ Normal component of final impulse applied.
      --   (Valid only after @step@ finishes.)

      ctJtAcc  :: CpFloat
      -- ^ Tangential component of final impulse applied.
      --   (Valid only after @step@ finishes.)
    }
               deriving (Eq, Ord, Show)

type ContactPtr = Ptr Contact

instance Storable Contact where
    sizeOf _    = (68)
{-# LINE 178 "Physics/Hipmunk/Internal.hsc" #-}
    alignment _ = alignment (undefined :: Vector)
    peek ptr    = do
      p     <- (\hsc_ptr -> peekByteOff hsc_ptr 0) ptr
{-# LINE 181 "Physics/Hipmunk/Internal.hsc" #-}
      n     <- (\hsc_ptr -> peekByteOff hsc_ptr 8) ptr
{-# LINE 182 "Physics/Hipmunk/Internal.hsc" #-}
      dist  <- (\hsc_ptr -> peekByteOff hsc_ptr 16) ptr
{-# LINE 183 "Physics/Hipmunk/Internal.hsc" #-}
      jnAcc <- (\hsc_ptr -> peekByteOff hsc_ptr 48) ptr
{-# LINE 184 "Physics/Hipmunk/Internal.hsc" #-}
      jtAcc <- (\hsc_ptr -> peekByteOff hsc_ptr 52) ptr
{-# LINE 185 "Physics/Hipmunk/Internal.hsc" #-}
      return $ Contact {ctPos    = p
                       ,ctNormal = n
                       ,ctDist   = dist
                       ,ctJnAcc  = jnAcc
                       ,ctJtAcc  = jtAcc}
    poke ptr c = do
      (\hsc_ptr -> pokeByteOff hsc_ptr 0) ptr (ctPos c)
{-# LINE 192 "Physics/Hipmunk/Internal.hsc" #-}
      (\hsc_ptr -> pokeByteOff hsc_ptr 8) ptr (ctNormal c)
{-# LINE 193 "Physics/Hipmunk/Internal.hsc" #-}
      (\hsc_ptr -> pokeByteOff hsc_ptr 16) ptr (ctDist c)
{-# LINE 194 "Physics/Hipmunk/Internal.hsc" #-}
      (\hsc_ptr -> pokeByteOff hsc_ptr 48) ptr (ctJnAcc c)
{-# LINE 195 "Physics/Hipmunk/Internal.hsc" #-}
      (\hsc_ptr -> pokeByteOff hsc_ptr 52) ptr (ctJtAcc c)
{-# LINE 196 "Physics/Hipmunk/Internal.hsc" #-}