{-- 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 - <http://www.terralib.org>
-}
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
import Foreign.C.String
import qualified Foreign.Ptr (Ptr)

import TerraHS.TerraLib.TeBox
import TerraHS.Misc.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 <- (TerraHS.Misc.Object.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 <- TerraHS.Misc.Object.new (TeCellSet [])
		addCells ptr xs 0
		return ptr
		where
		addCells ptr [] _ = error "erro"
		addCells ptr [x] i = TerraHS.Misc.Object.new x >>= \c -> cellId c (show i) >> (tecellset_addtecell ptr c)
		addCells ptr (x:xs) i = TerraHS.Misc.Object.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 stdcall unsafe "c_tecell_new" tecell_new :: TeBoxPtr -> Int32 -> Int32 -> Prelude.IO TeCellPtr
--foreign import stdcall unsafe "c_tecell_size" tecell_size :: TeCellPtr -> Prelude.IO Int32
foreign import stdcall unsafe "c_tecell_box" tecell_box :: TeCellPtr -> Prelude.IO TeBoxPtr
foreign import stdcall unsafe "c_tecell_column" tecell_column :: TeCellPtr -> Prelude.IO Int32
foreign import stdcall unsafe "c_tecell_line" tecell_line :: TeCellPtr -> Prelude.IO Int32
foreign import stdcall unsafe "c_tecellset_new" tecellset_new :: Prelude.IO TeCellSetPtr
foreign import stdcall unsafe "c_tecellset_size" tecellset_size :: TeCellSetPtr -> Prelude.IO Int32
foreign import stdcall unsafe "c_tecellset_gettecell" tecellset_gettecell :: TeCellSetPtr-> Int32 -> Prelude.IO TeCellPtr
foreign import stdcall unsafe "c_tecellset_addtecell" tecellset_addtecell :: TeCellSetPtr-> TeCellPtr -> Prelude.IO ()
 
foreign import stdcall unsafe "c_tecell_setobid" tecell_setobid :: TeCellPtr -> CString -> Prelude.IO ()

foreign import stdcall unsafe "c_tecell_destroy" tecell_destroy :: TeCellPtr -> Prelude.IO ()
foreign import stdcall unsafe "c_tecellset_destroy" tecellset_destroy :: TeCellSetPtr -> Prelude.IO ()