{-- 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) --} {- | A module for supporting the functions of TerraLib TeGeometryAlgorithms More information - -} module TerraHS.TerraLib.TeTopologyOps {-- ( distance, linelength, area, Centroid (..), terelation, Egenhofer9 (..), TeRelations (..), TeSpatialRelation (..), Topology(..) ) --} where import Foreign import Foreign.C.String import qualified Foreign.Ptr (Ptr) --locais 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 applyf ea fab ec fcd fbde = fab ea >>= \eb -> fcd ec >>= \ed -> fbde eb ed >>= \r -> delete eb >> delete ed >> return r -- semanticamente toTE tx = TerraHS.Misc.Object.new tx -- | Operators that test topologival relation between two objects. class Topology a b where teintersects, tecontains, tecoveredby, teoverlaps, teequals, tewithin, tedisjoint, tecrosses, tetouches :: a -> b -> Bool tecontainedBy :: b -> a -> Bool teequals g1 g2 = error "Not Applicable" tewithin g1 g2 = error "Not Applicable" tedisjoint g1 g2 = error "Not Applicable" tetouches g1 g2 = error "Not Applicable" teoverlaps g1 g2 = error "Not Applicable" tecoveredby g1 g2 = error "Not Applicable" tecrosses g1 g2 = error "Not Applicable" tecontains g1 g2 = error "Not Applicable" tecontainedBy g1 g2 = tecontains g2 g1 teintersects g1 g2 = not (tedisjoint g1 g2) instance Topology TeGeometry TeGeometry where -------------------------------------- -- teequals ------------------------------ -------------------------------------- -- TePoint -> TePoint -------- teequals (GPg g1) (GPg g2) = teequals g1 g2 -- TeLine2D -> TeLine2D -------- teequals (GCl g1) (GCl g2) = teequals g1 g2 -- TePolygon -> TePolygon -------- teequals (GPg g1) (GPg g2) = teequals g1 g2 -- TeCell -> TeCell -------- teequals (GCl g1) (GCl g2) = teequals g1 g2 -------------------------------------- -- tewithin ---------------------------- -------------------------------------- -- TePoint -> TeLine2D tewithin (GPt g1) (GLn g2) = tewithin g1 g2 -- TePoint -> TePoint tewithin (GPt g1) (GPt g2) = tewithin g1 g2 -- TePoint -> TePolygon tewithin (GPt g1) (GPg g2) = tewithin g1 g2 -- TePoint -> TePolygon tewithin (GPt g1) (GPg g2) = tewithin g1 g2 -- TeLine2D -> TeLine2D tewithin (GLn g1) (GLn g2) = tewithin g1 g2 -- TeLine2D -> TePolygon tewithin (GLn g1) (GPg g2) = tewithin g1 g2 -- TeLine2D -> TePolygon tewithin (GLn g1) (GPg g2) = tewithin g1 g2 -- TeCell -> TeCell tewithin (GCl g1) (GCl g2) = tewithin g1 g2 -- TeLIne2D -> TeCell tewithin (GLn g1) (GCl g2) = tewithin g1 g2 -- TeCell -> TePolygon tewithin (GCl g1) (GPg g2) = tewithin g1 g2 tewithin (GPg g1) (GPg g2) = tewithin g1 g2 -- TePoint -> TeCell tewithin (GPt g1) (GCl g2) = tewithin g1 g2 -------------------------------------- -- tedisjoint ---------------------------- -------------------------------------- tedisjoint (GPg g1) (GPg g2) = tedisjoint g1 g2 tedisjoint (GLn g1) (GPg g2) = tedisjoint g1 g2 tedisjoint (GPt g1) (GPt g2) = tedisjoint g1 g2 tedisjoint (GLn g1) (GLn g2) = tedisjoint g1 g2 tedisjoint (GPt g1) (GLn g2) = tedisjoint g1 g2 tedisjoint (GPt g1) (GPg g2) = tedisjoint g1 g2 tedisjoint (GCl g1) (GCl g2) = tedisjoint g1 g2 tedisjoint (GCl g1) (GLn g2) = tedisjoint g1 g2 tedisjoint (GCl g1) (GPg g2) = tedisjoint g1 g2 tedisjoint (GCl g1) (GPt g2) = tedisjoint g1 g2 -------------------------------------- -- tecrosses --------------------------- -------------------------------------- tecrosses (GLn g1) (GPg g2) = tecrosses g1 g2 tecrosses (GLn g1) (GLn g2) = tecrosses g1 g2 tecrosses (GLn g1) (GCl g2) = tecrosses g1 g2 -------------------------------------- -- tetouches --------------------------- -------------------------------------- tetouches (GLn g1) (GLn g2) = tetouches g1 g2 tetouches (GPt g1) (GLn g2) = tetouches g1 g2 tetouches (GPt g1) (GPg g2) = tetouches g1 g2 tetouches (GLn g1) (GPg g2) = tetouches g1 g2 tetouches (GPg g1) (GPg g2) = tetouches g1 g2 tetouches (GCl g1) (GCl g2) = tetouches g1 g2 tetouches (GLn g1) (GCl g2) = tetouches g1 g2 tetouches (GCl g1) (GPg g2) = tetouches g1 g2 tetouches (GPt g1) (GCl g2) = tetouches g1 g2 -------------------------------------- -- teoverlaps --------------------------- -------------------------------------- teoverlaps (GLn g1) (GLn g2) = teoverlaps g1 g2 teoverlaps (GPg g1) (GPg g2) = teoverlaps g1 g2 teoverlaps (GCl g1) (GCl g2) = teoverlaps g1 g2 teoverlaps (GCl g1) (GPg g2) = teoverlaps g1 g2 -------------------------------------- -- tecoveredby --------------------------- -------------------------------------- tecoveredby (GLn g1) (GLn g2) = tecoveredby g1 g2 tecoveredby (GPg g1) (GPg g2) = tecoveredby g1 g2 tecoveredby (GCl g1) (GCl g2) = tecoveredby g1 g2 tecoveredby (GPg g1) (GCl g2) = tecoveredby g1 g2 tecoveredby (GLn g1) (GPg g2) = tecoveredby g1 g2 tecoveredby (GLn g1) (GCl g2) = tecoveredby g1 g2 instance Topology TePoint TePoint where teequals g1 g2 = unsafePerformIO (applyf g1 toTE g2 toTE tepoint_teequals) tewithin g1 g2 = unsafePerformIO (applyf g1 toTE g2 toTE tepoint_tewithin) tedisjoint g1 g2 = unsafePerformIO (applyf g1 toTE g2 toTE tepoint_tedisjoint) instance Topology TeLine2D TeLine2D where teequals g1 g2 = unsafePerformIO (applyf g1 toTE g2 toTE teline2d_teequals) tewithin g1 g2 = unsafePerformIO (applyf g1 toTE g2 toTE teline2d_tewithin) tedisjoint g1 g2 = unsafePerformIO (applyf g1 toTE g2 toTE teline2d_tedisjoint) tecrosses g1 g2 = unsafePerformIO (applyf g1 toTE g2 toTE teline2d_tecrosses) instance Topology TePolygon TePolygon where tewithin g1 g2 = unsafePerformIO (applyf g1 toTE g2 toTE tepolygon_tewithin) --((terelation g1 g2) == TeWITHIN) tedisjoint g1 g2 = ((terelation g1 g2) == TeDISJOINT) tetouches g1 g2 = ((terelation g1 g2) == TeTOUCHES) teoverlaps g1 g2 = ((terelation g1 g2) == TeOVERLAPS) tecoveredby g1 g2 = ((terelation g1 g2) == TeCOVEREDBY) instance Topology TeCell TeCell where teequals g1 g2 = unsafePerformIO (applyf g1 toTE g2 toTE tecell_teequals) tewithin g1 g2 = unsafePerformIO (applyf g1 toTE g2 toTE tecell_tewithin) tedisjoint g1 g2 = unsafePerformIO (applyf g1 toTE g2 toTE tecell_tedisjoint) tetouches g1 g2 = unsafePerformIO (applyf g1 toTE g2 toTE tecell_tetouches) teoverlaps g1 g2 = unsafePerformIO (applyf g1 toTE g2 toTE tecell_teoverlaps) tecoveredby g1 g2 = unsafePerformIO (applyf g1 toTE g2 toTE tecell_tecoveredby) instance Topology TePoint TePolygon where tewithin g1 g2 = ((terelation g1 g2) == TeWITHIN) tedisjoint g1 g2 = ((terelation g1 g2) == TeDISJOINT) tetouches g1 g2 = ((terelation g1 g2) == TeTOUCHES) teoverlaps g1 g2 = ((terelation g1 g2) == TeOVERLAPS) tecoveredby g1 g2 = ((terelation g1 g2) == TeCOVEREDBY) instance Topology TeLine2D TePolygon where tewithin g1 g2 = ((terelation g1 g2) == TeWITHIN) tedisjoint g1 g2 = ((terelation g1 g2) == TeDISJOINT) tetouches g1 g2 = ((terelation g1 g2) == TeTOUCHES) teoverlaps g1 g2 = ((terelation g1 g2) == TeOVERLAPS) tecoveredby g1 g2 = ((terelation g1 g2) == TeCOVEREDBY) instance Topology TePoint TeLine2D where tewithin g1 g2 = ((terelation g1 g2) == TeWITHIN) tedisjoint g1 g2 = ((terelation g1 g2) == TeDISJOINT) tetouches g1 g2 = ((terelation g1 g2) == TeTOUCHES) teoverlaps g1 g2 = ((terelation g1 g2) == TeOVERLAPS) tecoveredby g1 g2 = ((terelation g1 g2) == TeCOVEREDBY) instance Topology TeLine2D TeCell where tewithin g1 g2 = unsafePerformIO (applyf g1 toTE g2 toTE linecell_tewithin) tetouches g1 g2 = unsafePerformIO (applyf g1 toTE g2 toTE linecell_tetouches) tecoveredby g1 g2 = unsafePerformIO (applyf g1 toTE g2 toTE linecell_tecoveredby) tecrosses g1 g2 = unsafePerformIO (applyf g1 toTE g2 toTE linecell_tecrosses) instance Topology TePoint TeCell where tewithin g1 g2 = unsafePerformIO (applyf g1 toTE g2 toTE pointcell_tewithin) tetouches g1 g2 = unsafePerformIO (applyf g1 toTE g2 toTE pointcell_tetouches) instance Topology TePolygon TeCell where tecoveredby g1 g2 = unsafePerformIO (applyf g1 toTE g2 toTE polcell_tecoveredby) instance Topology TeCell TePolygon where tewithin g1 g2 = unsafePerformIO (applyf g1 toTE g2 toTE cellpol_tewithin) tedisjoint g1 g2 = unsafePerformIO (applyf g1 toTE g2 toTE cellpol_tedisjoint) tetouches g1 g2 = unsafePerformIO (applyf g1 toTE g2 toTE cellpol_tetouches) teoverlaps g1 g2 = unsafePerformIO (applyf g1 toTE g2 toTE cellpol_teoverlaps) instance Topology TeCell TeLine2D where tedisjoint g1 g2 = unsafePerformIO (applyf g1 toTE g2 toTE cellline_tedisjoint) instance Topology TeCell TePoint where tedisjoint g1 g2 = unsafePerformIO (applyf g1 toTE g2 toTE cellpoint_tedisjoint) ---- relation data TeSpatialRelation = TeDISJOINT | TeTOUCHES | TeCROSSES | TeWITHIN | TeOVERLAPS | TeCONTAINS | TeINTERSECTS | TeEQUALS | TeCOVERS | TeCOVEREDBY | TeUNDEFINEDREL deriving (Show, Eq, Ord) class TeRelations a b where terelation :: a -> b -> TeSpatialRelation instance TeRelations TePolygon TePolygon where terelation g1 g2 = ( unsafePerformIO (applyf g1 toTE g2 toTE polpol_terelation >>= \r -> return (returnTeRelation r ))) instance TeRelations TePoint TePolygon where terelation g1 g2 = ( unsafePerformIO (applyf g1 toTE g2 toTE pointpol_terelation >>= \r -> return (returnTeRelation r ))) instance TeRelations TeLine2D TePolygon where terelation g1 g2 = ( unsafePerformIO (applyf g1 toTE g2 toTE linepol_terelation >>= \r -> return (returnTeRelation r ))) instance TeRelations TePoint TeLine2D where terelation g1 g2 = ( unsafePerformIO (applyf g1 toTE g2 toTE pointline_terelation >>= \r -> return (returnTeRelation r ))) instance TeRelations TeGeometry TeGeometry where terelation (GPg g1) (GPg g2) = ( unsafePerformIO (applyf g1 toTE g2 toTE polpol_terelation >>= \r -> return (returnTeRelation r ))) terelation (GPt g1) (GPg g2) = ( unsafePerformIO (applyf g1 toTE g2 toTE pointpol_terelation >>= \r -> return (returnTeRelation r ))) terelation (GLn g1) (GPg g2) = ( unsafePerformIO (applyf g1 toTE g2 toTE linepol_terelation >>= \r -> return (returnTeRelation r ))) terelation (GPt g1) (GLn g2) = ( unsafePerformIO (applyf g1 toTE g2 toTE pointline_terelation >>= \r -> return (returnTeRelation r ))) terelation _ _ = error "topoly: relation is not applicable" returnTeRelation :: Int32 -> TeSpatialRelation returnTeRelation r |r == 1 =TeDISJOINT |r == 2 =TeTOUCHES |r == 4 =TeCROSSES |r == 8 =TeWITHIN |r == 16 =TeOVERLAPS |r == 32 =TeCONTAINS |r == 64 =TeINTERSECTS |r == 128 =TeEQUALS |r == 256 =TeCOVERS |r == 512 =TeCOVEREDBY | otherwise = TeUNDEFINEDREL -- teequals ------------------------- foreign import stdcall unsafe "c_tecell_teequals" tecell_teequals :: TeCellPtr -> TeCellPtr -> Prelude.IO Bool foreign import stdcall unsafe "c_tepolygon_teequals" tepolygon_teequals :: TePolygonPtr -> TePolygonPtr -> Prelude.IO Bool foreign import stdcall unsafe "c_tepoint_teequals" tepoint_teequals :: TePointPtr -> TePointPtr -> Prelude.IO Bool foreign import stdcall unsafe "c_teline2d_teequals" teline2d_teequals :: TeLine2DPtr -> TeLine2DPtr -> Prelude.IO Bool --- tecrosses ------------------------ foreign import stdcall unsafe "c_teline2d_tecrosses" teline2d_tecrosses :: TeLine2DPtr -> TeLine2DPtr -> Prelude.IO Bool foreign import stdcall unsafe "c_linepol_tecrosses" linepol_tecrosses :: TeLine2DPtr -> TePolygonPtr -> Prelude.IO Bool foreign import stdcall unsafe "c_linecell_tecrosses" linecell_tecrosses :: TeLine2DPtr -> TeCellPtr -> Prelude.IO Bool --- tedisjoint ----------------------- foreign import stdcall unsafe "c_tepolygon_tedisjoint" tepolygon_tedisjoint :: TePolygonPtr -> TePolygonPtr -> Prelude.IO Bool foreign import stdcall unsafe "c_linepol_tedisjoint" linepol_tedisjoint :: TeLine2DPtr -> TePolygonPtr -> Prelude.IO Bool foreign import stdcall unsafe "c_tepoint_tedisjoint" tepoint_tedisjoint :: TePointPtr -> TePointPtr -> Prelude.IO Bool foreign import stdcall unsafe "c_teline2d_tedisjoint" teline2d_tedisjoint :: TeLine2DPtr -> TeLine2DPtr -> Prelude.IO Bool foreign import stdcall unsafe "c_pointline_tedisjoint" pointline_tedisjoint :: TePointPtr -> TeLine2DPtr -> Prelude.IO Bool foreign import stdcall unsafe "c_pointpol_tedisjoint" pointpol_tedisjoint :: TePointPtr -> TePolygonPtr -> Prelude.IO Bool foreign import stdcall unsafe "c_tecell_tedisjoint" tecell_tedisjoint :: TeCellPtr -> TeCellPtr -> Prelude.IO Bool foreign import stdcall unsafe "c_cellline_tedisjoint" cellline_tedisjoint :: TeCellPtr -> TeLine2DPtr -> Prelude.IO Bool foreign import stdcall unsafe "c_cellpol_tedisjoint" cellpol_tedisjoint :: TeCellPtr -> TePolygonPtr -> Prelude.IO Bool foreign import stdcall unsafe "c_cellpoint_tedisjoint" cellpoint_tedisjoint :: TeCellPtr -> TePointPtr -> Prelude.IO Bool --- tetouches ----------- foreign import stdcall unsafe "c_teline2d_tetouches" teline2d_tetouches :: TeLine2DPtr -> TeLine2DPtr -> Prelude.IO Bool foreign import stdcall unsafe "c_linepoint_tetouches" linepoint_tetouches :: TePointPtr -> TeLine2DPtr -> Prelude.IO Bool foreign import stdcall unsafe "c_pointpol_tetouches" pointpol_tetouches :: TePointPtr -> TePolygonPtr -> Prelude.IO Bool foreign import stdcall unsafe "c_linepol_tetouches" linepol_tetouches :: TeLine2DPtr -> TePolygonPtr -> Prelude.IO Bool foreign import stdcall unsafe "c_tepolygon_tetouches" tepolygon_tetouches :: TePolygonPtr -> TePolygonPtr -> Prelude.IO Bool foreign import stdcall unsafe "c_tecell_tetouches" tecell_tetouches :: TeCellPtr -> TeCellPtr -> Prelude.IO Bool foreign import stdcall unsafe "c_linecell_tetouches" linecell_tetouches :: TeLine2DPtr -> TeCellPtr -> Prelude.IO Bool foreign import stdcall unsafe "c_cellpol_tetouches" cellpol_tetouches :: TeCellPtr -> TePolygonPtr -> Prelude.IO Bool foreign import stdcall unsafe "c_pointcell_tetouches" pointcell_tetouches :: TePointPtr -> TeCellPtr -> Prelude.IO Bool -- tewithin ---------- foreign import stdcall unsafe "c_linepoint_tewithin" linepoint_tewithin :: TePointPtr -> TeLine2DPtr -> Prelude.IO Bool foreign import stdcall unsafe "c_tepoint_tewithin" tepoint_tewithin :: TePointPtr -> TePointPtr -> Prelude.IO Bool foreign import stdcall unsafe "c_pointpol_tewithin" pointpol_tewithin :: TePointPtr -> TePolygonPtr -> Prelude.IO Bool foreign import stdcall unsafe "c_teline2d_tewithin" teline2d_tewithin :: TeLine2DPtr -> TeLine2DPtr -> Prelude.IO Bool foreign import stdcall unsafe "c_linepol_tewithin" linepol_tewithin :: TeLine2DPtr -> TePolygonPtr -> Prelude.IO Bool foreign import stdcall unsafe "c_tecell_tewithin" tecell_tewithin :: TeCellPtr -> TeCellPtr -> Prelude.IO Bool foreign import stdcall unsafe "c_linecell_tewithin" linecell_tewithin :: TeLine2DPtr -> TeCellPtr -> Prelude.IO Bool foreign import stdcall unsafe "c_cellpol_tewithin" cellpol_tewithin :: TeCellPtr -> TePolygonPtr -> Prelude.IO Bool foreign import stdcall unsafe "c_pointcell_tewithin" pointcell_tewithin :: TePointPtr -> TeCellPtr -> Prelude.IO Bool foreign import stdcall unsafe "c_tepolygon_tewithin" tepolygon_tewithin :: TePolygonPtr -> TePolygonPtr -> Prelude.IO Bool --- teoverlaps foreign import stdcall unsafe "c_teline2d_teoverlaps" teline2d_teoverlaps :: TeLine2DPtr -> TeLine2DPtr -> Prelude.IO Bool foreign import stdcall unsafe "c_tepolygon_teoverlaps" tepolygon_teoverlaps :: TePolygonPtr -> TePolygonPtr -> Prelude.IO Bool foreign import stdcall unsafe "c_tecell_teoverlaps" tecell_teoverlaps :: TeCellPtr -> TeCellPtr -> Prelude.IO Bool foreign import stdcall unsafe "c_cellpol_teoverlaps" cellpol_teoverlaps :: TeCellPtr -> TePolygonPtr -> Prelude.IO Bool --- tecoveredby foreign import stdcall unsafe "c_teline2d_tecoveredby" teline2d_tecoveredby :: TeLine2DPtr -> TeLine2DPtr -> Prelude.IO Bool foreign import stdcall unsafe "c_tepolygon_tecoveredby" tepolygon_tecoveredby :: TePolygonPtr -> TePolygonPtr -> Prelude.IO Bool foreign import stdcall unsafe "c_tecell_tecoveredby" tecell_tecoveredby :: TeCellPtr -> TeCellPtr -> Prelude.IO Bool foreign import stdcall unsafe "c_polcell_tecoveredby" polcell_tecoveredby :: TePolygonPtr -> TeCellPtr -> Prelude.IO Bool foreign import stdcall unsafe "c_linepol_tecoveredby" linepol_tecoveredby :: TeLine2DPtr -> TePolygonPtr -> Prelude.IO Bool foreign import stdcall unsafe "c_linecell_tecoveredby" linecell_tecoveredby :: TeLine2DPtr -> TeCellPtr -> Prelude.IO Bool -- Relations foreign import stdcall unsafe "c_pointline_terelation" pointline_terelation :: TePointPtr -> TeLine2DPtr -> Prelude.IO Int32 foreign import stdcall unsafe "c_polpol_terelation" polpol_terelation :: TePolygonPtr -> TePolygonPtr -> Prelude.IO Int32 foreign import stdcall unsafe "c_pointpol_terelation" pointpol_terelation :: TePointPtr -> TePolygonPtr -> Prelude.IO Int32 foreign import stdcall unsafe "c_linepol_terelation" linepol_terelation :: TeLine2DPtr -> TePolygonPtr -> Prelude.IO Int32