module TerraHS.TerraLib.TePolygon
(
TePolygon (..),
TePolygonPtr,
TePolygonSet (..),
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
data TePolygon = TePolygon [TeLinearRing] deriving (Eq, Show)
type TePolygonPtr = Foreign.Ptr.Ptr TePolygon
data TePolygonSet = TePolygonSet [TePolygon] deriving (Eq, Show)
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)
polbox pol = unsafePerformIO ( (new pol ) >>= \tpol -> (tepolygon_box tpol) >>= \b -> fromPointer b >>= \bh -> delete b >> delete tpol >> return bh )
foreign import stdcall unsafe "c_tepolygon_new" tepolygon_new :: Prelude.IO TePolygonPtr
foreign import stdcall unsafe "c_tepolygon_size" tepolygon_size :: TePolygonPtr -> Prelude.IO Int32
foreign import stdcall unsafe "c_tepolygon_getteline2d" tepolygon_getteline2d :: TePolygonPtr -> Int32 -> Prelude.IO TeLine2DPtr
foreign import stdcall unsafe "c_tepolygon_box" tepolygon_box :: TePolygonPtr -> Prelude.IO TeBoxPtr
foreign import stdcall unsafe "c_tepolygonset_new" tepolygonset_new :: Prelude.IO TePolygonSetPtr
foreign import stdcall unsafe "c_tepolygonset_size" tepolygonset_size :: TePolygonSetPtr -> Prelude.IO Int32
foreign import stdcall unsafe "c_tepolygonset_gettepolygon" tepolygonset_gettepolygon :: TePolygonSetPtr-> Int32 -> Prelude.IO TePolygonPtr
foreign import stdcall unsafe "c_tepolygonset_addtepolygon" tepolygonset_addtepolygon :: TePolygonSetPtr-> TePolygonPtr -> Prelude.IO ()
foreign import stdcall unsafe "c_tepolygon_addteline" tepolygon_addteline :: TePolygonPtr -> TeLine2DPtr -> Prelude.IO ()
foreign import stdcall unsafe "c_tepolygonset_destroy" tepolygonset_destroy :: TePolygonSetPtr -> Prelude.IO ()
foreign import stdcall unsafe "c_tepolygon_destroy" tepolygon_destroy :: TePolygonPtr -> Prelude.IO ()
foreign import stdcall unsafe "c_tepolygon_setobid" tepolygon_setobid :: TePolygonPtr -> CString -> Prelude.IO ()