{-- 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 TeCell TerraLib class More information - -} module TerraHS.TerraLib.TeCell ( -- * The @TeCell@ type TeCell(..), -- * The @TeCellPtr@ type TeCellPtr, -- * The @TeCellSet@ type TeCellSet(..), -- * The @TeCellSetPtr@ type TeCellSetPtr, -- ** Operations on @TeTable@ column, line, box ) where import Foreign (Int32) import Foreign.C.String import qualified Foreign.Ptr (Ptr) import TerraHS.TerraLib.TeBox import TerraHS.Algebras.Base.Object data TeCell = TeCell TeBox Int32 Int32 deriving (Eq, Show) -- | The type @TeCellPtr@ is a pointer to @TeCell@ type TeCellPtr = Foreign.Ptr.Ptr TeCell data TeCellSet = TeCellSet [TeCell] -- | The type @TeCellSetPtr@ is a pointer to @TeCellSet@ type TeCellSetPtr = Foreign.Ptr.Ptr TeCellSet -- | Returns the column identification of the cell column :: TeCell -> Int32 column (TeCell _ c _) = c -- | Returns the line identification of the cell line :: TeCell -> Int32 line ( TeCell _ _ l ) = l -- | Returns the box of the cell box :: TeCell -> TeBox box (TeCell b _ _) = b cellId :: TeCellPtr -> String -> IO () cellId ptr str = newCString str >>= (tecell_setobid ptr) >>= return instance Pointer TeCell where new (TeCell box c l) = do tbox <- (new box) cl <- (tecell_new tbox c l) return cl fromPointer ptr = tecell_box ptr >>= fromPointer >>= \hb -> tecell_column ptr >>= \c -> (tecell_line ptr) >>= \l -> return (TeCell hb c l) delete ptr = (tecell_destroy ptr) instance Pointer TeCellSet where new (TeCellSet []) = tecellset_new new (TeCellSet xs) = do ptr <- new (TeCellSet []) addCells ptr xs 0 return ptr where addCells ptr [] _ = error "erro" addCells ptr [x] i = new x >>= \c -> cellId c (show i) >> (tecellset_addtecell ptr c) addCells ptr (x:xs) i = new x >>= \c -> cellId c (show i) >> (tecellset_addtecell ptr c ) >> (addCells ptr xs) (i+1) delete ptr = (tecellset_destroy ptr) instance Element TeCellSet TeCell where getElement ptr i = tecellset_gettecell ptr i >>= fromPointer >>= return instance Size TeCellSet where size ptr = (tecellset_size ptr) ----------- TeCell, TeCellSet ------------------------------------------------------------------- foreign import ccall unsafe "c_tecell_new" tecell_new :: TeBoxPtr -> Int32 -> Int32 -> Prelude.IO TeCellPtr --foreign import ccall unsafe "c_tecell_size" tecell_size :: TeCellPtr -> Prelude.IO Int32 foreign import ccall unsafe "c_tecell_box" tecell_box :: TeCellPtr -> Prelude.IO TeBoxPtr foreign import ccall unsafe "c_tecell_column" tecell_column :: TeCellPtr -> Prelude.IO Int32 foreign import ccall unsafe "c_tecell_line" tecell_line :: TeCellPtr -> Prelude.IO Int32 foreign import ccall unsafe "c_tecellset_new" tecellset_new :: Prelude.IO TeCellSetPtr foreign import ccall unsafe "c_tecellset_size" tecellset_size :: TeCellSetPtr -> Prelude.IO Int32 foreign import ccall unsafe "c_tecellset_gettecell" tecellset_gettecell :: TeCellSetPtr-> Int32 -> Prelude.IO TeCellPtr foreign import ccall unsafe "c_tecellset_addtecell" tecellset_addtecell :: TeCellSetPtr-> TeCellPtr -> Prelude.IO () foreign import ccall unsafe "c_tecell_setobid" tecell_setobid :: TeCellPtr -> CString -> Prelude.IO () foreign import ccall unsafe "c_tecell_destroy" tecell_destroy :: TeCellPtr -> Prelude.IO () foreign import ccall unsafe "c_tecellset_destroy" tecellset_destroy :: TeCellSetPtr -> Prelude.IO ()