{-# LINE 1 "Physics/Hipmunk/Common.hsc" #-}
{-# CFILES
{-# LINE 2 "Physics/Hipmunk/Common.hsc" #-}
      chipmunk-r402/src/chipmunk.c,
      chipmunk-r402/src/constraints/cpConstraint.c,
      chipmunk-r402/src/constraints/cpDampedRotarySpring.c,
      chipmunk-r402/src/constraints/cpDampedSpring.c,
      chipmunk-r402/src/constraints/cpGearJoint.c,
      chipmunk-r402/src/constraints/cpGrooveJoint.c,
      chipmunk-r402/src/constraints/cpPinJoint.c,
      chipmunk-r402/src/constraints/cpPivotJoint.c,
      chipmunk-r402/src/constraints/cpRatchetJoint.c,
      chipmunk-r402/src/constraints/cpRotaryLimitJoint.c,
      chipmunk-r402/src/constraints/cpSimpleMotor.c,
      chipmunk-r402/src/constraints/cpSlideJoint.c,
      chipmunk-r402/src/cpArbiter.c,
      chipmunk-r402/src/cpArray.c,
      chipmunk-r402/src/cpBB.c,
      chipmunk-r402/src/cpBody.c,
      chipmunk-r402/src/cpCollision.c,
      chipmunk-r402/src/cpHashSet.c,
      chipmunk-r402/src/cpPolyShape.c,
      chipmunk-r402/src/cpShape.c,
      chipmunk-r402/src/cpSpace.c,
      chipmunk-r402/src/cpSpaceHash.c,
      chipmunk-r402/src/cpVect.c,
      Physics/Hipmunk/wrapper.c #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Physics/Hipmunk/Common.hsc
-- Copyright   :  (c) 2008-2010 Felipe A. Lessa
-- License     :  MIT (see LICENSE)
--
-- Maintainer  :  felipe.lessa@gmail.com
-- Stability   :  provisional
-- Portability :  portable (needs FFI)
--
-- Functionality used by various modules and routines for
-- initialization and change of global variables.
--
-----------------------------------------------------------------------------

module Physics.Hipmunk.Common
    (-- * Initialization
     initChipmunk,

     -- * Basic data types
     CpFloat,
     infinity,
     Time,
     Angle,
     Distance,
     Damping,

     -- * Global variables
     -- $global_vars

     -- ** Shape counter
     -- $shape_counter
     resetShapeCounter,

     -- ** Contact persistence
     -- $contact_persistence
     getContactPersistence,
     setContactPersistence,

     -- ** Collision slop
     -- $collision_slop
     getCollisionSlop,
     setCollisionSlop,

     -- ** Bias coefficient
     -- $bias_coef
     BiasCoef,
     getBiasCoef,
     setBiasCoef,

     -- ** Constraint bias coefficient
     -- $constraint_bias_coef
     getConstraintBiasCoef,
     setConstraintBiasCoef,

     -- * Vectors
     Vector(..),
     Position,
     fromAngle,
     len,
     normalize,
     scale,
     toAngle,
     dot,
     cross,
     perp,
     project,
     rotate,
     unrotate
    )
    where

import Foreign hiding (rotate)
import Foreign.C.Types (CInt)

{-# LINE 102 "Physics/Hipmunk/Common.hsc" #-}

error' :: String -> a
error' = error . ("Physics.Hipmunk.Common: " ++)

-- | Initilizes the Chipmunk library. This should be called
--   once before using any functions of this library.
initChipmunk :: IO ()
initChipmunk = cpInitChipmunk

foreign import ccall unsafe "wrapper.h"
    cpInitChipmunk :: IO ()


-- | The floating point type used internally in Chipmunk.
type CpFloat = Double
{-# LINE 117 "Physics/Hipmunk/Common.hsc" #-}

-- | @infinity@ may be used to create bodies with
--   an infinite mass.
infinity :: CpFloat
infinity = 1e1000

-- | Type synonym used to hint that the argument or result
--   represents time.
type Time = CpFloat

-- | Type synonym used to hint that the argument or result
--   represents an angle in radians.
type Angle = CpFloat

-- | Type synonym used to hint that the argument or result
--   represents a distance.
type Distance = CpFloat

-- | Type synonym used to hint that the argument or result
--   represents a damping constant.
type Damping = CpFloat


-- $global_vars
--   Chipmunk tries to maintain a very few number of global
--   variables to allow multiple @Space@s to be used
--   simultaneously, however there are some.

-- $shape_counter
--   The shape counter is a global counter used for creating
--   unique hash identifiers to the shapes.

-- | @resetShapeCounter@ reset the shape counter to its default
--   value.  This is used to add determinism to a simulation.  As
--   the ids created with this counter may affect the order in
--   which the collisions happen, there may be very slight
--   differences in different simulations.  It may be very useful
--   to call @resetShapeCounter@ everytime you start a new
--   simulation.
--
--   However, be careful as you should not use shapes created
--   before a call to @resetCounter@ with shapes created after it
--   as they may have the same id.  This means that you can't add
--   shapes created after the call to a space created before it.
resetShapeCounter :: IO ()
resetShapeCounter = cpResetShapeIdCounter

foreign import ccall unsafe "wrapper.h"
    cpResetShapeIdCounter :: IO ()


-- $contact_persistence
--   This variable determines how long contacts should persist.
--   It should be small as the cached contacts will only be
--   close for a short time. (default is 3)

getContactPersistence :: IO CInt
getContactPersistence = peek cp_contact_persistence

setContactPersistence :: CInt -> IO ()
setContactPersistence = poke cp_contact_persistence

foreign import ccall unsafe "wrapper.h &cp_contact_persistence"
    cp_contact_persistence :: Ptr CInt


-- $collision_slop
--   The collision slop is the amount that shapes are allowed to
--   penetrate. Setting this to zero will work just fine, but using a
--   small positive amount will help prevent oscillating
--   contacts. (default is 0.1)

getCollisionSlop :: IO CpFloat
getCollisionSlop = peek cp_collision_slop

setCollisionSlop :: CpFloat -> IO ()
setCollisionSlop = poke cp_collision_slop

foreign import ccall unsafe "wrapper.h &cp_collision_slop"
    cp_collision_slop :: Ptr CpFloat


-- $bias_coef
--   The amount of penetration to reduce in each step. Values should
--   range from 0 to 1. Using large values will eliminate penetration in
--   fewer steps, but can cause vibration. (default is 0.1)
type BiasCoef = CpFloat

getBiasCoef :: IO BiasCoef
getBiasCoef = peek cp_bias_coef

setBiasCoef :: BiasCoef -> IO ()
setBiasCoef = poke cp_bias_coef

foreign import ccall unsafe "wrapper.h &cp_bias_coef"
    cp_bias_coef :: Ptr CpFloat


-- $constraint_bias_coef
--   Similar to the bias coefficient, but sets the default bias
--   for all constraints. (default is 0.1)

getConstraintBiasCoef :: IO BiasCoef
getConstraintBiasCoef = peek cp_constraint_bias_coef

setConstraintBiasCoef :: BiasCoef -> IO ()
setConstraintBiasCoef = poke cp_constraint_bias_coef

foreign import ccall unsafe "wrapper.h &cp_constraint_bias_coef"
    cp_constraint_bias_coef :: Ptr CpFloat



-- | A two-dimensional vector. It is an instance of 'Num'
--   however the operations 'signum' and @(*)@ are not
--   supported.
data Vector = Vector !CpFloat !CpFloat
              deriving (Eq, Show, Ord)

-- | Type synonym used to hint that the argument or result
--   represents a position.
type Position = Vector


instance Num Vector where
    (Vector x1 y1) + (Vector x2 y2) = Vector (x1+x2) (y1+y2)
    (Vector x1 y1) - (Vector x2 y2) = Vector (x1-x2) (y1-y2)
    negate (Vector x1 y1)           = Vector (-x1) (-y1)
    abs v                           = Vector (len v) 0
    fromInteger n                   = Vector (fromInteger n) 0
    signum _ = error' "signum not supported"
    _ * _    = error' "(*) not supported"

instance Storable Vector where
    sizeOf _    = (16)
{-# LINE 252 "Physics/Hipmunk/Common.hsc" #-}
    alignment _ = alignment (undefined :: CpFloat)
    peek ptr = do
      x <- (\hsc_ptr -> peekByteOff hsc_ptr 0) ptr
{-# LINE 255 "Physics/Hipmunk/Common.hsc" #-}
      y <- (\hsc_ptr -> peekByteOff hsc_ptr 8) ptr
{-# LINE 256 "Physics/Hipmunk/Common.hsc" #-}
      return (Vector x y)
    poke ptr (Vector x y) = do
      (\hsc_ptr -> pokeByteOff hsc_ptr 0) ptr x
{-# LINE 259 "Physics/Hipmunk/Common.hsc" #-}
      (\hsc_ptr -> pokeByteOff hsc_ptr 8) ptr y
{-# LINE 260 "Physics/Hipmunk/Common.hsc" #-}


-- | Constructs an unitary vector pointing to the given
--   angle (in radians).
fromAngle :: Angle -> Vector
fromAngle theta = Vector (cos theta) (sin theta)
{-# INLINE fromAngle #-}

-- | The length of a vector.
len :: Vector -> CpFloat
len (Vector x y) = sqrt $ x*x + y*y
{-# INLINE len #-}

-- | Normalizes the vector (i.e. divides it by its length).
normalize :: Vector -> Vector
normalize v = v `scale` (recip $ len v)
{-# INLINE normalize #-}

-- | Scales the components of a vector by the same amount.
scale :: Vector -> CpFloat -> Vector
scale (Vector x y) s = Vector (x*s) (y*s)
{-# INLINE scale #-}

-- | @toAngle v@ is the angle that @v@ has
--   with the vector @Vector 1 0@ (modulo @2*pi@).
toAngle :: Vector -> Angle
toAngle (Vector x y) = atan2 y x
{-# INLINE toAngle #-}

-- | @v1 \`dot\` v2@ computes the familiar dot operation.
dot :: Vector -> Vector -> CpFloat
dot (Vector x1 y1) (Vector x2 y2) = x1*x2 + y1*y2
{-# INLINE dot #-}

-- | @v1 \`cross\` v2@ computes the familiar cross operation.
cross :: Vector -> Vector -> CpFloat
cross (Vector x1 y1) (Vector x2 y2) = x1*y2 - y1*x2
{-# INLINE cross #-}

-- | @perp v@ is a vector of same length as @v@ but perpendicular
--   to @v@ (i.e. @toAngle (perp v) - toAngle v@ equals @pi\/2@
--   modulo @2*pi@).
perp :: Vector -> Vector
perp (Vector x y) = Vector (-y) x
{-# INLINE perp #-}

-- | @v1 \`project\` v2@ is the vector projection of @v1@ onto @v2@.
project :: Vector -> Vector -> Vector
project v1 v2 = v2 `scale` s
    where s = (v1 `dot` v2) / (v2 `dot` v2)
{-# INLINE project #-}

-- | @v1 \`rotate\` v2@ uses complex multiplication
--   to rotate (and scale) @v1@ by @v2@.
rotate :: Vector -> Vector -> Vector
rotate (Vector x1 y1) (Vector x2 y2) = Vector x3 y3
    where x3 = x1*x2 - y1*y2
          y3 = x1*y2 + y1*x2
{-# INLINE rotate #-}

-- | The inverse operation of @rotate@, such that
--   @unrotate (rotate v1 v2) v2@ equals @v1@.
unrotate :: Vector -> Vector -> Vector
unrotate (Vector x1 y1) (Vector x2 y2) = Vector x3 y3
    where x3 = x1*x2 + y1*y2
          y3 = y1*x2 - x1*y2
{-# INLINE unrotate #-}