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
newtype Polygon = PolygonC {polygonSet :: Set (Bool, Contour)} deriving Show
type CContour = Ptr (Contour)
instance Storable Polygon where
sizeOf _ = 12
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