module Algebras.Base.GeoObjects
(
TeGeoObject (..),
GeoObjects (..),
Value (..),
Attribute (..),
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
getId :: a -> i
getAttributes :: a -> [at]
getGeometries :: a -> [g]
data TeGeoObject = TeGeoObject ObjectId [Attribute] [TeGeometry]
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
retrieve 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)
store 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)
testInstance2geObject :: TeSTInstancePtr -> IO TeGeoObject
testInstance2geObject st = objectId st >>= \obid -> getProperties st >>= \attrs -> getGeometry st >>= \geo -> return (TeGeoObject (ObjectId obid) (map Attr attrs) geo)