{-- 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 a TePolygonTerraLib class In TerraLib, a 2D polygon consists of an outer ring and a list of inner rings More information - -} module TerraHS.TerraLib.TePolygon ( -- * The @TePolygon@ type TePolygon (..), -- * The @TePolygonPtr@ type TePolygonPtr, -- * The @TePolygonSet@ type TePolygonSet (..), -- * The @TePolygonSetPtr@ type TePolygonSetPtr, polbox ) where import Foreign (Int32, unsafePerformIO) import Foreign.C.String import qualified Foreign.Ptr (Ptr) import TerraHS.TerraLib.TePoint import TerraHS.TerraLib.TeLine2D import TerraHS.TerraLib.TeBox import TerraHS.Algebras.Base.Object import TerraHS.Misc.GenericFunctions import TerraHS.Algebras.Spatial.Polygons -- | The type @TePolygon@ represents a 2D polygon . -- In TerraLib, a 2D polygon consists of an outer ring and a list of inner ring -- In Haskell, a 2D polygon consists of a list TeLinearRing data TePolygon = TePolygon [TeLinearRing] deriving (Eq, Show) -- | The type @TePolygonPtr@ is a pointer to @TePolygon@ type TePolygonPtr = Foreign.Ptr.Ptr TePolygon -- | The type @TePolygonSet@ represents a set of 2D polygon . data TePolygonSet = TePolygonSet [TePolygon] deriving (Eq, Show) -- | The type @TePolygonSetPtr@ is a pointer to @TePolygonSet@ type TePolygonSetPtr = Foreign.Ptr.Ptr TePolygonSet polygonId :: TePolygonPtr -> String -> IO () polygonId ptr str = newCString str >>= (tepolygon_setobid ptr) >>= return instance Pointer TePolygon where new (TePolygon ls) = tepolygon_new >>= \pol -> doall (map ( (addLine pol) ) ( ls )) >> return pol where addLine pol l = new l >>= \l -> (tepolygon_addteline pol l) >> delete l delete ptr = tepolygon_destroy ptr fromPointer ptr = tepolygon_size ptr >>= \s -> polygon2lines ptr 0 s >>= \ps -> return (TePolygon ps) where polygon2lines p i s = do if i >= s then return [] else tepolygon_getteline2d p i >>= fromPointer >>= \x -> polygon2lines p (i+1) s >>= \xs -> return (x : xs) instance Pointer TePolygonSet where new (TePolygonSet []) = tepolygonset_new new (TePolygonSet xs) = do ptr <- new (TePolygonSet []) addPolygons ptr xs 0 return ptr where addPolygons ptr [] _ = error "erro" addPolygons ptr [x] i= new x >>= \p -> polygonId p (show i) >> (tepolygonset_addtepolygon ptr p) addPolygons ptr (x:xs) i= new x >>= \p -> polygonId p (show i) >> (tepolygonset_addtepolygon ptr p) >> (addPolygons ptr xs (i+1)) delete ptr = tepolygonset_destroy ptr instance Element TePolygonSet TePolygon where getElement ptr i = tepolygonset_gettepolygon ptr i >>= fromPointer >>= return instance Size TePolygonSet where size ptr = (tepolygonset_size ptr) instance Polygons TePolygon TeLine2D Double where createPolygon ls = (TePolygon ls) getLines (TePolygon ls) = ls polbox pol = unsafePerformIO ( (new pol ) >>= \tpol -> (tepolygon_box tpol) >>= \b -> fromPointer b >>= \bh -> delete b >> delete tpol >> return bh ) --- TePolygon, TePolyonSet ----------------------------- foreign import ccall unsafe "c_tepolygon_new" tepolygon_new :: Prelude.IO TePolygonPtr foreign import ccall unsafe "c_tepolygon_size" tepolygon_size :: TePolygonPtr -> Prelude.IO Int32 foreign import ccall unsafe "c_tepolygon_getteline2d" tepolygon_getteline2d :: TePolygonPtr -> Int32 -> Prelude.IO TeLine2DPtr foreign import ccall unsafe "c_tepolygon_box" tepolygon_box :: TePolygonPtr -> Prelude.IO TeBoxPtr foreign import ccall unsafe "c_tepolygonset_new" tepolygonset_new :: Prelude.IO TePolygonSetPtr foreign import ccall unsafe "c_tepolygonset_size" tepolygonset_size :: TePolygonSetPtr -> Prelude.IO Int32 foreign import ccall unsafe "c_tepolygonset_gettepolygon" tepolygonset_gettepolygon :: TePolygonSetPtr-> Int32 -> Prelude.IO TePolygonPtr foreign import ccall unsafe "c_tepolygonset_addtepolygon" tepolygonset_addtepolygon :: TePolygonSetPtr-> TePolygonPtr -> Prelude.IO () foreign import ccall unsafe "c_tepolygon_addteline" tepolygon_addteline :: TePolygonPtr -> TeLine2DPtr -> Prelude.IO () foreign import ccall unsafe "c_tepolygonset_destroy" tepolygonset_destroy :: TePolygonSetPtr -> Prelude.IO () foreign import ccall unsafe "c_tepolygon_destroy" tepolygon_destroy :: TePolygonPtr -> Prelude.IO () foreign import ccall unsafe "c_tepolygon_setobid" tepolygon_setobid :: TePolygonPtr -> CString -> Prelude.IO ()