module Algebra.Geometric.Clip (
Clip (
difference, intersection, xor, union,
(\\), (/\), (<+>), (\/)))
where
import Foreign hiding (xor)
import Foreign.C
import Algebra.Geometric.Polygon
import Algebra.Geometric.Strip
type CPolygon = Ptr (Polygon)
type CStrip = Ptr (Strip)
infixl 7 \\, /\, <+>, \/
class Storable geometry => Clip geometry where
cClip :: CInt -> Ptr Polygon -> Ptr Polygon -> Ptr geometry -> IO ()
clipFree :: Ptr geometry -> IO ()
clip :: CInt -> Polygon -> Polygon -> IO geometry
clip op subject clip_ =
alloca $
\cSubject -> alloca $
\cClip_ -> alloca $
\cResult ->
do
poke cSubject subject
poke cClip_ clip_
cClip op cSubject cClip_ cResult
result <- peek cResult
gpc_free_polygon cSubject
gpc_free_polygon cClip_
clipFree cResult
return result
difference :: Polygon -> Polygon -> IO geometry
difference = clip 0
intersection :: Polygon -> Polygon -> IO geometry
intersection = clip 1
xor :: Polygon -> Polygon -> IO geometry
xor = clip 2
union :: Polygon -> Polygon -> IO geometry
union = clip 3
(\\) :: Polygon -> Polygon -> geometry
subject \\ clip_ = unsafePerformIO $ subject `difference` clip_
(/\) :: Polygon -> Polygon -> geometry
subject /\ clip_ = unsafePerformIO $ subject `intersection` clip_
(<+>) :: Polygon -> Polygon -> geometry
subject <+> clip_ = unsafePerformIO $ subject `xor` clip_
(\/) :: Polygon -> Polygon -> geometry
subject \/ clip_ = unsafePerformIO $ subject `union` clip_
instance Clip Polygon where
cClip = gpc_polygon_clip
clipFree = gpc_free_polygon
instance Clip Strip where
cClip = gpc_tristrip_clip
clipFree = gpc_free_tristrip
foreign import ccall unsafe "Algebra/Geometric/Clip.chs.h gpc_free_polygon"
gpc_free_polygon :: ((CPolygon) -> (IO ()))
foreign import ccall unsafe "Algebra/Geometric/Clip.chs.h gpc_polygon_clip"
gpc_polygon_clip :: (CInt -> ((CPolygon) -> ((CPolygon) -> ((CPolygon) -> (IO ())))))
foreign import ccall unsafe "Algebra/Geometric/Clip.chs.h gpc_tristrip_clip"
gpc_tristrip_clip :: (CInt -> ((CPolygon) -> ((CPolygon) -> ((CStrip) -> (IO ())))))
foreign import ccall unsafe "Algebra/Geometric/Clip.chs.h gpc_free_tristrip"
gpc_free_tristrip :: ((CStrip) -> (IO ()))