{-# LINE 1 "src/Chiphunk/Low/Types.chs" #-}
{-# LANGUAGE DeriveGeneric #-}
{-# 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.Hashable
import Data.StateVar
import Data.VectorSpace
import Foreign
import GHC.Generics (Generic)
data Vect = Vect
{ vX :: !Double, vY :: !Double
} deriving (Eq, Show, Ord, Generic)
instance Hashable Vect
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 59 "src/Chiphunk/Low/Types.chs" #-}
alignment _ = 8
{-# LINE 60 "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 68 "src/Chiphunk/Low/Types.chs" #-}
data BB = BB
{ bbL :: !Double, bbB :: !Double, bbR :: !Double, bbT :: !Double
} deriving (Show, Eq, Ord, Generic)
instance Hashable BB
instance Storable BB where
sizeOf _ = 32
{-# LINE 78 "src/Chiphunk/Low/Types.chs" #-}
alignment _ = 8
{-# LINE 79 "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 91 "src/Chiphunk/Low/Types.chs" #-}
type DataPtr = C2HSImp.Ptr (())
{-# LINE 94 "src/Chiphunk/Low/Types.chs" #-}
newtype Body = Body (C2HSImp.Ptr (Body))
{-# LINE 97 "src/Chiphunk/Low/Types.chs" #-}
deriving (Eq, Ord, Generic)
instance Hashable Body
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 140 "src/Chiphunk/Low/Types.chs" #-}
deriving instance Show BodyType
newtype Space = Space (C2HSImp.Ptr (Space))
{-# LINE 146 "src/Chiphunk/Low/Types.chs" #-}
deriving (Eq, Ord, Generic)
instance Hashable Space
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 169 "src/Chiphunk/Low/Types.chs" #-}
deriving (Eq, Ord, Generic)
instance Hashable Shape
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 183 "src/Chiphunk/Low/Types.chs" #-}
deriving (Eq, Ord, Generic)
instance Hashable Constraint
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 203 "src/Chiphunk/Low/Types.chs" #-}
deriving (Eq, Ord, Generic)
instance Hashable Arbiter
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, Eq)
instance Storable Transform where
sizeOf _ = 48
{-# LINE 220 "src/Chiphunk/Low/Types.chs" #-}
alignment _ = 8
{-# LINE 221 "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 237 "src/Chiphunk/Low/Types.chs" #-}
type CollisionType = WordPtr
type CPBool = (C2HSImp.CUChar)
{-# LINE 242 "src/Chiphunk/Low/Types.chs" #-}
mkStateVar :: (a -> IO b) -> (a -> b -> IO ()) -> a -> StateVar b
mkStateVar g s i = makeStateVar (g i) (s i)