{-# LINE 1 "src/Chiphunk/Low/Types.chs" #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
module Chiphunk.Low.Types
( Vect (..)
, VectPtr
, BB (..)
, BBPtr
, DataPtr
, Body (..)
, BodyType (..)
, Space (..)
, Shape (..)
, Constraint (..)
, Arbiter (..)
, Transform (..)
, TransformPtr
, CollisionType
, CPBool
, mkStateVar
) where
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Ptr as C2HSImp
import qualified Foreign.Storable as C2HSImp
import Data.Cross
import Data.StateVar
import Data.VectorSpace
import Foreign
data Vect = Vect
{ vX :: !Double, vY :: !Double
} deriving (Eq, Show)
instance AdditiveGroup Vect where
zeroV = Vect 0 0
negateV (Vect x y) = Vect (-x) (-y)
Vect x1 y1 ^+^ Vect x2 y2 = Vect (x1 + x2) (y1 + y2)
Vect x1 y1 ^-^ Vect x2 y2 = Vect (x1 - x2) (y1 - y2)
instance VectorSpace Vect where
type Scalar Vect = Double
f *^ Vect x y = Vect (f * x) (f * y)
instance InnerSpace Vect where
Vect x1 y1 <.> Vect x2 y2 = x1 * x2 + y1 * y2
instance HasCross2 Vect where
cross2 (Vect x y) = Vect (-y) x
instance Storable Vect where
sizeOf _ = 16
{-# LINE 54 "src/Chiphunk/Low/Types.chs" #-}
alignment _ = 8
{-# LINE 55 "src/Chiphunk/Low/Types.chs" #-}
poke p (Vect x y) = do
(\ptr val -> do {C2HSImp.pokeByteOff ptr 0 (val :: C2HSImp.CDouble)}) p $ realToFrac x
(\ptr val -> do {C2HSImp.pokeByteOff ptr 8 (val :: C2HSImp.CDouble)}) p $ realToFrac y
peek p = Vect <$> (realToFrac <$> (\ptr -> do {C2HSImp.peekByteOff ptr 0 :: IO C2HSImp.CDouble}) p)
<*> (realToFrac <$> (\ptr -> do {C2HSImp.peekByteOff ptr 8 :: IO C2HSImp.CDouble}) p)
type VectPtr = C2HSImp.Ptr (Vect)
{-# LINE 63 "src/Chiphunk/Low/Types.chs" #-}
data BB = BB
{ bbL :: !Double, bbB :: !Double, bbR :: !Double, bbT :: !Double
} deriving (Show)
instance Storable BB where
sizeOf _ = 32
{-# LINE 71 "src/Chiphunk/Low/Types.chs" #-}
alignment _ = 8
{-# LINE 72 "src/Chiphunk/Low/Types.chs" #-}
poke p (BB l b r t) = do
(\ptr val -> do {C2HSImp.pokeByteOff ptr 0 (val :: C2HSImp.CDouble)}) p $ realToFrac l
(\ptr val -> do {C2HSImp.pokeByteOff ptr 8 (val :: C2HSImp.CDouble)}) p $ realToFrac b
(\ptr val -> do {C2HSImp.pokeByteOff ptr 16 (val :: C2HSImp.CDouble)}) p $ realToFrac r
(\ptr val -> do {C2HSImp.pokeByteOff ptr 24 (val :: C2HSImp.CDouble)}) p $ realToFrac t
peek p = BB <$> (realToFrac <$> (\ptr -> do {C2HSImp.peekByteOff ptr 0 :: IO C2HSImp.CDouble}) p)
<*> (realToFrac <$> (\ptr -> do {C2HSImp.peekByteOff ptr 8 :: IO C2HSImp.CDouble}) p)
<*> (realToFrac <$> (\ptr -> do {C2HSImp.peekByteOff ptr 16 :: IO C2HSImp.CDouble}) p)
<*> (realToFrac <$> (\ptr -> do {C2HSImp.peekByteOff ptr 24 :: IO C2HSImp.CDouble}) p)
type BBPtr = C2HSImp.Ptr (BB)
{-# LINE 84 "src/Chiphunk/Low/Types.chs" #-}
type DataPtr = C2HSImp.Ptr (())
{-# LINE 87 "src/Chiphunk/Low/Types.chs" #-}
newtype Body = Body (C2HSImp.Ptr (Body))
{-# LINE 90 "src/Chiphunk/Low/Types.chs" #-}
instance Storable Body where
sizeOf (Body p) = sizeOf p
alignment (Body p) = alignment p
poke p (Body b) = poke (castPtr p) b
peek p = Body <$> peek (castPtr p)
data BodyType =
BodyTypeDynamic
| BodyTypeKimenatic
| BodyTypeStatic
deriving (Enum)
{-# LINE 130 "src/Chiphunk/Low/Types.chs" #-}
deriving instance Show BodyType
newtype Space = Space (C2HSImp.Ptr (Space))
{-# LINE 136 "src/Chiphunk/Low/Types.chs" #-}
instance Storable Space where
sizeOf (Space p) = sizeOf p
alignment (Space p) = alignment p
poke p (Space b) = poke (castPtr p) b
peek p = Space <$> peek (castPtr p)
newtype Shape = Shape (C2HSImp.Ptr (Shape))
{-# LINE 156 "src/Chiphunk/Low/Types.chs" #-}
instance Storable Shape where
sizeOf (Shape p) = sizeOf p
alignment (Shape p) = alignment p
poke p (Shape b) = poke (castPtr p) b
peek p = Shape <$> peek (castPtr p)
newtype Constraint = Constraint (C2HSImp.Ptr (Constraint))
{-# LINE 167 "src/Chiphunk/Low/Types.chs" #-}
instance Storable Constraint where
sizeOf (Constraint p) = sizeOf p
alignment (Constraint p) = alignment p
poke p (Constraint b) = poke (castPtr p) b
peek p = Constraint <$> peek (castPtr p)
newtype Arbiter = Arbiter (C2HSImp.Ptr (Arbiter))
{-# LINE 184 "src/Chiphunk/Low/Types.chs" #-}
instance Storable Arbiter where
sizeOf (Arbiter p) = sizeOf p
alignment (Arbiter p) = alignment p
poke p (Arbiter b) = poke (castPtr p) b
peek p = Arbiter <$> peek (castPtr p)
data Transform = Transform
{ tA :: !Double, tB :: !Double, tC :: !Double, tD :: !Double, tTx :: !Double, tTy :: !Double
} deriving Show
instance Storable Transform where
sizeOf _ = 48
{-# LINE 198 "src/Chiphunk/Low/Types.chs" #-}
alignment _ = 8
{-# LINE 199 "src/Chiphunk/Low/Types.chs" #-}
poke p (Transform a b c d tx ty) = do
(\ptr val -> do {C2HSImp.pokeByteOff ptr 0 (val :: C2HSImp.CDouble)}) p $ realToFrac a
(\ptr val -> do {C2HSImp.pokeByteOff ptr 8 (val :: C2HSImp.CDouble)}) p $ realToFrac b
(\ptr val -> do {C2HSImp.pokeByteOff ptr 16 (val :: C2HSImp.CDouble)}) p $ realToFrac c
(\ptr val -> do {C2HSImp.pokeByteOff ptr 24 (val :: C2HSImp.CDouble)}) p $ realToFrac d
(\ptr val -> do {C2HSImp.pokeByteOff ptr 32 (val :: C2HSImp.CDouble)}) p $ realToFrac tx
(\ptr val -> do {C2HSImp.pokeByteOff ptr 40 (val :: C2HSImp.CDouble)}) p $ realToFrac ty
peek p = Transform <$> (realToFrac <$> (\ptr -> do {C2HSImp.peekByteOff ptr 0 :: IO C2HSImp.CDouble}) p)
<*> (realToFrac <$> (\ptr -> do {C2HSImp.peekByteOff ptr 8 :: IO C2HSImp.CDouble}) p)
<*> (realToFrac <$> (\ptr -> do {C2HSImp.peekByteOff ptr 16 :: IO C2HSImp.CDouble}) p)
<*> (realToFrac <$> (\ptr -> do {C2HSImp.peekByteOff ptr 24 :: IO C2HSImp.CDouble}) p)
<*> (realToFrac <$> (\ptr -> do {C2HSImp.peekByteOff ptr 32 :: IO C2HSImp.CDouble}) p)
<*> (realToFrac <$> (\ptr -> do {C2HSImp.peekByteOff ptr 40 :: IO C2HSImp.CDouble}) p)
type TransformPtr = C2HSImp.Ptr (Transform)
{-# LINE 215 "src/Chiphunk/Low/Types.chs" #-}
type CollisionType = WordPtr
type CPBool = (C2HSImp.CUChar)
{-# LINE 220 "src/Chiphunk/Low/Types.chs" #-}
mkStateVar :: (a -> IO b) -> (a -> b -> IO ()) -> a -> StateVar b
mkStateVar g s i = makeStateVar (g i) (s i)