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
type Grd a = [[a]]
data TeRaster a = TeRaster (Grd a) deriving (Show)
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' _ _ _ = []
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
st <- teraster_init ptr
if (st) then (fromPointer ptr) else return (TeRaster [[]])
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 ()