module Algebras.Base.Geometries
(
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)