{-- 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 a TeBox TerraLib class

Provides support for dealing with a rectangular a box. Used by all geometrical representations

More information - <http://www.terralib.org>-}
module TerraHS.TerraLib.TeBox
	(
		-- * The @TeBox@ type
		TeBox (..), TeBoxPtr,
		
		-- ** Operations on @TeBox@ 
		x1, y1, x2, y2
	)
 	where

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

import TerraHS.Misc.Object

-- |  The type @TeBox@  represents a rectangular box. Used by all geometrical representations in TerraLib Library
data TeBox   = TeBox Double Double Double Double deriving (Eq, Show)

-- | The type @TeBoxPtr@ is a pointer to @TeBox@
type TeBoxPtr = Foreign.Ptr.Ptr TeBox

instance Pointer TeBox where

	fromPointer ptr = do
		x1 <- tebox_x1 ptr 
		y1 <- tebox_y1 ptr
		x2 <- tebox_x2 ptr 
		y2 <- tebox_y2 ptr 
 		return (TeBox x1 y1 x2 y2)
	
	new (TeBox x1 y1 x2 y2) = do
		cp <- tebox_new x1 y1 x2 y2
		return cp
-- | Returns the x component of the lower left corner
x1 :: TeBox -> Double
x1 (TeBox x1 y1 x2 y2) = x1				

-- |  Returns the y component of the lower left corner
y1 :: TeBox -> Double
y1 (TeBox x1 y1 x2 y2) = y1				

-- |  Returns the x component of the upper right corner
x2 :: TeBox -> Double
x2 (TeBox x1 y1 x2 y2) = x2				

-- |  Returns the y component of the upper right corner
y2 :: TeBox -> Double
y2 (TeBox x1 y1 x2 y2) = y2

------------------ Tebox ----------------------------------------------------------------------
foreign import stdcall unsafe "c_tebox_new" tebox_new :: Double -> Double -> Double -> Double -> Prelude.IO TeBoxPtr
foreign import stdcall unsafe "c_tebox_x1" tebox_x1 :: TeBoxPtr -> Prelude.IO Double
foreign import stdcall unsafe "c_tebox_y1" tebox_y1 :: TeBoxPtr -> Prelude.IO Double
foreign import stdcall unsafe "c_tebox_x2" tebox_x2 :: TeBoxPtr -> Prelude.IO Double
foreign import stdcall unsafe "c_tebox_y2" tebox_y2 :: TeBoxPtr -> Prelude.IO Double