{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE Strict #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ViewPatterns #-}
module Apecs.Physics.Query where
import Apecs
import Control.Monad.IO.Class (liftIO, MonadIO)
import Foreign.C.Types
import Foreign.ForeignPtr (withForeignPtr)
import Foreign.Marshal.Alloc
import Foreign.Ptr
import Foreign.Storable
import qualified Language.C.Inline as C
import Linear.V2
import Apecs.Physics.Space ()
import Apecs.Physics.Types
C.context phycsCtx
C.include "<chipmunk.h>"
pointQuery :: (MonadIO m, Has w m Physics) => WVec -> Double -> CollisionFilter -> SystemT w m (Maybe PointQueryResult)
pointQuery :: forall (m :: * -> *) w.
(MonadIO m, Has w m Physics) =>
WVec
-> Double
-> CollisionFilter
-> SystemT w m (Maybe PointQueryResult)
pointQuery (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (Real a, Fractional b) => a -> b
realToFrac -> V2 CDouble
px CDouble
py) (forall a b. (Real a, Fractional b) => a -> b
realToFrac -> CDouble
maxDistance) (CollisionFilter CollisionGroup
gr (Bitmask CollisionGroup
cs) (Bitmask CollisionGroup
mk)) = do
Space IOMap BodyRecord
_ IOMap (Record Shape)
_ IOMap (Record Constraint)
_ IOMap (Record CollisionHandler)
_ SpacePtr
spcPtr :: Space Physics <- forall w (m :: * -> *) c. Has w m c => SystemT w m (Storage c)
getStore
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr PointQueryResult
pq -> do
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr SpacePtr
spcPtr forall a b. (a -> b) -> a -> b
$ \Ptr FrnSpace
space -> [C.block| void {
cpSpacePointQueryNearest
( $(cpSpace *space)
, cpv($(double px), $(double py))
, $(double maxDistance)
, cpShapeFilterNew($(unsigned int gr), $(unsigned int cs), $(unsigned int mk))
, $(cpPointQueryInfo *pq));
}|]
PointQueryResult
res <- forall a. Storable a => Ptr a -> IO a
peek Ptr PointQueryResult
pq
if Entity -> Int
unEntity (PointQueryResult -> Entity
pqShape PointQueryResult
res) forall a. Eq a => a -> a -> Bool
== -Int
1
then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
else forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just PointQueryResult
res)
instance Storable PointQueryResult where
sizeOf :: PointQueryResult -> Int
sizeOf ~PointQueryResult
_ = Int
48
alignment :: PointQueryResult -> Int
alignment ~PointQueryResult
_ = Int
8
peek :: Ptr PointQueryResult -> IO PointQueryResult
peek Ptr PointQueryResult
ptr = do
Ptr Shape
sPtr :: Ptr Shape <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr PointQueryResult
ptr Int
0
CIntPtr
s <- [C.block| intptr_t {
cpShape *shape = $(cpShape *sPtr);
if (shape==NULL) {
return -1;
} else {
return (intptr_t) cpShapeGetUserData(shape);
} }|]
V2 CDouble
p :: V2 CDouble <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr PointQueryResult
ptr Int
8
CDouble
d :: CDouble <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr PointQueryResult
ptr Int
24
V2 CDouble
g :: V2 CDouble <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr PointQueryResult
ptr Int
32
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Entity -> WVec -> Double -> WVec -> PointQueryResult
PointQueryResult (Int -> Entity
Entity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ CIntPtr
s) (forall a b. (Real a, Fractional b) => a -> b
realToFrac forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> V2 CDouble
p) (forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
d) (forall a b. (Real a, Fractional b) => a -> b
realToFrac forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> V2 CDouble
g)
poke :: Ptr PointQueryResult -> PointQueryResult -> IO ()
poke = forall a. HasCallStack => a
undefined