-- 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/Polygon.chs" #-}{-# LANGUAGE ForeignFunctionInterface #-}

-- Polygon.chs

-- hgeometric: A geometric library with bindings to GPC.
-- Polygon.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

-- | 'Polygon' data type.
module Algebra.Geometric.Polygon (Polygon (PolygonC, polygonSet)) where


import Data.Set hiding (map)
import Control.Monad
import Foreign
import Foreign.C

import Algebra.Geometric.Area
import Algebra.Geometric.Contour


{-# LINE 38 "./Algebra/Geometric/Polygon.chs" #-}

-- | A 'Polygon', which support holes and disjoint areas. Each 'Bool' in the
-- tuple tells if the 'Contour' is the border of a hole ('True') or of a
-- 'Polygon' ('False').
newtype Polygon = PolygonC {polygonSet :: Set (Bool, Contour)} deriving Show

type CContour = Ptr (Contour)
{-# LINE 45 "./Algebra/Geometric/Polygon.chs" #-}

instance Storable Polygon where
    sizeOf _ = 12
{-# LINE 48 "./Algebra/Geometric/Polygon.chs" #-}

    alignment _ = alignment (undefined :: Int)

    peek cPolygon =
        (PolygonC . fromList) `liftM`
        do
        numContours <-
            fromIntegral `liftM` (\ptr -> do {peekByteOff ptr 0 ::IO CInt}) cPolygon

        cHoles <- (\ptr -> do {peekByteOff ptr 4 ::IO (Ptr CInt)}) cPolygon
        holes <- peekArray numContours cHoles

        cContours <- (\ptr -> do {peekByteOff ptr 8 ::IO (CContour)}) cPolygon
        contours <- peekArray numContours cContours

        return $ zip (map toBool holes) contours

    poke cPolygon (PolygonC polygon) =
        do
        (\ptr val -> do {pokeByteOff ptr 0 (val::CInt)}) cPolygon $ fromIntegral $ size polygon

        cHoles <- newArray $ map fromBool holes
        (\ptr val -> do {pokeByteOff ptr 4 (val::(Ptr CInt))}) cPolygon cHoles

        cContours <- newArray contours
        (\ptr val -> do {pokeByteOff ptr 8 (val::(CContour))}) cPolygon cContours

        where (holes, contours) = unzip $ toList polygon

instance Area Polygon where
    area (PolygonC polygon) =
        sum $ map signal $ toList polygon
        where
        signal (False, contour) = area contour
        signal (True, contour) = negate $ area contour