module Data.Bitmap.IO.File
( readBitmap
, writeBitmap
, readRawData
, writeRawData
, hPutHeader
, hPutRawData
, hGetHeader
, hGetRawData
)
where
import Control.Monad
import System.IO
import Foreign.C
import Foreign.Ptr
import Foreign.ForeignPtr
import Foreign.Storable
import Foreign.Marshal
import Data.Int
import Data.Bitmap.Base
import Data.Bitmap.Internal
import Data.Bitmap.IO
readBitmap :: PixelComponent t => FilePath -> IO (IOBitmap t)
readBitmap fpath = do
h <- openFile fpath ReadMode
header <- hGetHeader h
bitmap <- hGetRawData h header
hClose h
return bitmap
readRawData :: PixelComponent t => FilePath -> (Size,NChn,PixelComponentType) -> IO (IOBitmap t)
readRawData fpath header = do
h <- openFile fpath ReadMode
bitmap <- hGetRawData h header
hClose h
return bitmap
writeBitmap :: PixelComponent t => FilePath -> IOBitmap t -> IO ()
writeBitmap fpath bm = do
h <- openFile fpath WriteMode
hPutHeader h bm
hPutRawData h bm
hClose h
writeRawData :: PixelComponent t => FilePath -> IOBitmap t -> IO ()
writeRawData fpath bm = do
h <- openFile fpath WriteMode
hPutRawData h bm
hClose h
hPutHeader :: PixelComponent t => Handle -> IOBitmap t -> IO ()
hPutHeader h bm = do
let (xsize,ysize) = bitmapSize bm
nchn = bitmapNChannels bm
typ = bitmapCType bm
with (fromIntegral xsize :: Int32) $ \p -> hPutBuf h p 4
with (fromIntegral ysize :: Int32) $ \p -> hPutBuf h p 4
with (fromIntegral nchn :: Int32) $ \p -> hPutBuf h p 4
with (fromIntegral typ :: Int32) $ \p -> hPutBuf h p 4
hPutRawData :: PixelComponent t => Handle -> IOBitmap t -> IO ()
hPutRawData h bm =
withIOBitmap bm $ \(xres,yres) nchn padding ptr -> do
forM_ [0..yres1] $ \k -> do
let q = ptr `plusPtr` (k*long)
hPutBuf h q short
where
long = bitmapPaddedRowSizeInBytes bm
short = bitmapUnpaddedRowSizeInBytes bm
hGetRawData :: PixelComponent t => Handle -> (Size,NChn,PixelComponentType) -> IO (IOBitmap t)
hGetRawData h (siz,nchn,pct) = do
bm <- newIOBitmapUninitialized siz nchn (Just 1)
if bitmapComponentType bm /= pct
then error "bitmap/getRawData: bitmap component type does not match"
else do
withIOBitmap bm $ \(_,ysiz) _ _ ptr -> do
let n = ysiz * bitmapUnpaddedRowSizeInBytes bm
k <- hGetBuf h ptr n
when (k/=n) $ error "bitmap/getRawData: not enough data"
return bm
hGetHeader :: Handle -> IO (Size,NChn,PixelComponentType)
hGetHeader h = do
xsize <- loadInt32
ysize <- loadInt32
nchn <- loadInt32
ctyp <- loadInt32
return
( (fromIntegral xsize, fromIntegral ysize)
, fromIntegral nchn
, decodeCType (fromIntegral ctyp)
)
where
loadInt32 :: IO Int32
loadInt32 = alloca $ \p -> do
hGetBuf h p 4
peek p