{-- 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 TeSTInstance TerraLib class

An instance in a time of a spatial element

More information - <http://www.terralib.org>
-}

module TerraHS.TerraLib.TeSTInstance 

		(
			-- * The @TeSTInstance@ type
			TeSTInstance (..),
			
			-- * The @TeSTInstancePtr@ type 
			TeSTInstancePtr,
						
			-- ** Operations on @TeSTInstancePtr@ 
			getProperties, getGeometry, objectId,
			
													
			
		)
		where

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

import TerraHS.Algebras.Base.Object
import TerraHS.Misc.GenericFunctions
import TerraHS.TerraLib.TeGeometry


import TerraHS.TerraLib.TePoint
import TerraHS.TerraLib.TeLine2D
import TerraHS.TerraLib.TeCell
import TerraHS.TerraLib.TeBox
import TerraHS.TerraLib.TePolygon
import TerraHS.TerraLib.TeLayer

import TerraHS.Algebras.Base.Attribute


-- |  The type @TeSTInstance@  represent an instance in a time of a spatial element
data TeSTInstance = TeSTInstance 

-- | The type @TeSTInstancePtr@ is a pointer to @TeSTInstance@
type TeSTInstancePtr = Foreign.Ptr.Ptr TeSTInstance


instance Pointer TeSTInstance where
	new st = testinstance_new


				
-- |  Returns the property list of this instance
getProperties :: TeSTInstancePtr ->  Prelude.IO [Property]
getProperties st  = testinstance_sizePropriety st >>= (getProperties2 st 0)
		
getProperties2 :: TeSTInstancePtr -> Int32 -> Int32 -> Prelude.IO [Property]
getProperties2 st i size = do
	if i >= size then return [] else testinstance_namePropriety st i >>= peekCString >>= \name -> testinstance_valuePropriety st i >>= peekCString >>= \value -> testinstance_typePropriety st i >>= \t -> (getProperties2 st (i+1) size) >>= \xs -> return  (( (name, (fvalue t value)) : xs))
		where	
		fvalue t v
			| t == 1 = DbValue (toDouble v)
			| t == 2 = InValue (fromIntegral (toInt v))
			| otherwise = StValue v
		
-- |  Returns the geometry list of this instance	
getGeometry :: TeSTInstancePtr -> TeLayerPtr -> Prelude.IO [TeGeometry]
getGeometry st layer = do
	hp <- (testinstance_hasPoints st)
	-- Pontos
	if (hp == True) then (new (TePointSet [])) >>= \ps -> testinstance_gettepoints st ps >> size ps >>= \pssize -> pointset2geometryset ps 0 pssize  >>= \points -> delete ps >> return points else do
		hl <- (testinstance_hasLines st)
		-- Lines
		if (hl == True) then (new (TeLineSet [])) >>= \ps -> testinstance_gettelines st ps >> size ps >>= \pssize ->  lineset2geometryset ps 0 pssize  >>= \lines -> delete ps >> return lines else do
			hp1 <- testinstance_hasPolygons st
			-- Polygons
			if (hp1 == True) then (new (TePolygonSet [])) >>= \ps -> testinstance_gettepolygons st ps layer >> size ps >>= \pssize -> polygonset2geometryset ps 0 pssize  >>= \pols -> delete ps >> return pols else do
				hc <- testinstance_hasCells st
				-- Cells
				if (hc == True) then (new (TeCellSet [])) >>= \cs -> testinstance_gettecells st cs >> cellset2geometryset cs 0 1  >>= \cells -> delete cs >> return cells else return []
				--if (hc == True) then (new (TeCellSet [])) >>= \cs -> testinstance_gettecells st cs >> cellset2geometryset cs 0 1  >>= \cells -> return cells else return []



-- | Returns the object identification
objectId :: TeSTInstancePtr ->  Prelude.IO String
objectId st = testinstance_objectId st >>= peekCString >>= return	

--testInstance2geometries :: TeSTInstancePtr -> IO [TeGeometry]
--testInstance2geometries st =  getGeometry st >>= \geo -> return (geo)
	

	
						
foreign import stdcall unsafe "c_testinstance_new" testinstance_new :: Prelude.IO TeSTInstancePtr
foreign import stdcall unsafe "c_testinstance_namePropriety" testinstance_namePropriety :: TeSTInstancePtr -> Int32 -> Prelude.IO CString
foreign import stdcall unsafe "c_testinstance_valuePropriety" testinstance_valuePropriety :: TeSTInstancePtr -> Int32 -> Prelude.IO CString
foreign import stdcall unsafe "c_testinstance_typePropriety" testinstance_typePropriety :: TeSTInstancePtr -> Int32 -> Prelude.IO Int32
foreign import stdcall unsafe "c_testinstance_gettepoints" testinstance_gettepoints :: TeSTInstancePtr -> TePointSetPtr -> Prelude.IO ()
foreign import stdcall unsafe "c_testinstance_objectId" testinstance_objectId :: TeSTInstancePtr -> Prelude.IO CString
foreign import stdcall unsafe "c_testinstance_sizePropriety" testinstance_sizePropriety :: TeSTInstancePtr -> Prelude.IO Int32 
foreign import stdcall unsafe "c_testinstance_gettelines" testinstance_gettelines :: TeSTInstancePtr ->  TeLineSetPtr -> Prelude.IO ()
foreign import stdcall unsafe "c_testinstance_gettepolygons" testinstance_gettepolygons :: TeSTInstancePtr -> TePolygonSetPtr -> TeLayerPtr -> Prelude.IO ()
foreign import stdcall unsafe "c_testinstance_hasPoints" testinstance_hasPoints :: TeSTInstancePtr -> Prelude.IO Bool
foreign import stdcall unsafe "c_testinstance_hasLines" testinstance_hasLines :: TeSTInstancePtr -> Prelude.IO Bool
foreign import stdcall unsafe "c_testinstance_hasPolygons" testinstance_hasPolygons :: TeSTInstancePtr -> Prelude.IO Bool
foreign import stdcall unsafe "c_testinstance_hasCells" testinstance_hasCells :: TeSTInstancePtr -> Prelude.IO Bool
foreign import stdcall unsafe "c_testinstance_gettecells" testinstance_gettecells :: TeSTInstancePtr -> TeCellSetPtr -> Prelude.IO ()