{-- 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 TeRaster TerraLib class

	More information - <http://www.terralib.org>
-}

module TerraHS.TerraLib.TeRaster where

import System.IO.Unsafe 
--import Foreign
import Foreign (Int32)

import Foreign.C.String

import qualified Foreign.Ptr (Ptr)
import TerraHS.Algebras.Base.Object
import TerraHS.Misc.GenericFunctions
import TerraHS.Algebras.Base.Category

import TerraHS.Algebras.Spatial.Raster

import TerraHS.Algebras.DB.Databases
import TerraHS.TerraLib.TeLayer
import TerraHS.TerraLib.TeDatabase

-- data	
type Grd a = [[a]]


-- | The type  @TeRaster@ represents a geographic layer	
data TeRaster a = TeRaster (Grd a) deriving (Show) 


--enum TeDataType 
--{	TeBIT, TeUNSIGNEDCHAR, TeCHAR, TeUNSIGNEDSHORT, TeSHORT, TeINTEGER, TeUNSIGNEDLONG, TeLONG, TeFLOAT, TeDOUBLE };

-- | The type @TeLayerPtr@ is a pointer to @TeLayer@
type TeRasterPtr = Foreign.Ptr.Ptr (TeRaster Double)

instance Pointer (TeRaster Double) where
		
	fromPointer ptr = return ( TeRaster (getrasterLines ptr 0 0 (nlines ptr) (ncols ptr)))

	new (TeRaster rs) = ( new_teraster2 nc nl ) >>= \ptr -> teraster_init ptr >> setrasterLines rs ptr 0 0 >> return ptr
		where
		nl :: Int32
		nl = fromIntegral (length rs) 
		nc :: Int32
		nc = fromIntegral (length (head rs))
	
instance Funct TeRaster where
    lift1 f (TeRaster grd) = ( TeRaster (Prelude.map (Prelude.map f) grd) )
    lift2 g (TeRaster grd1) (TeRaster grd2) = ( TeRaster (lift2' g grd1 grd2) )
    	where
    	lift2' z (a:as) (b:bs) = (Prelude.zipWith z a b) : (lift2' z as bs)
    	lift2' _ _ _ = []

instance Rasters TeRaster where
	getValues (TeRaster rs) = rs
	setValues rs = (TeRaster rs)
	
instance Databases (TeRaster Double) TeDatabase String where
	retrieve db ln = do
		layer <- loadLayer db ln
		ptr <- getRaster layer
		-- convert to haskell object
		raster <- fromPointer ptr 
		return raster
					
	store db name rs = do
		l <- newCString name
		rsptr <- new rs
		teimportraster l rsptr db  
	    
		
getrasterLine :: TeRasterPtr -> Int32 -> Int32 -> Int32 -> [Double]
getrasterLine rs l c nc
	|c >= nc = [] 
	|otherwise = (getVal rs c l) : (getrasterLine rs l (c+1) nc)
	
getrasterLines :: TeRasterPtr ->  Int32 -> Int32 -> Int32 -> Int32 -> [[Double]]
getrasterLines rs l c nl nc
	|l >= nl = [] 
	|otherwise = (getrasterLine rs l c nc) : (getrasterLines rs (l+1) c nl nc)

	
setrasterLines :: [[Double]] -> TeRasterPtr ->  Int32 -> Int32 -> Prelude.IO ()
setrasterLines rs ptr l c = do 
	if ((length rs) > 0 ) then (setrasterLine (head rs) ptr l c ) >> (setrasterLines (tail rs) ptr (l+1) c )  else return ()


setrasterLine :: [Double] -> TeRasterPtr -> Int32 -> Int32 -> Prelude.IO ()
setrasterLine rs ptr l c = do
	if ((length rs) > 0 ) then (setVal ptr c l (head rs)) >> (setrasterLine (tail rs) ptr l (c+1)) else return ()
	
	
	
loadRasterFile :: String -> IO (TeRaster Double)
loadRasterFile  filename = do
		fn <- newCString filename 
		ptr <- new_teraster fn
		-- convert to haskell object
		st <- teraster_init ptr
		if (st) then (fromPointer ptr) else return (TeRaster [[]])

loadRaster db ln = do
		layer <- loadLayer db ln
		ptr <- getRaster layer
		-- convert to haskell object
		raster <- fromPointer ptr 
		return raster
	
	
saveRasterFile rs fn =  (newCString fn >>= \cfn -> new rs >>= \ters -> save_teraster ters cfn)


	
getRaster :: TeLayerPtr -> Prelude.IO TeRasterPtr
getRaster l = telayer_raster l	
	
importRaster :: TeDatabasePtr -> String 	-> (TeRaster Double) -> Prelude.IO Bool			
importRaster ptr ln	rs  = do
		l <- newCString ln
		rsptr <- new rs
		teimportraster l rsptr ptr  
		
importRasterWParameter :: TeDatabasePtr -> String -> Double -> (TeRaster Double) -> Prelude.IO Bool		
importRasterWParameter ptr ln dummy rs  = do
		l <- newCString ln
		rsptr <- new rs
		teraster_setdummy rsptr dummy
		teimportraster l rsptr ptr  

	
-- c calls

foreign import ccall unsafe  "c_save_teraster" save_teraster ::  TeRasterPtr -> CString -> Prelude.IO Bool

foreign import ccall  unsafe "c_teraster_nlines" nlines :: TeRasterPtr -> Int32
foreign import ccall  unsafe "c_teraster_ncols" ncols :: TeRasterPtr -> Int32
foreign import ccall  unsafe "c_teraster_get_element" getVal :: TeRasterPtr -> Int32 -> Int32 -> Double
foreign import ccall unsafe "c_new_teraster" new_teraster :: CString -> Prelude.IO TeRasterPtr 
foreign import ccall unsafe "c_teraster_init" teraster_init :: TeRasterPtr -> Prelude.IO Bool 
foreign import ccall unsafe "c_new_teraster2" new_teraster2 :: Int32 -> Int32 -> Prelude.IO TeRasterPtr 
foreign import ccall unsafe  "c_teraster_set_element" setVal :: TeRasterPtr -> Int32 -> Int32 -> Double -> Prelude.IO Bool
foreign import ccall unsafe "c_teraster_setdummy" teraster_setdummy :: TeRasterPtr -> Double -> Prelude.IO () 

foreign import ccall unsafe "c_telayer_raster"  telayer_raster :: TeLayerPtr -> Prelude.IO TeRasterPtr
foreign import ccall unsafe  "c_teimportraster" teimportraster ::  CString -> TeRasterPtr -> TeDatabasePtr -> Prelude.IO Bool 


--void c_teraster_setdummy (TeRaster *rs, double dummy);