module TerraHS.TerraLib.TeRaster where
import System.IO.Unsafe
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
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' _ _ _ = []
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
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
st <- teraster_init ptr
if (st) then (fromPointer ptr) else return (TeRaster [[]])
loadRaster db ln = do
layer <- loadLayer db ln
ptr <- getRaster layer
raster <- fromPointer ptr
return raster
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
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 ()
foreign import stdcall unsafe "c_telayer_raster" telayer_raster :: TeLayerPtr -> Prelude.IO TeRasterPtr
foreign import stdcall unsafe "c_teimportraster" teimportraster :: CString -> TeRasterPtr -> TeDatabasePtr -> Prelude.IO Bool