module TerraHS.TerraLib.TeGeoObject
(
TeGeoObject (..),
loadGeoObjects,
)
where
import Foreign.C.String
import TerraHS.Algebras.Spatial.Geometries
import TerraHS.Algebras.Spatial.Points
import TerraHS.Algebras.Base.Attribute
import TerraHS.Algebras.Spatial.Lines
import TerraHS.Algebras.Spatial.Polygons
import TerraHS.Algebras.Base.Ids
import TerraHS.TerraLib.TeGeometry
import TerraHS.Algebras.Spatial.GeoObjects
import TerraHS.Algebras.Spatial.GeoObjects
import TerraHS.Algebras.DB.Databases
import TerraHS.Algebras.Base.Object
import TerraHS.Misc.GenericFunctions
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.TeTheme
import TerraHS.TerraLib.TeQuerier
import TerraHS.TerraLib.TeTable
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 TeTheme where
retrieve db (TeTheme tn) = do
theme <- loadTheme db tn
query <- new (TeQuerierTheme theme True True)
layer <- tetheme_layer theme
st <- loadInstances query
num <- numElemInstances query
goSet <- getgeoobjects query layer 0 num
return goSet
where
getgeoobjects q layer i size = (nextInstance q) >>= (testInstance2geObject layer)>>= \geo ->
if i >= size then return [] else getgeoobjects q layer (i+1) size >>= \xs -> return (geo : xs)
instance Databases [TeGeoObject] TeDatabase String where
retrieve db ln = do
layer <- loadLayer db ln
query <- new (TeQuerier layer True True)
st <- loadInstances query
num <- numElemInstances query
goSet <- getgeoobjects query layer 0 num
return goSet
where
getgeoobjects q layer i size = (nextInstance q) >>= (testInstance2geObject layer)>>= \geo ->
if i >= size then return [] else getgeoobjects q layer (i+1) size >>= \xs -> return (geo : xs)
store db name st1 = do
layer <- new (TeLayer 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)
takeNo :: (a -> Bool) -> [a] -> [a]
takeNo p [] = []
takeNo p (x:xs)
| (not (p x)) = x : takeNo p xs
| otherwise = (takeNo p xs)
setAtribute [] _ = []
setAtribute ((TeGeoObject id _ geo):xs) (y:ys) = (TeGeoObject id y geo ) : (setAtribute xs ys)
apaga_id go = takeNo (\x->((getName x)) == "object_id_hs") (getAttributes go)
arruma_id gos = setAtribute gos (map apaga_id gos)
instance Databases [TeGeoObject] TeDatabase (String,TeProjection) where
store db (name, prj) st1 = do
prj <- new prj
layer <- new (TeLayer name db)
telayer_setprojection layer prj
let st = addObIds (arruma_id 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 = ( (retrieve db name)::(IO [TeGeoObject]) )
testInstance2geObject :: TeLayerPtr -> TeSTInstancePtr -> IO TeGeoObject
testInstance2geObject layer st = objectId st >>= \obid -> getProperties st >>= \attrs -> getGeometry st layer >>= \geo -> return (TeGeoObject (ObjectId obid) (map Attr attrs) geo)