module TerraHS.TerraLib.TeSTInstance
(
TeSTInstance (..),
TeSTInstancePtr,
getProperties, getGeometry, objectId,
Value (..),
)
where
import Foreign
import Foreign.C.String
import qualified Foreign.Ptr (Ptr)
import TerraHS.Misc.Object
import TerraHS.TerraLib.TeGeometry
import TerraHS.Misc.Generic
import TerraHS.TerraLib.TePoint
import TerraHS.TerraLib.TeLine2D
import TerraHS.TerraLib.TeCell
import TerraHS.TerraLib.TeBox
import TerraHS.TerraLib.TePolygon
data TeSTInstance = TeSTInstance
type TeSTInstancePtr = Foreign.Ptr.Ptr TeSTInstance
type Property = (String, Value)
instance Pointer TeSTInstance where
new st = testinstance_new
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 (toInt v)
| otherwise = StValue v
getGeometry::TeSTInstancePtr -> Prelude.IO [TeGeometry]
getGeometry st = do
hp <- (testinstance_hasPoints st)
if (hp == True) then (TerraHS.Misc.Object.new (TePointSet [])) >>= \ps -> testinstance_gettepoints st ps >> pointset2geometryset ps 0 1 >>= \points -> delete ps >> return points else do
hl <- (testinstance_hasLines st)
if (hl == True) then (TerraHS.Misc.Object.new (TeLineSet [])) >>= \ps -> testinstance_gettelines st ps >> lineset2geometryset ps 0 1 >>= \lines -> delete ps >> return lines else do
hp1 <- testinstance_hasPolygons st
if (hp1 == True) then (TerraHS.Misc.Object.new (TePolygonSet [])) >>= \ps -> testinstance_gettepolygons st ps >> polygonset2geometryset ps 0 1 >>= \pols -> delete ps >> return pols else do
hc <- testinstance_hasCells st
if (hc == True) then (TerraHS.Misc.Object.new (TeCellSet [])) >>= \cs -> testinstance_gettecells st cs >> cellset2geometryset cs 0 1 >>= \cells -> delete cs >> return cells else return []
objectId :: TeSTInstancePtr -> Prelude.IO String
objectId st = testinstance_objectId st >>= peekCString >>= return
data Value
= StValue String
| DbValue Double
| InValue Int32
| Undefined
deriving (Eq, Show)
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 -> 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 ()