module SFML.Graphics.Rect
(
FloatRect(..)
, IntRect(..)
, Rect(..)
, floatRectContains
, intRectContains
)
where
import Control.Applicative ((<$>), (<*>))
import Foreign.C.Types
import Foreign.Marshal.Alloc (alloca)
import Foreign.Marshal.Utils (with)
import Foreign.Ptr (Ptr)
import Foreign.Storable
import System.IO.Unsafe
sizeInt = (4)
sizeFloat = (4)
data FloatRect = FloatRect
{ fleft :: Float
, ftop :: Float
, fwidth :: Float
, fheight :: Float
}
instance Storable FloatRect where
sizeOf _ = 4 * sizeFloat
alignment _ = alignment (undefined :: CFloat)
peek ptr = FloatRect
<$> fmap realToFrac ((\hsc_ptr -> peekByteOff hsc_ptr 0) ptr :: IO CFloat)
<*> fmap realToFrac ((\hsc_ptr -> peekByteOff hsc_ptr 4) ptr :: IO CFloat)
<*> fmap realToFrac ((\hsc_ptr -> peekByteOff hsc_ptr 8) ptr :: IO CFloat)
<*> fmap realToFrac ((\hsc_ptr -> peekByteOff hsc_ptr 12) ptr :: IO CFloat)
poke ptr (FloatRect l t w h) = do
(\hsc_ptr -> pokeByteOff hsc_ptr 0) ptr (realToFrac l :: CFloat)
(\hsc_ptr -> pokeByteOff hsc_ptr 4) ptr (realToFrac t :: CFloat)
(\hsc_ptr -> pokeByteOff hsc_ptr 8) ptr (realToFrac w :: CFloat)
(\hsc_ptr -> pokeByteOff hsc_ptr 12) ptr (realToFrac h :: CFloat)
data IntRect = IntRect
{ ileft :: Int
, itop :: Int
, iwidth :: Int
, iheight :: Int
}
instance Storable IntRect where
sizeOf _ = 4 * sizeInt
alignment _ = alignment (undefined :: CInt)
peek ptr = IntRect
<$> fmap fromIntegral ((\hsc_ptr -> peekByteOff hsc_ptr 0) ptr :: IO CInt)
<*> fmap fromIntegral ((\hsc_ptr -> peekByteOff hsc_ptr 4) ptr :: IO CInt)
<*> fmap fromIntegral ((\hsc_ptr -> peekByteOff hsc_ptr 8) ptr :: IO CInt)
<*> fmap fromIntegral ((\hsc_ptr -> peekByteOff hsc_ptr 12) ptr :: IO CInt)
poke ptr (IntRect l t w h) = do
(\hsc_ptr -> pokeByteOff hsc_ptr 0) ptr (fromIntegral l :: CInt)
(\hsc_ptr -> pokeByteOff hsc_ptr 4) ptr (fromIntegral t :: CInt)
(\hsc_ptr -> pokeByteOff hsc_ptr 8) ptr (fromIntegral w :: CInt)
(\hsc_ptr -> pokeByteOff hsc_ptr 12) ptr (fromIntegral h :: CInt)
floatRectContains
:: Float
-> Float
-> FloatRect
-> Bool
floatRectContains x y r = unsafeDupablePerformIO $ fmap (/=0) . with r $ \ptr -> sfFloatRect_contains ptr x y
foreign import ccall unsafe "sfFloatRect_contains"
sfFloatRect_contains :: Ptr FloatRect -> Float -> Float -> IO CInt
intRectContains
:: Int
-> Int
-> IntRect
-> Bool
intRectContains x y r = unsafeDupablePerformIO $ fmap (/=0) . with r $
\ptr -> sfIntRect_contains ptr (fromIntegral x) (fromIntegral y)
foreign import ccall unsafe "sfIntRect_contains"
sfIntRect_contains :: Ptr IntRect -> CInt -> CInt -> IO CInt
class Rect a where
intersectRect
:: a
-> a
-> Maybe a
instance Rect FloatRect where
intersectRect r1 r2 = unsafeDupablePerformIO $
alloca $ \ptr1 ->
alloca $ \ptr2 ->
alloca $ \ptrOut -> do
poke ptr1 r1
poke ptr2 r2
result <- sfFloatRect_intersects ptr1 ptr2 ptrOut
case result of
0 -> return Nothing
_ -> peek ptrOut >>= return . Just
foreign import ccall unsafe "sfFloatRect_intersects"
sfFloatRect_intersects :: Ptr FloatRect -> Ptr FloatRect -> Ptr FloatRect -> IO CInt
instance Rect IntRect where
intersectRect r1 r2 = unsafeDupablePerformIO $
alloca $ \ptr1 ->
alloca $ \ptr2 ->
alloca $ \ptrOut -> do
poke ptr1 r1
poke ptr2 r2
result <- sfIntRect_intersects ptr1 ptr2 ptrOut
case result of
0 -> return Nothing
_ -> peek ptrOut >>= return . Just
foreign import ccall unsafe "sfIntRect_intersects"
sfIntRect_intersects :: Ptr IntRect -> Ptr IntRect -> Ptr IntRect -> IO CInt