{-- 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.Geometries ( -- * The @Geometries@ class Geometries (..), geo2Points, geo2Lines, geo2Polygons, geo2Cells ) where 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 a, Points p a, Lines l a, Polygons pg l a) => Geometries g pg l p a | g -> pg l p a where isPoint, isPolygon, isLine :: g -> Bool toPolygon :: g -> pg toLine :: g -> l toPoint :: g -> p instance Geometries TeGeometry TePolygon TeLine2D TePoint Double where isPoint (GPt _) = True isPoint _ = False isLine (GLn _) = True isLine _ = False isPolygon (GPg _) = True isPolygon _ = False toPoint (GPt pt) = pt toPoint _ = error "topoint: geometry is not a point" toLine (GLn ls) = ls toLine _ = error "toline: geometry is not a line" toPolygon (GPg pg) = pg toPolygon _ = error "topoly: geometry is not a polygon" instance Databases [[TeGeometry]] TeDatabase where retrieve db ln = do layer <- loadLayer db ln query <- TerraHS.Misc.Object.new (TeQuerier layer True False) st <- loadInstances query num <- numElemInstances query goSet <- getgeometries query 0 num return goSet where getgeometries q i size = (nextInstance q) >>= testInstance2geometries >>= \gs -> if i >= size then return [] else getgeometries q (i+1) size >>= \xs -> return (gs : xs) store db name st = do layer <- TerraHS.Misc.Object.new (TeLayerDb name db) let fields = ["object_id_hs"] let strs = map (\x->[show x]) ([0..((length st)-1)]) saveTable layer (TeTable name fields strs ) let gs = map head 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) testInstance2geometries :: TeSTInstancePtr -> IO [TeGeometry] testInstance2geometries st = getGeometry st >>= \geo -> return (geo) geo2Points :: [TeGeometry] -> [TePoint] geo2Points [] = [] geo2Points ( ( GPt pt) :xs) = pt : (geo2Points xs) geo2Lines :: [TeGeometry] -> [TeLine2D] geo2Lines [] = [] geo2Lines ( ( GLn pt) :xs) = pt : (geo2Lines xs) geo2Polygons :: [TeGeometry] -> [TePolygon] geo2Polygons [] = [] geo2Polygons ( ( GPg pol) :xs) = pol : (geo2Polygons xs) geo2Cells :: [TeGeometry] -> [TeCell] geo2Cells [] = [] geo2Cells ( ( GCl pt) :xs) = pt : (geo2Cells xs)