{-- 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)
--}

{--  --}

module TerraHS.TerraLib.TeGeometry	where


import Foreign
import Foreign.C.String
import qualified Foreign.Ptr (Ptr)

import qualified System.IO.Unsafe (unsafePerformIO)

import TerraHS.Misc.GenericFunctions
import TerraHS.Algebras.Base.Object

import TerraHS.TerraLib.TePoint
import TerraHS.TerraLib.TeLine2D
import TerraHS.TerraLib.TeCell
import TerraHS.TerraLib.TeBox
import TerraHS.TerraLib.TePolygon

import TerraHS.Algebras.Spatial.Geometries
 		
data TeGeometry = GPt TePoint 
	| GPg TePolygon 
	| GLn TeLine2D
	| GCl TeCell
	deriving (Show,Eq)	
	

type TeGeometryPtr = Foreign.Ptr.Ptr TeGeometry



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"
   


pointset2geometryset :: TePointSetPtr ->  Int32 -> Int32 -> Prelude.IO [TeGeometry]
pointset2geometryset gs i size = do
		if i >= size then return [] else (getElement gs i) >>= \x -> pointset2geometryset gs (i+1) size >>= \xs -> return  ((GPt x) : xs)
		
lineset2geometryset :: TeLineSetPtr ->  Int32 -> Int32 -> Prelude.IO [TeGeometry]
lineset2geometryset gs i size = do
		if i >= size then return [] else (getElement gs i) >>= \x -> lineset2geometryset gs (i+1) size >>= \xs -> return  ((GLn x) : xs)
		
polygonset2geometryset :: TePolygonSetPtr ->  Int32 -> Int32 -> Prelude.IO [TeGeometry]
polygonset2geometryset gs i size = do
		if i >= size then return [] else (getElement gs i) >>= \x -> polygonset2geometryset gs (i+1) size >>= \xs -> return  ((GPg x) : xs)

cellset2geometryset :: TeCellSetPtr ->  Int32 -> Int32 -> Prelude.IO [TeGeometry]
cellset2geometryset gs i size = do
		if i >= size then return [] else (getElement gs i) >>= \x -> cellset2geometryset gs (i+1) size >>= \xs -> return  ((GCl x) : xs)
		
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)