{-- 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) --} {-- --} module Algebras.Base.GeoObjects ( -- * The @TeGeoObject@ type TeGeoObject (..), -- * The @TeGeoObjects@ class GeoObjects (..), -- ** Operations on @TeGeoObject@ loadGeoObjects, -- * The @Value@ type Value (..), -- * The @Attribute@ type Attribute (..), -- * The @Attributes@ class Attributes (..), getValuebyName ) where import Foreign.C.String import Algebras.Base.Geometries import Algebras.Base.Points import Algebras.Base.Attribute import Algebras.Base.Lines import Algebras.Base.Polygons import Algebras.Base.Ids import TerraHS.Misc.Databases import TerraHS.Misc.Object 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.TeDatabase import TerraHS.TerraLib.TeSTInstance import TerraHS.TerraLib.TeLayer import TerraHS.TerraLib.TeQuerier import TerraHS.TerraLib.TeTable class (Num n, Points p n, Lines l n, Polygons pg l n, Geometries g pg l p n, Ids i, Values v, Attributes at v ) => GeoObjects a i at v g pg l p n | a -> i at v g pg l p n where -- | Returns the object identification getId :: a -> i -- | Returns the attributes list from a geoobject getAttributes :: a -> [at] -- | Returns the geometries list from a geoobject getGeometries :: a -> [g] data TeGeoObject = TeGeoObject ObjectId [Attribute] [TeGeometry] -- deriving (Show) -- falta implementar a parte instance GeoObjects TeGeoObject ObjectId Attribute Value TeGeometry TePolygon TeLine2D TePoint Double where getId (TeGeoObject obid attrs geometries) = obid getAttributes (TeGeoObject obid attrs geometries) = attrs getGeometries (TeGeoObject obid attrs geometries) = geometries instance Show TeGeoObject where show st = show (getId st) ++ " " ++ show ( [g] ) ++ " " ++ show (getAttributes st) where geos = getGeometries st geo = (head geos) g = formatG geo where formatG (GPt g) = (GPt g) formatG (GCl g) = (GCl g) formatG (GLn g) = (GLn (fl g)) where fl (TeLine2D ps) = (TeLine2D [(head ps), (last ps)]) formatG (GPg g) = (GPg (fp g)) where fp (TePolygon ls) = (TePolygon [fl (head ls)]) fl (TeLine2D ps) = (TeLine2D [(head ps), (last ps)]) instance Databases TeGeoObject TeDatabase where loadCollection db ln = do layer <- loadLayer db ln query <- TerraHS.Misc.Object.new (TeQuerier layer True True) st <- loadInstances query num <- numElemInstances query goSet <- getgeoobjects query 0 num return goSet where getgeoobjects q i size = (nextInstance q) >>= testInstance2geObject >>= \geo -> if i >= size then return [] else getgeoobjects q (i+1) size >>= \xs -> return (geo : xs) saveCollection db name st1 = do layer <- TerraHS.Misc.Object.new (TeLayerDb name db) let st = addObIds st1 0 let attrs = map getAttributes st let props = map (map (\(Attr t) -> t)) attrs let fields = fst (unzip (head props )) let values = map (snd . unzip ) props let strs = map ( (map toString) ) values saveTable layer (TeTable name fields strs ) let gs = map head (map (getGeometries ) st) if (isPoint (head gs)) then do let ps = geo2Points gs addPoints layer (TePointSet ps) else do if (isLine (head gs)) then do let ls = geo2Lines gs addLines layer (TeLineSet ls) else do if (isPolygon (head gs)) then do let ps = geo2Polygons gs addPolygons layer (TePolygonSet ps) else do let cs = geo2Cells gs addCells layer (TeCellSet cs) addObIds :: [TeGeoObject] -> Int -> [TeGeoObject] addObIds go i = addObIds' go i object_id_hs where object_id_hs =( (filter (=="object_id_hs") ( fst (unzip (head (map (map (\(Attr t) -> t)) ( map getAttributes go)) )) )) /= []) addObIds' :: [TeGeoObject] -> Int -> Bool -> [TeGeoObject] addObIds' go _ True = go addObIds' [] _ _ = [] addObIds' ((TeGeoObject (ObjectId id) atts geos ):os) i _= (TeGeoObject (ObjectId (show i)) (((Attr ("object_id_hs", (StValue (show i) ) ) ) ) : atts ) geos) : (addObIds' os (i+1) False) loadGeoObjects db name = ( (loadCollection db name)::(IO [TeGeoObject]) ) testInstance2geObject :: TeSTInstancePtr -> IO TeGeoObject testInstance2geObject st = objectId st >>= \obid -> getProperties st >>= \attrs -> getGeometry st >>= \geo -> return (TeGeoObject (ObjectId obid) (map Attr attrs) geo)