{-- TerraHS - Interface between TerraLib and Haskell

    (c) Sergio Costa (INPE) - Setembro, 2005

	This program is free software; you can redistribute it 
    and/or modify it under the terms of the GNU General 
    Public License 2.1 as published by the Free Software Foundation
    (http://www.opensource.org/licenses/gpl-license.php)
--}

{- | A module for supporting the functions of TerraLib TeGeometryAlgorithms

More information - <http://www.terralib.org>
-}
module TerraHS.TerraLib.TeOverlay {--
	(
		Topology (..), Overlay (..), distance, linelength, area, Centroid (..), terelation, distance, Egenhofer9 (..)
	) --}
	 where


import Foreign
import Foreign.C.String
import qualified Foreign.Ptr (Ptr)

--locais
import TerraHS.Misc.Object
import TerraHS.TerraLib.TeGeometry
import TerraHS.TerraLib.TePoint
import TerraHS.TerraLib.TeLine2D
import TerraHS.TerraLib.TeCell
import TerraHS.TerraLib.TeBox
import TerraHS.TerraLib.TePolygon

-- | Returns the result of objects overlay
class Overlay a where
	teunion, teintersection, tedifference :: a -> a -> [TeGeometry]

instance Overlay TePolygonSet where
	teunion gs1 gs2 = unsafePerformIO (apply gs1 gs2 (\ptr1 ptr2 -> teoverlay ptr1 ptr2 2))
	tedifference gs1 gs2 = unsafePerformIO (apply gs1 gs2 (\ptr1 ptr2 -> teoverlay ptr1 ptr2 1))
	teintersection gs1 gs2 = unsafePerformIO (apply gs1 gs2 (\ptr1 ptr2 -> teoverlay ptr1 ptr2 4))


apply gs1 gs2 f = (TerraHS.Misc.Object.new gs1) >>= \ps1 -> (TerraHS.Misc.Object.new gs2) >>= \ps2 -> f ps1 ps2 >>= polset2geoset >>= return
	where
	polset2geoset gs = size gs >>= (polygonset2geometryset gs 0)		
	


foreign import stdcall unsafe "c_teoverlay" teoverlay :: TePolygonSetPtr -> TePolygonSetPtr ->  Int ->  Prelude.IO TePolygonSetPtr