{-- 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 - -} module TerraHS.TerraLib.TeRaster where import System.IO.Unsafe import Foreign import Foreign.C.String import qualified Foreign.Ptr (Ptr) import TerraHS.Misc.Object import TerraHS.Misc.Generic import Algebras.Functor.Category -- 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' _ _ _ = [] --fmap2 :: (a -> a) -> (TeRaster a) -> (TeRaster a) --fmap2 g (TeRaster (rs)) = (TeRaster ( (Prelude.map g rs))) --instance Funct (TeRaster) where -- lift1 g (TeRaster rs1) = (TeRaster (Prelude.map g rs1)) --lift2 g (TeRaster rs1) (TeRaster rs2) = (TeRaster (Prelude.zipWith g rs1 rs2)) 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 [[]]) -- c calls foreign import stdcall unsafe "c_teraster_nlines" nlines :: TeRasterPtr -> Int32 foreign import stdcall unsafe "c_teraster_ncols" ncols :: TeRasterPtr -> Int32 foreign import stdcall unsafe "c_teraster_get_element" getVal :: TeRasterPtr -> Int32 -> Int32 -> Double foreign import stdcall unsafe "c_new_teraster" new_teraster :: CString -> Prelude.IO TeRasterPtr foreign import stdcall unsafe "c_teraster_init" teraster_init :: TeRasterPtr -> Prelude.IO Bool foreign import stdcall unsafe "c_new_teraster2" new_teraster2 :: Int32 -> Int32 -> Prelude.IO TeRasterPtr foreign import stdcall unsafe "c_teraster_set_element" setVal :: TeRasterPtr -> Int32 -> Int32 -> Double -> Prelude.IO Bool foreign import stdcall unsafe "c_teraster_setdummy" teraster_setdummy :: TeRasterPtr -> Double -> Prelude.IO () --void c_teraster_setdummy (TeRaster *rs, double dummy);