iteratee-0.4.0: Examples/Tiff.hs
{-# LANGUAGE Rank2Types #-}
-- Random and Binary IO with IterateeM
-- A general-purpose TIFF library
-- The library gives the user the TIFF dictionary, which the user
-- can search for specific tags and obtain the values associated with
-- the tags, including the pixel matrix.
--
-- The overarching theme is incremental processing: initially,
-- only the TIFF dictionary is read. The value associated with a tag
-- is read only when that tag is looked up (unless the value was short
-- and was packed in the TIFF dictionary entry). The pixel matrix
-- (let alone the whole TIFF file) is not loaded in memory --
-- the pixel matrix is not even located before it is needed.
-- The matrix is processed incrementally, by a user-supplied
-- iteratee.
--
-- The incremental processing is accomplished by iteratees and enumerators.
-- The enumerators are indeed first-class, they are stored
-- in the interned TIFF dictionary data structure. These enumerators
-- represent the values associated with tags; the values will be read
-- on demand, when the enumerator is applied to a user-given iteratee.
--
-- The library extensively uses nested streams, tacitly converting the
-- stream of raw bytes from the file into streams of integers,
-- rationals and other user-friendly items. The pixel matrix is
-- presented as a contiguous stream, regardless of its segmentation
-- into strips and physical arrangement.
-- The library exhibits random IO and binary parsing, reading
-- of multi-byte numeric data in big- or little-endian formats.
-- The library can be easily adopted for AIFF, RIFF and other
-- IFF formats.
--
-- We show a representative application of the library: reading a sample
-- TIFF file, printing selected values from the TIFF dictionary,
-- verifying the values of selected pixels and computing the histogram
-- of pixel values. The pixel verification procedure stops reading the
-- pixel matrix as soon as all specified pixel values are verified.
-- The histogram accumulation does read the entire matrix, but
-- incrementally. Neither pixel matrix processing procedure loads
-- the whole matrix in memory. In fact, we never read and retain
-- more than the IO-buffer-full of raw data.
-- This TIFF library is to be contrasted with the corresponding Scheme
-- code:
-- http://okmij.org/ftp/Scheme/binary-io.html#tiff
-- The main distinction is using iteratees for on-demand processing.
module Data.Iteratee.Codecs.Tiff where
import Data.Iteratee
import qualified Data.Iteratee as Iter
import qualified Data.ListLike as LL
import Data.Iteratee.Binary
import Control.Monad
import Control.Monad.Trans
import Data.Char (chr)
import Data.Int
import Data.Word
import Data.Ratio
import Data.Maybe
import qualified Data.IntMap as IM
-- ========================================================================
-- Sample TIFF user code
-- The following is sample code using the TIFF library (whose implementation
-- is in the second part of this file).
-- Our sample code prints interesting information from the TIFF
-- dictionary (such as the dimensions, the resolution and the name
-- of the image)
-- The main user function. tiff_reader is the library function,
-- which builds the TIFF dictionary.
-- process_tiff is the user function, to extract useful data
-- from the dictionary
test_tiff :: FilePath -> IO ()
test_tiff = fileDriverRandom (tiff_reader >>= process_tiff)
-- Sample TIFF processing function
process_tiff :: MonadIO m => Maybe (IM.IntMap TIFFDE) ->
Iteratee [Word8] m ()
process_tiff Nothing = return ()
process_tiff (Just dict) = do
note ["dict size: ", show $ IM.size dict]
-- Check tag values against the known values for the sample image
check_tag TG_IMAGEWIDTH (flip dict_read_int dict) 129
check_tag TG_IMAGELENGTH (flip dict_read_int dict) 122
check_tag TG_BITSPERSAMPLE (flip dict_read_int dict) 8
check_tag TG_IMAGEDESCRIPTION (flip dict_read_string dict)
"JPEG:gnu-head-sm.jpg 129x122"
check_tag TG_COMPRESSION (flip dict_read_int dict) 1
check_tag TG_SAMPLESPERPIXEL (flip dict_read_int dict) 1
check_tag TG_STRIPBYTECOUNTS (flip dict_read_int dict) 15738 -- nrows*ncols
check_tag TG_XRESOLUTION (flip dict_read_rat dict) (72%1)
check_tag TG_YRESOLUTION (flip dict_read_rat dict) (72%1)
(n,hist) <- compute_hist dict
note ["computed histogram over ", show n, " values\n", show hist]
--iterReportError >>= maybe (return ()) error
note ["Verifying values of sample pixels"]
verify_pixel_vals dict [(0,255), (17,248)]
--err <- iterReportError
--maybe (return ()) error err
--return err
where check_tag tag action v = do
vc <- action tag
case vc of
Just v' | v' == v -> note ["Tag ",show tag, " value ", show v]
_ -> error $ unwords ["Tag", show tag, "unexpected:", show vc]
-- process_tiff Nothing = return Nothing
-- sample processing of the pixel matrix: computing the histogram
compute_hist :: MonadIO m =>
TIFFDict ->
Iteratee [Word8] m (Int,IM.IntMap Int)
compute_hist dict = Iter.joinI $ pixel_matrix_enum dict $ compute_hist' 0 IM.empty
where
--compute_hist' count = liftI . Cont . step count
compute_hist' count hist = icont (step count hist) Nothing
step count hist (Chunk ch)
| LL.null ch = icont (step count hist) Nothing
| otherwise = icont
(step (count + LL.length ch) (foldr accum hist ch))
Nothing
step count hist s = idone (count,hist) s
accum e = IM.insertWith (+) (fromIntegral e) 1
-- Another sample processor of the pixel matrix: verifying values of
-- some pixels
-- This processor does not read the whole matrix; it stops as soon
-- as everything is verified or the error is detected
verify_pixel_vals :: MonadIO m =>
TIFFDict -> [(IM.Key, Word8)] -> Iteratee [Word8] m ()
verify_pixel_vals dict pixels = Iter.joinI $ pixel_matrix_enum dict $
verify 0 (IM.fromList pixels)
where
verify _ m | IM.null m = return ()
verify n m = icont (step n m) Nothing
step n m (Chunk xs)
| LL.null xs = icont (step n m) Nothing
| otherwise = let (h, t) = (LL.head xs, LL.tail xs) in
case IM.updateLookupWithKey (\_k _e -> Nothing) n m of
(Just v,m') -> if v == h
then step (succ n) m' (Chunk t)
else let er = (unwords ["Pixel #",show n,
"expected:",show v,
"found", show h])
in icont (const . throwErr . iterStrExc $ er) (Just $ iterStrExc er)
(Nothing,m')-> step (succ n) m' (Chunk t)
step _n _m s = idone () s
-- ========================================================================
-- TIFF library code
-- A TIFF directory is a finite map associating a TIFF tag with
-- a record TIFFDE
type TIFFDict = IM.IntMap TIFFDE
data TIFFDE = TIFFDE{tiffde_count :: Int, -- number of items
tiffde_enum :: TIFFDE_ENUM -- enumerator to get values
}
type EnumeratorM sFrom sTo m a = Iteratee sTo m a -> m (Iteratee sFrom m a)
joinL :: (Monad m, Nullable s) => m (Iteratee s m a) -> Iteratee s m a
joinL = join . lift
data TIFFDE_ENUM =
TEN_CHAR (forall a m. Monad m => EnumeratorM [Word8] [Char] m a)
| TEN_BYTE (forall a m. Monad m => EnumeratorM [Word8] [Word8] m a)
| TEN_INT (forall a m. Monad m => EnumeratorM [Word8] [Int] m a)
| TEN_RAT (forall a m. Monad m => EnumeratorM [Word8] [Ratio Int] m a)
-- Standard TIFF data types
data TIFF_TYPE = TT_NONE -- 0
| TT_byte -- 1 8-bit unsigned integer
| TT_ascii -- 2 8-bit bytes with last byte null
| TT_short -- 3 16-bit unsigned integer
| TT_long -- 4 32-bit unsigned integer
| TT_rational -- 5 64-bit fractional (numer+denominator)
-- The following was added in TIFF 6.0
| TT_sbyte -- 6 8-bit signed (2s-complement) integer
| TT_undefined -- 7 An 8-bit byte, "8-bit chunk"
| TT_sshort -- 8 16-bit signed (2s-complement) integer
| TT_slong -- 9 32-bit signed (2s-complement) integer
| TT_srational -- 10 "signed rational", two SLONGs (num+denominator)
| TT_float -- 11 "IEEE 32-bit float", single precision (4-byte)
| TT_double -- 12 "IEEE 64-bit double", double precision (8-byte)
deriving (Eq, Enum, Ord, Bounded, Show)
-- Standard TIFF tags
data TIFF_TAG = TG_other Int -- other than below
| TG_SUBFILETYPE -- subfile data descriptor
| TG_OSUBFILETYPE -- +kind of data in subfile
| TG_IMAGEWIDTH -- image width in pixels
| TG_IMAGELENGTH -- image height in pixels
| TG_BITSPERSAMPLE -- bits per channel (sample)
| TG_COMPRESSION -- data compression technique
| TG_PHOTOMETRIC -- photometric interpretation
| TG_THRESHOLDING -- +thresholding used on data
| TG_CELLWIDTH -- +dithering matrix width
| TG_CELLLENGTH -- +dithering matrix height
| TG_FILLORDER -- +data order within a byte
| TG_DOCUMENTNAME -- name of doc. image is from
| TG_IMAGEDESCRIPTION -- info about image
| TG_MAKE -- scanner manufacturer name
| TG_MODEL -- scanner model name/number
| TG_STRIPOFFSETS -- offsets to data strips
| TG_ORIENTATION -- +image orientation
| TG_SAMPLESPERPIXEL -- samples per pixel
| TG_ROWSPERSTRIP -- rows per strip of data
| TG_STRIPBYTECOUNTS -- bytes counts for strips
| TG_MINSAMPLEVALUE -- +minimum sample value
| TG_MAXSAMPLEVALUE -- maximum sample value
| TG_XRESOLUTION -- pixels/resolution in x
| TG_YRESOLUTION -- pixels/resolution in y
| TG_PLANARCONFIG -- storage organization
| TG_PAGENAME -- page name image is from
| TG_XPOSITION -- x page offset of image lhs
| TG_YPOSITION -- y page offset of image lhs
| TG_FREEOFFSETS -- +byte offset to free block
| TG_FREEBYTECOUNTS -- +sizes of free blocks
| TG_GRAYRESPONSEUNIT -- gray scale curve accuracy
| TG_GRAYRESPONSECURVE -- gray scale response curve
| TG_GROUP3OPTIONS -- 32 flag bits
| TG_GROUP4OPTIONS -- 32 flag bits
| TG_RESOLUTIONUNIT -- units of resolutions
| TG_PAGENUMBER -- page numbers of multi-page
| TG_COLORRESPONSEUNIT -- color scale curve accuracy
| TG_COLORRESPONSECURVE -- RGB response curve
| TG_SOFTWARE -- name & release
| TG_DATETIME -- creation date and time
| TG_ARTIST -- creator of image
| TG_HOSTCOMPUTER -- machine where created
| TG_PREDICTOR -- prediction scheme w/ LZW
| TG_WHITEPOINT -- image white point
| TG_PRIMARYCHROMATICITIES -- primary chromaticities
| TG_COLORMAP -- RGB map for pallette image
| TG_BADFAXLINES -- lines w/ wrong pixel count
| TG_CLEANFAXDATA -- regenerated line info
| TG_CONSECUTIVEBADFAXLINES -- max consecutive bad lines
| TG_MATTEING -- alpha channel is present
deriving (Eq, Show)
tag_map :: Num t => [(TIFF_TAG, t)]
tag_map = [
(TG_SUBFILETYPE,254),
(TG_OSUBFILETYPE,255),
(TG_IMAGEWIDTH,256),
(TG_IMAGELENGTH,257),
(TG_BITSPERSAMPLE,258),
(TG_COMPRESSION,259),
(TG_PHOTOMETRIC,262),
(TG_THRESHOLDING,263),
(TG_CELLWIDTH,264),
(TG_CELLLENGTH,265),
(TG_FILLORDER,266),
(TG_DOCUMENTNAME,269),
(TG_IMAGEDESCRIPTION,270),
(TG_MAKE,271),
(TG_MODEL,272),
(TG_STRIPOFFSETS,273),
(TG_ORIENTATION,274),
(TG_SAMPLESPERPIXEL,277),
(TG_ROWSPERSTRIP,278),
(TG_STRIPBYTECOUNTS,279),
(TG_MINSAMPLEVALUE,280),
(TG_MAXSAMPLEVALUE,281),
(TG_XRESOLUTION,282),
(TG_YRESOLUTION,283),
(TG_PLANARCONFIG,284),
(TG_PAGENAME,285),
(TG_XPOSITION,286),
(TG_YPOSITION,287),
(TG_FREEOFFSETS,288),
(TG_FREEBYTECOUNTS,289),
(TG_GRAYRESPONSEUNIT,290),
(TG_GRAYRESPONSECURVE,291),
(TG_GROUP3OPTIONS,292),
(TG_GROUP4OPTIONS,293),
(TG_RESOLUTIONUNIT,296),
(TG_PAGENUMBER,297),
(TG_COLORRESPONSEUNIT,300),
(TG_COLORRESPONSECURVE,301),
(TG_SOFTWARE,305),
(TG_DATETIME,306),
(TG_ARTIST,315),
(TG_HOSTCOMPUTER,316),
(TG_PREDICTOR,317),
(TG_WHITEPOINT,318),
(TG_PRIMARYCHROMATICITIES,319),
(TG_COLORMAP,320),
(TG_BADFAXLINES,326),
(TG_CLEANFAXDATA,327),
(TG_CONSECUTIVEBADFAXLINES,328),
(TG_MATTEING,32995)
]
tag_map' :: IM.IntMap TIFF_TAG
tag_map' = IM.fromList $ map (\(tag,v) -> (v,tag)) tag_map
tag_to_int :: TIFF_TAG -> Int
tag_to_int (TG_other x) = x
tag_to_int x = fromMaybe (error $ "not found tag: " ++ show x) $ lookup x tag_map
int_to_tag :: Int -> TIFF_TAG
int_to_tag x = fromMaybe (TG_other x) $ IM.lookup x tag_map'
-- The library function to read the TIFF dictionary
tiff_reader :: Iteratee [Word8] IO (Maybe TIFFDict)
tiff_reader = do
endian <- read_magic
check_version
case endian of
Just e -> do
endianRead4 e >>= Iter.seek . fromIntegral
load_dict e
Nothing -> return Nothing
where
-- Read the magic and set the endianness
read_magic = do
c1 <- Iter.head
c2 <- Iter.head
case (c1,c2) of
(0x4d, 0x4d) -> return $ Just MSB
(0x49, 0x49) -> return $ Just LSB
_ -> (throwErr . iterStrExc $ "Bad TIFF magic word: " ++ show [c1,c2])
>> return Nothing
-- Check the version in the header. It is always ...
tiff_version = 42
check_version = do
v <- endianRead2 MSB
if v == tiff_version
then return ()
else throwErr (iterStrExc $ "Bad TIFF version: " ++ show v)
-- A few conversion procedures
u32_to_float :: Word32 -> Double
u32_to_float _x = -- unsigned 32-bit int -> IEEE float
error "u32->float is not yet implemented"
u32_to_s32 :: Word32 -> Int32 -- unsigned 32-bit int -> signed 32 bit
u32_to_s32 = fromIntegral
-- u32_to_s32 0x7fffffff == 0x7fffffff
-- u32_to_s32 0xffffffff == -1
u16_to_s16 :: Word16 -> Int16 -- unsigned 16-bit int -> signed 16 bit
u16_to_s16 = fromIntegral
-- u16_to_s16 32767 == 32767
-- u16_to_s16 32768 == -32768
-- u16_to_s16 65535 == -1
u8_to_s8 :: Word8 -> Int8 -- unsigned 8-bit int -> signed 8 bit
u8_to_s8 = fromIntegral
-- u8_to_s8 127 == 127
-- u8_to_s8 128 == -128
-- u8_to_s8 255 == -1
note :: (MonadIO m, Nullable s) => [String] -> Iteratee s m ()
note = liftIO . putStrLn . concat
-- An internal function to load the dictionary. It assumes that the stream
-- is positioned to read the dictionary
load_dict :: MonadIO m => Endian -> Iteratee [Word8] m (Maybe TIFFDict)
load_dict e = do
nentries <- endianRead2 e
dict <- foldr (const read_entry) (return (Just IM.empty)) [1..nentries]
next_dict <- endianRead4 e
when (next_dict > 0) $
note ["The TIFF file contains several images, ",
"only the first one will be considered"]
return dict
where
read_entry dictM = dictM >>=
maybe (return Nothing) (\dict -> do
tag <- endianRead2 e
typ' <- endianRead2 e
typ <- convert_type (fromIntegral typ')
count <- endianRead4 e
-- we read the val-offset later. We need to check the size and the type
-- of the datum, because val-offset may contain the value itself,
-- in its lower-numbered bytes, regardless of the big/little endian
-- order!
note ["TIFFEntry: tag ",show . int_to_tag . fromIntegral $ tag,
" type ", show typ, " count ", show count]
enum_m <- maybe (return Nothing)
(\t -> read_value t e (fromIntegral count)) typ
case enum_m of
Just enum ->
return . Just $ IM.insert (fromIntegral tag)
(TIFFDE (fromIntegral count) enum) dict
_ -> return (Just dict)
)
convert_type :: (Monad m, Nullable s) => Int -> Iteratee s m (Maybe TIFF_TYPE)
convert_type typ | typ > 0 && typ <= fromEnum (maxBound::TIFF_TYPE)
= return . Just . toEnum $ typ
convert_type typ = do
throwErr . iterStrExc $ "Bad type of entry: " ++ show typ
return Nothing
read_value :: MonadIO m => TIFF_TYPE -> Endian -> Int ->
Iteratee [Word8] m (Maybe TIFFDE_ENUM)
read_value typ e' 0 = do
endianRead4 e'
throwErr . iterStrExc $ "Zero count in the entry of type: " ++ show typ
return Nothing
-- Read an ascii string from the offset in the
-- dictionary. The last byte of
-- an ascii string is always zero, which is
-- included in 'count' but we don't need to read it
read_value TT_ascii e' count | count > 4 = do -- val-offset is offset
offset <- endianRead4 e'
return . Just . TEN_CHAR $ \iter_char -> return $ do
Iter.seek (fromIntegral offset)
let iter = convStream
(liftM ((:[]) . chr . fromIntegral) Iter.head)
iter_char
Iter.joinI $ Iter.joinI $ Iter.take (pred count) iter
-- Read the string of 0 to 3 characters long
-- The zero terminator is included in count, but
-- we don't need to read it
read_value TT_ascii _e count = do -- count is within 1..4
let len = pred count -- string length
let loop acc 0 = return . Just . reverse $ acc
loop acc n = Iter.head >>= (\v -> loop ((chr . fromIntegral $ v):acc)
(pred n))
str <- loop [] len
Iter.drop (4-len)
case str of
Just str' -> return . Just . TEN_CHAR $ immed_value str'
Nothing -> return Nothing
-- Read the array of signed or unsigned bytes
read_value typ e' count | count > 4 && typ == TT_byte || typ == TT_sbyte = do
offset <- endianRead4 e'
return . Just . TEN_INT $ \iter_int -> return $ do
Iter.seek (fromIntegral offset)
let iter = convStream
(liftM ((:[]) . conv_byte typ) Iter.head)
iter_int
Iter.joinI $ Iter.joinI $ Iter.take count iter
-- Read the array of 1 to 4 bytes
read_value typ _e count | typ == TT_byte || typ == TT_sbyte = do
let loop acc 0 = return . Just . reverse $ acc
loop acc n = Iter.head >>= (\v -> loop (conv_byte typ v:acc)
(pred n))
str <- (loop [] count)
Iter.drop (4-count)
case str of
Just str' -> return . Just . TEN_INT $ immed_value str'
Nothing -> return Nothing
-- Read the array of Word8
read_value TT_undefined e' count | count > 4 = do
offset <- endianRead4 e'
return . Just . TEN_BYTE $ \iter -> return $ do
Iter.seek (fromIntegral offset)
Iter.joinI $ Iter.take count iter
-- Read the array of Word8 of 1..4 elements,
-- packed in the offset field
read_value TT_undefined _e count = do
let loop acc 0 = return . Just . reverse $ acc
loop acc n = Iter.head >>= (\v -> loop (v:acc) (pred n))
str <- loop [] count
Iter.drop (4-count)
case str of
Just str' -> return . Just . TEN_BYTE $ immed_value str'
Nothing -> return Nothing
--return . Just . TEN_BYTE $ immed_value str
-- Read the array of short integers
-- of 1 element: the offset field contains the value
read_value typ e' 1 | typ == TT_short || typ == TT_sshort = do
item <- endianRead2 e'
Iter.drop 2 -- skip the padding
return . Just . TEN_INT $ immed_value [conv_short typ item]
-- of 2 elements: the offset field contains the value
read_value typ e' 2 | typ == TT_short || typ == TT_sshort = do
i1 <- endianRead2 e'
i2 <- endianRead2 e'
return . Just . TEN_INT $
immed_value [conv_short typ i1, conv_short typ i2]
-- of n elements
read_value typ e' count | typ == TT_short || typ == TT_sshort = do
offset <- endianRead4 e'
return . Just . TEN_INT $ \iter_int -> return $ do
Iter.seek (fromIntegral offset)
let iter = convStream
(liftM ((:[]) . conv_short typ) (endianRead2 e'))
iter_int
Iter.joinI $ Iter.joinI $ Iter.take (2*count) iter
-- Read the array of long integers
-- of 1 element: the offset field contains the value
read_value typ e' 1 | typ == TT_long || typ == TT_slong = do
item <- endianRead4 e'
return . Just . TEN_INT $ immed_value [conv_long typ item]
-- of n elements
read_value typ e' count | typ == TT_long || typ == TT_slong = do
offset <- endianRead4 e'
return . Just . TEN_INT $ \iter_int -> return $ do
Iter.seek (fromIntegral offset)
let iter = convStream
(liftM ((:[]) . conv_long typ) (endianRead4 e'))
iter_int
Iter.joinI $ Iter.joinI $ Iter.take (4*count) iter
read_value typ e' count = do -- stub
_offset <- endianRead4 e'
note ["unhandled type: ", show typ, " with count ", show count]
return Nothing
immed_value :: (Monad m) => [el] -> EnumeratorM [Word8] [el] m a
immed_value item iter =
--(Iter.enumPure1Chunk item >. enumEof) iter >>== Iter.joinI . return
return . joinI . return . joinIM $ (enumPure1Chunk item >>> enumEof) iter
conv_byte :: TIFF_TYPE -> Word8 -> Int
conv_byte TT_byte = fromIntegral
conv_byte TT_sbyte = fromIntegral . u8_to_s8
conv_byte _ = error "conv_byte called with non-byte type"
conv_short :: TIFF_TYPE -> Word16 -> Int
conv_short TT_short = fromIntegral
conv_short TT_sshort = fromIntegral . u16_to_s16
conv_short _ = error "conv_short called with non-short type"
conv_long :: TIFF_TYPE -> Word32 -> Int
conv_long TT_long = fromIntegral
conv_long TT_slong = fromIntegral . u32_to_s32
conv_long _ = error "conv_long called with non-long type"
-- Reading the pixel matrix
-- For simplicity, we assume no compression and 8-bit pixels
pixel_matrix_enum :: MonadIO m => TIFFDict -> Enumeratee [Word8] [Word8] m a
pixel_matrix_enum dict iter = validate_dict >>= proceed
where
-- Make sure we can handle this particular TIFF image
validate_dict = do
dict_assert TG_COMPRESSION 1
dict_assert TG_SAMPLESPERPIXEL 1
dict_assert TG_BITSPERSAMPLE 8
ncols <- liftM (fromMaybe 0) $ dict_read_int TG_IMAGEWIDTH dict
nrows <- liftM (fromMaybe 0) $ dict_read_int TG_IMAGELENGTH dict
strip_offsets <- liftM (fromMaybe [0]) $
dict_read_ints TG_STRIPOFFSETS dict
rps <- liftM (fromMaybe nrows) (dict_read_int TG_ROWSPERSTRIP dict)
if ncols > 0 && nrows > 0 && rps > 0
then return $ Just (ncols,nrows,rps,strip_offsets)
else return Nothing
dict_assert tag v = do
vfound <- dict_read_int tag dict
case vfound of
Just v' | v' == v -> return $ Just ()
_ -> throwErr (iterStrExc (unwords ["dict_assert: tag:", show tag,
"expected:", show v, "found:", show vfound])) >>
return Nothing
proceed Nothing = throwErr $ iterStrExc "Can't handle this TIFF"
proceed (Just (ncols,nrows,rows_per_strip,strip_offsets)) = do
let strip_size = rows_per_strip * ncols
image_size = nrows * ncols
note ["Processing the pixel matrix, ", show image_size, " bytes"]
let loop _pos [] iter' = return iter'
loop pos (strip:strips) iter' = do
Iter.seek (fromIntegral strip)
let len = min strip_size (image_size - pos)
iter'' <- Iter.take (fromIntegral len) iter'
loop (pos+len) strips iter''
loop 0 strip_offsets iter
-- A few helpers for getting data from TIFF dictionary
dict_read_int :: Monad m => TIFF_TAG -> TIFFDict ->
Iteratee [Word8] m (Maybe Int)
dict_read_int tag dict = do
els <- dict_read_ints tag dict
case els of
Just (e:_) -> return $ Just e
_ -> return Nothing
dict_read_ints :: Monad m => TIFF_TAG -> TIFFDict ->
Iteratee [Word8] m (Maybe [Int])
dict_read_ints tag dict =
case IM.lookup (tag_to_int tag) dict of
Just (TIFFDE _ (TEN_INT enum)) -> do
e <- joinL $ enum stream2list
return (Just e)
_ -> return Nothing
dict_read_rat :: Monad m => TIFF_TAG -> TIFFDict ->
Iteratee [Word8] m (Maybe (Ratio Int))
dict_read_rat tag dict =
case IM.lookup (tag_to_int tag) dict of
Just (TIFFDE 1 (TEN_RAT enum)) -> do
[e] <- joinL $ enum stream2list
return (Just e)
_ -> return Nothing
dict_read_string :: Monad m => TIFF_TAG -> TIFFDict ->
Iteratee [Word8] m (Maybe String)
dict_read_string tag dict =
case IM.lookup (tag_to_int tag) dict of
Just (TIFFDE _ (TEN_CHAR enum)) -> do
e <- joinL $ enum stream2list
return (Just e)
_ -> return Nothing