module Physics.Bullet.Raw.Types(
    Transform(..),
    allocaVec3,
    withVec3,
    pokeVec3,
    peekVec3,
    allocaVec4,
    withVec4,
    pokeVec4,
    peekVec4,
    allocaUnitQuaternion,
    withUnitQuaternion,
    pokeUnitQuaternion,
    peekUnitQuaternion,
    allocaMat3,
    withMat3,
    pokeMat3,
    peekMat3,
    allocaTransform,
    withTransform,
    pokeTransform,
    peekTransform,
    module Data.Vect.Float,
    module Data.Vect.Float.Util.Quaternion
    ) where

import Foreign.Marshal.Alloc
import Foreign.Marshal.Array
import Foreign.ForeignPtr
import Foreign.Storable
import Foreign.Ptr

import Data.Vect.Float
import Data.Vect.Float.Instances
import Data.Vect.Float.Util.Quaternion

data Transform  = Transform !Mat3 !Vec3
    deriving (Int -> Transform -> ShowS
[Transform] -> ShowS
Transform -> String
(Int -> Transform -> ShowS)
-> (Transform -> String)
-> ([Transform] -> ShowS)
-> Show Transform
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Transform] -> ShowS
$cshowList :: [Transform] -> ShowS
show :: Transform -> String
$cshow :: Transform -> String
showsPrec :: Int -> Transform -> ShowS
$cshowsPrec :: Int -> Transform -> ShowS
Show,Transform -> Transform -> Bool
(Transform -> Transform -> Bool)
-> (Transform -> Transform -> Bool) -> Eq Transform
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Transform -> Transform -> Bool
$c/= :: Transform -> Transform -> Bool
== :: Transform -> Transform -> Bool
$c== :: Transform -> Transform -> Bool
Eq)

