-- GENERATED by C->Haskell Compiler, version 0.16.0 Crystal Seed, 24 Jan 2009 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "./Algebra/Geometric/Clip.chs" #-}{-# LANGUAGE ForeignFunctionInterface #-}

-- Clip.chs

-- hgeometric: A geometric library with bindings to GPC.
-- Clip.chs is part of hgeometric.

-- Copyright (C) 2007 Marco Túlio Gontijo e Silva
-- Copyright (C) 2007 Rafael Cunha de Almeida

-- hgeometric is free software; you can redistribute it and/or modify
-- it under the terms of the GNU General Public License as published by
-- the Free Software Foundation; either version 2 of the License, or
-- (at your option) any later version.

-- hgeometric is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-- GNU General Public License for more details.

-- You should have received a copy of the GNU General Public License
-- along with hgeometric; if not, write to the Free Software
-- Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA

-- | 'Clip' operations to 'Polygon's and 'Strip's.
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


{-# LINE 40 "./Algebra/Geometric/Clip.chs" #-}

type CPolygon = Ptr (Polygon)
{-# LINE 42 "./Algebra/Geometric/Clip.chs" #-}
type CStrip = Ptr (Strip)
{-# LINE 43 "./Algebra/Geometric/Clip.chs" #-}

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

    -- | An 'IO' version of '\\', which does not use 'unsafePerformIO'.
    difference :: Polygon -> Polygon -> IO geometry
    difference = clip 0

    -- | An 'IO' version of '/\', which does not use 'unsafePerformIO'.
    intersection :: Polygon -> Polygon -> IO geometry
    intersection = clip 1

    -- | An 'IO' version of '<+>', which does not use 'unsafePerformIO'.
    xor :: Polygon -> Polygon -> IO geometry
    xor = clip 2

    -- | An 'IO' version of '\/', which does not use 'unsafePerformIO'.
    union :: Polygon -> Polygon -> IO geometry
    union = clip 3

    -- | 'difference': Returns a 'Polygon' with the area in the first 'Polygon'
    -- and not in the second.
    (\\) :: Polygon -> Polygon -> geometry
    subject \\ clip_ = unsafePerformIO $ subject `difference` clip_

    -- | 'intersection': a 'Polygon' with the area in both the first and the
    -- second 'Polygon'.
    (/\) :: Polygon -> Polygon -> geometry
    subject /\ clip_ = unsafePerformIO $ subject `intersection` clip_

    -- | 'xor': Returns a 'Polygon' with the area in the first or the second
    -- 'Polygon', but not in both.
    (<+>) :: Polygon -> Polygon -> geometry
    subject <+> clip_ = unsafePerformIO $ subject `xor` clip_

    -- | 'union': Returns a 'Polygon' with the area in the first or the second
    -- 'Polygon'.
    (\/) :: Polygon -> Polygon -> geometry
    subject \/ clip_ = unsafePerformIO $ subject `union` clip_

instance Clip Polygon where
    cClip = gpc_polygon_clip
{-# LINE 108 "./Algebra/Geometric/Clip.chs" #-}
    clipFree = gpc_free_polygon
{-# LINE 109 "./Algebra/Geometric/Clip.chs" #-}

instance Clip Strip where
    cClip = gpc_tristrip_clip
{-# LINE 112 "./Algebra/Geometric/Clip.chs" #-}
    clipFree = gpc_free_tristrip
{-# LINE 113 "./Algebra/Geometric/Clip.chs" #-}

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 ()))