{-# 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
, Polyline(..)
, PolylinePtr
, PolylineSet(..)
, PolylineSetPtr
, withPolylinePtr
, peekPolylineSet
) 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 65 "src/Chiphunk/Low/Types.chs" #-}
alignment _ = 8
{-# LINE 66 "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 74 "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 84 "src/Chiphunk/Low/Types.chs" #-}
alignment _ = 8
{-# LINE 85 "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 97 "src/Chiphunk/Low/Types.chs" #-}
type DataPtr = C2HSImp.Ptr (())
{-# LINE 100 "src/Chiphunk/Low/Types.chs" #-}
newtype Body = Body (C2HSImp.Ptr (Body))
{-# LINE 103 "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 146 "src/Chiphunk/Low/Types.chs" #-}
deriving instance Show BodyType
newtype Space = Space (C2HSImp.Ptr (Space))
{-# LINE 152 "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 175 "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 189 "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 209 "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 226 "src/Chiphunk/Low/Types.chs" #-}
alignment _ = 8
{-# LINE 227 "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 243 "src/Chiphunk/Low/Types.chs" #-}
type CollisionType = WordPtr
type CPBool = (C2HSImp.CUChar)
{-# LINE 248 "src/Chiphunk/Low/Types.chs" #-}
mkStateVar :: (a -> IO b) -> (a -> b -> IO ()) -> a -> StateVar b
mkStateVar g s i = makeStateVar (g i) (s i)
type PolylinePtr = C2HSImp.Ptr (Polyline)
{-# LINE 254 "src/Chiphunk/Low/Types.chs" #-}
newtype Polyline = Polyline { unPolyline :: [Vect] }
foreign import ccall w_cpPolylineVerts :: Ptr Polyline -> Ptr Vect
withPolylinePtr :: Polyline -> (Ptr Polyline -> IO a) -> IO a
withPolylinePtr (Polyline verts) fn = do
allocaBytes (sizeOf (undefined :: Vect) * (count+10)) $ \p -> do
(\ptr val -> do {C2HSImp.pokeByteOff ptr 0 (val :: C2HSImp.CInt)}) p $ fromIntegral count
(\ptr val -> do {C2HSImp.pokeByteOff ptr 4 (val :: C2HSImp.CInt)}) p $ fromIntegral count
let vp = plusPtr p (8)
{-# LINE 265 "src/Chiphunk/Low/Types.chs" #-}
pokeArray vp verts
fn p
where
count = length verts
peekPolyline :: Ptr Polyline -> IO Polyline
peekPolyline p = do
count <- fromIntegral <$> (\ptr -> do {C2HSImp.peekByteOff ptr 0 :: IO C2HSImp.CInt}) p
let vp = w_cpPolylineVerts p
Polyline <$> peekArray count vp
type PolylineSetPtr = C2HSImp.Ptr (PolylineSet)
{-# LINE 277 "src/Chiphunk/Low/Types.chs" #-}
data PolylineSet = PolylineSet { unPolylineSet :: [Polyline] }
peekPolylineSet :: Ptr PolylineSet -> IO PolylineSet
peekPolylineSet p = do
count <- fromIntegral <$> (\ptr -> do {C2HSImp.peekByteOff ptr 0 :: IO C2HSImp.CInt}) p
lp <- (\ptr -> do {C2HSImp.peekByteOff ptr 8 :: IO (C2HSImp.Ptr (PolylinePtr))}) p
PolylineSet <$> (mapM peekPolyline =<< peekArray count lp)