-- Vec3
allocaVec3 :: (Storable a) => (Ptr a -> IO b) -> IO b
allocaVec3 :: (Ptr a -> IO b) -> IO b
allocaVec3 = Int -> (Ptr a -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes 12

withVec3 :: Vec3 -> (Ptr a -> IO  b) -> IO  b
withVec3 :: Vec3 -> (Ptr a -> IO b) -> IO b
withVec3 v :: Vec3
v f :: Ptr a -> IO b
f = (Ptr Float -> IO b) -> IO b
forall a b. Storable a => (Ptr a -> IO b) -> IO b
allocaVec3 ((Ptr Float -> IO b) -> IO b) -> (Ptr Float -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr Float
p -> do
    Vec3 -> Ptr Float -> IO ()
pokeVec3 Vec3
v Ptr Float
p
    Ptr a -> IO b
f (Ptr a -> IO b) -> Ptr a -> IO b
forall a b. (a -> b) -> a -> b
$ Ptr Float -> Ptr a
forall a b. Ptr a -> Ptr b
castPtr Ptr Float
p

pokeVec3 :: Vec3 -> Ptr Float -> IO ()
pokeVec3 (Vec3 x :: Float
x y :: Float
y z :: Float
z) p :: Ptr Float
p = do
    Ptr Float -> Int -> Float -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Float
p 0 Float
x 
    Ptr Float -> Int -> Float -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Float
p 1 Float
y
    Ptr Float -> Int -> Float -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Float
p 2 Float
z

peekVec3 :: Ptr a -> IO Vec3
peekVec3 :: Ptr a -> IO Vec3
peekVec3 p' :: Ptr a
p' = do
    let p :: Ptr b
p = Ptr a -> Ptr b
forall a b. Ptr a -> Ptr b
castPtr Ptr a
p'
    Float
x <- Ptr Float -> Int -> IO Float
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Float
forall b. Ptr b
p 0
    Float
y <- Ptr Float -> Int -> IO Float
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Float
forall b. Ptr b
p 1
    Float
z <- Ptr Float -> Int -> IO Float
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Float
forall b. Ptr b
p 2
    Vec3 -> IO Vec3
forall (m :: * -> *) a. Monad m => a -> m a
return (Vec3 -> IO Vec3) -> Vec3 -> IO Vec3
forall a b. (a -> b) -> a -> b
$ Float -> Float -> Float -> Vec3
Vec3 Float
x Float
y Float
z

-- Vec4
allocaVec4 :: (Storable a) => (Ptr a -> IO b) -> IO b
allocaVec4 :: (Ptr a -> IO b) -> IO b
allocaVec4 = Int -> (Ptr a -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes 16

withVec4 :: Vec4 -> (Ptr a -> IO  b) -> IO  b
withVec4 :: Vec4 -> (Ptr a -> IO b) -> IO b
withVec4 v :: Vec4
v f :: Ptr a -> IO b
f = (Ptr Float -> IO b) -> IO b
forall a b. Storable a => (Ptr a -> IO b) -> IO b
allocaVec4 ((Ptr Float -> IO b) -> IO b) -> (Ptr Float -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr Float
p -> do
    Vec4 -> Ptr Float -> IO ()
pokeVec4 Vec4
v Ptr Float
p
    Ptr a -> IO b
f (Ptr a -> IO b) -> Ptr a -> IO b
forall a b. (a -> b) -> a -> b
$ Ptr Float -> Ptr a
forall a b. Ptr a -> Ptr b
castPtr Ptr Float
p

pokeVec4 :: Vec4 -> Ptr Float -> IO ()
pokeVec4 (Vec4 x :: Float
x y :: Float
y z :: Float
z w :: Float
w) p :: Ptr Float
p = do
    Ptr Float -> Int -> Float -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Float
p 0 Float
x 
    Ptr Float -> Int -> Float -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Float
p 1 Float
y
    Ptr Float -> Int -> Float -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Float
p 2 Float
z
    Ptr Float -> Int -> Float -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Float
p 3 Float
w

peekVec4 :: Ptr a -> IO Vec4
peekVec4 :: Ptr a -> IO Vec4
peekVec4 p' :: Ptr a
p' = do
    let p :: Ptr b
p = Ptr a -> Ptr b
forall a b. Ptr a -> Ptr b
castPtr Ptr a
p'
    Float
x <- Ptr Float -> Int -> IO Float
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Float
forall b. Ptr b
p 0
    Float
y <- Ptr Float -> Int -> IO Float
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Float
forall b. Ptr b
p 1
    Float
z <- Ptr Float -> Int -> IO Float
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Float
forall b. Ptr b
p 2
    Float
w <- Ptr Float -> Int -> IO Float
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Float
forall b. Ptr b
p 3
    Vec4 -> IO Vec4
forall (m :: * -> *) a. Monad m => a -> m a
return (Vec4 -> IO Vec4) -> Vec4 -> IO Vec4
forall a b. (a -> b) -> a -> b
$ Float -> Float -> Float -> Float -> Vec4
Vec4 Float
x Float
y Float
z Float
w

-- UnitQuaternion
allocaUnitQuaternion :: (Storable a) => (Ptr a -> IO b) -> IO b
allocaUnitQuaternion :: (Ptr a -> IO b) -> IO b
allocaUnitQuaternion = Int -> (Ptr a -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes 16

withUnitQuaternion :: UnitQuaternion -> (Ptr a -> IO  b) -> IO  b
withUnitQuaternion :: UnitQuaternion -> (Ptr a -> IO b) -> IO b
withUnitQuaternion v :: UnitQuaternion
v f :: Ptr a -> IO b
f = (Ptr Float -> IO b) -> IO b
forall a b. Storable a => (Ptr a -> IO b) -> IO b
allocaUnitQuaternion ((Ptr Float -> IO b) -> IO b) -> (Ptr Float -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr Float
p -> do
    UnitQuaternion -> Ptr Float -> IO ()
pokeUnitQuaternion UnitQuaternion
v Ptr Float
p
    Ptr a -> IO b
f (Ptr a -> IO b) -> Ptr a -> IO b
forall a b. (a -> b) -> a -> b
$ Ptr Float -> Ptr a
forall a b. Ptr a -> Ptr b
castPtr Ptr Float
p

pokeUnitQuaternion :: UnitQuaternion -> Ptr Float -> IO ()
pokeUnitQuaternion (U (Vec4 x :: Float
x y :: Float
y z :: Float
z w :: Float
w)) p :: Ptr Float
p = do
    Ptr Float -> Int -> Float -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Float
p 0 Float
x 
    Ptr Float -> Int -> Float -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Float
p 1 Float
y
    Ptr Float -> Int -> Float -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Float
p 2 Float
z
    Ptr Float -> Int -> Float -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Float
p 3 Float
w

peekUnitQuaternion :: Ptr a -> IO UnitQuaternion
peekUnitQuaternion :: Ptr a -> IO UnitQuaternion
peekUnitQuaternion p' :: Ptr a
p' = do
    let p :: Ptr b
p = Ptr a -> Ptr b
forall a b. Ptr a -> Ptr b
castPtr Ptr a
p'
    Float
x <- Ptr Float -> Int -> IO Float
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Float
forall b. Ptr b
p 0
    Float
y <- Ptr Float -> Int -> IO Float
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Float
forall b. Ptr b
p 1
    Float
z <- Ptr Float -> Int -> IO Float
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Float
forall b. Ptr b
p 2
    Float
w <- Ptr Float -> Int -> IO Float
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Float
forall b. Ptr b
p 3
    UnitQuaternion -> IO UnitQuaternion
forall (m :: * -> *) a. Monad m => a -> m a
return (UnitQuaternion -> IO UnitQuaternion)
-> UnitQuaternion -> IO UnitQuaternion
forall a b. (a -> b) -> a -> b
$ Vec4 -> UnitQuaternion
mkU (Vec4 -> UnitQuaternion) -> Vec4 -> UnitQuaternion
forall a b. (a -> b) -> a -> b
$ Float -> Float -> Float -> Float -> Vec4
Vec4 Float
x Float
y Float
z Float
w

-- Mat3
allocaMat3 :: (Storable a) => (Ptr a -> IO b) -> IO b
allocaMat3 :: (Ptr a -> IO b) -> IO b
allocaMat3 = Int -> (Ptr a -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes 36

withMat3 :: Mat3 -> (Ptr a -> IO  b) -> IO  b
withMat3 :: Mat3 -> (Ptr a -> IO b) -> IO b
withMat3 v :: Mat3
v f :: Ptr a -> IO b
f = (Ptr Float -> IO b) -> IO b
forall a b. Storable a => (Ptr a -> IO b) -> IO b
allocaMat3 ((Ptr Float -> IO b) -> IO b) -> (Ptr Float -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr Float
p -> do
    Mat3 -> Ptr Float -> IO ()
pokeMat3 Mat3
v Ptr Float
p
    Ptr a -> IO b
f (Ptr a -> IO b) -> Ptr a -> IO b
forall a b. (a -> b) -> a -> b
$ Ptr Float -> Ptr a
forall a b. Ptr a -> Ptr b
castPtr Ptr Float
p

pokeMat3 :: Mat3 -> Ptr Float -> IO ()
pokeMat3 (Mat3 a :: Vec3
a b :: Vec3
b c :: Vec3
c) p :: Ptr Float
p = do
    Vec3 -> Ptr Float -> IO ()
pokeVec3 Vec3
a Ptr Float
p
    Vec3 -> Ptr Float -> IO ()
pokeVec3 Vec3
b (Ptr Float -> IO ()) -> Ptr Float -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Float -> Int -> Ptr Float
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Float
p 12
    Vec3 -> Ptr Float -> IO ()
pokeVec3 Vec3
c (Ptr Float -> IO ()) -> Ptr Float -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Float -> Int -> Ptr Float
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Float
p 24

peekMat3 :: Ptr a -> IO Mat3
peekMat3 :: Ptr a -> IO Mat3
peekMat3 p :: Ptr a
p = do
    Vec3
a <- Ptr a -> IO Vec3
forall a. Ptr a -> IO Vec3
peekVec3 Ptr a
p
    Vec3
b <- Ptr Any -> IO Vec3
forall a. Ptr a -> IO Vec3
peekVec3 (Ptr Any -> IO Vec3) -> Ptr Any -> IO Vec3
forall a b. (a -> b) -> a -> b
$ Ptr a -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr a
p 12
    Vec3
c <- Ptr Any -> IO Vec3
forall a. Ptr a -> IO Vec3
peekVec3 (Ptr Any -> IO Vec3) -> Ptr Any -> IO Vec3
forall a b. (a -> b) -> a -> b
$ Ptr a -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr a
p 24
    Mat3 -> IO Mat3
forall (m :: * -> *) a. Monad m => a -> m a
return (Mat3 -> IO Mat3) -> Mat3 -> IO Mat3
forall a b. (a -> b) -> a -> b
$ Vec3 -> Vec3 -> Vec3 -> Mat3
Mat3 Vec3
a Vec3
b Vec3
c

-- Transform
allocaTransform :: (Storable a) => (Ptr a -> IO b) -> IO b
allocaTransform :: (Ptr a -> IO b) -> IO b
allocaTransform = Int -> (Ptr a -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes 48

withTransform :: Transform -> (Ptr a -> IO  b) -> IO  b
withTransform :: Transform -> (Ptr a -> IO b) -> IO b
withTransform v :: Transform
v f :: Ptr a -> IO b
f = (Ptr Float -> IO b) -> IO b
forall a b. Storable a => (Ptr a -> IO b) -> IO b
allocaTransform ((Ptr Float -> IO b) -> IO b) -> (Ptr Float -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr Float
p -> do
    Transform -> Ptr Float -> IO ()
pokeTransform Transform
v Ptr Float
p
    Ptr a -> IO b
f (Ptr a -> IO b) -> Ptr a -> IO b
forall a b. (a -> b) -> a -> b
$ Ptr Float -> Ptr a
forall a b. Ptr a -> Ptr b
castPtr Ptr Float
p

pokeTransform :: Transform -> Ptr Float -> IO ()
pokeTransform (Transform m :: Mat3
m v :: Vec3
v) p :: Ptr Float
p = do
    Mat3 -> Ptr Float -> IO ()
pokeMat3 Mat3
m Ptr Float
p
    Vec3 -> Ptr Float -> IO ()
pokeVec3 Vec3
v (Ptr Float -> IO ()) -> Ptr Float -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Float -> Int -> Ptr Float
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Float
p 36

peekTransform :: Ptr a -> IO Transform
peekTransform :: Ptr a -> IO Transform
peekTransform p :: Ptr a
p = do
    Mat3
m <- Ptr a -> IO Mat3
forall a. Ptr a -> IO Mat3
peekMat3 Ptr a
p
    Vec3
v <- Ptr Any -> IO Vec3
forall a. Ptr a -> IO Vec3
peekVec3 (Ptr Any -> IO Vec3) -> Ptr Any -> IO Vec3
forall a b. (a -> b) -> a -> b
$ Ptr a -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr a
p 36
    Transform -> IO Transform
forall (m :: * -> *) a. Monad m => a -> m a
return (Transform -> IO Transform) -> Transform -> IO Transform
forall a b. (a -> b) -> a -> b
$ Mat3 -> Vec3 -> Transform
Transform Mat3
m Vec3
v