{-- 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 - <http://www.terralib.org>
-}
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