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

-- Contour.chs

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

-- Copyright 2007, 2009 Marco Túlio Gontijo e Silva
-- Copyright 2007, 2009 Rafael Cunha de Almeida

-- See LICENSE



-- | Basic geometric types used by 'Algebra.Geometric.Polygon.Polygon' and
-- 'Algebra.Geometric.Strip.Strip'.
module Algebra.Geometric.Contour (
        -- * Contour
        Contour (ContourC, contourList),
        -- * Vertex
        Vertex (VertexC, vertexX, vertexY))
    where

import Data.List
import Control.Monad
import Foreign
import Foreign.C

import Algebra.Geometric.Area


{-# LINE 33 "./Algebra/Geometric/Contour.chs" #-}

-- | A list of 2D Points. A 'Contour' is the border of a
-- 'Algebra.Geometric.Polygon.Polygon' or the internal border of a hole in a
-- 'Algebra.Geometric.Polygon.Polygon'. In a 'Algebra.Geometric.Strip.Strip',
-- it is the border of each division of the 'Algebra.Geometric.Strip.Strip'.
newtype Contour = ContourC {contourList :: [Vertex]} deriving (Ord, Show)

type CVertex = Ptr (Vertex)
{-# LINE 41 "./Algebra/Geometric/Contour.chs" #-}

instance Storable Contour where
    sizeOf _ = 8
{-# LINE 44 "./Algebra/Geometric/Contour.chs" #-}

    alignment _ = alignment (undefined :: Int)

    peek cContour =
        ContourC `liftM`
        do
        numVertices <-
            fromIntegral `liftM` (\ptr -> do {peekByteOff ptr 0 ::IO CInt}) cContour

        contour <- (\ptr -> do {peekByteOff ptr 4 ::IO (CVertex)}) cContour
        peekArray numVertices contour

    poke cContour (ContourC contour) =
        do
        (\ptr val -> do {pokeByteOff ptr 0 (val::CInt)}) cContour $ fromIntegral $
            length contour

        vertex <- newArray contour
        (\ptr val -> do {pokeByteOff ptr 4 (val::(CVertex))}) cContour vertex

instance Eq Contour where
    (ContourC list1) == (ContourC list2) =
        list1 `elem` rotation list2 ++ rotation (reverse list2)

rotation :: Eq a => [a] -> [[a]]
rotation list = nub $ zipWith (++) (tails list) $ inits list

instance Area Contour where
    area (ContourC []) = 0
    area (ContourC [_]) = 0
    area (ContourC (vertex1 : rest)) =
        abs (addVertex (last rest) vertex1 + sumMulti rest) / 2

addVertex :: Vertex -> Vertex -> Double
addVertex (VertexC x1 y1) (VertexC x2 y2) = (x1 + x2) * (y2 - y1)

sumMulti :: [Vertex] -> Double
sumMulti [] = error "sumMulti []"
sumMulti [_] = 0
sumMulti (vertex1 : rest@(vertex2 : _)) =
    addVertex vertex1 vertex2 + sumMulti rest

-- | A 2D Point.
data Vertex =
    VertexC {
        vertexX :: Double,
        vertexY :: Double}
    deriving (Eq, Ord, Show)

instance Storable Vertex where
    sizeOf _ = 16
{-# LINE 95 "./Algebra/Geometric/Contour.chs" #-}

    alignment _ = alignment (undefined :: Int)

    peek cVertex =
        do
        x <- get (\ptr -> do {peekByteOff ptr 0 ::IO CDouble})
{-# LINE 101 "./Algebra/Geometric/Contour.chs" #-}
        y <- get (\ptr -> do {peekByteOff ptr 8 ::IO CDouble})
{-# LINE 102 "./Algebra/Geometric/Contour.chs" #-}
        return $ VertexC x y

        where get field = realToFrac `liftM` field cVertex

    poke cVertex (VertexC x y) =
        do
        (\ptr val -> do {pokeByteOff ptr 0 (val::CDouble)}) cVertex (realToFrac x)
        (\ptr val -> do {pokeByteOff ptr 8 (val::CDouble)}) cVertex (realToFrac y)