{-# 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.Base (StreamG (..), IterateeG (..), IterateeGM, EnumeratorGMM, EnumeratorN, bindm, liftI, (==<<), (>.), (>>==), iterErr, enumErr, convStream, iterReportError, enumEof)
import qualified Data.Iteratee.Base as Iter
import qualified Data.Iteratee.Base.StreamChunk as SC
import Data.Iteratee.Binary
import Control.Monad.State
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 :: IO (Maybe String)
-- test_tiff = test_driver_random (tiff_reader >>= process_tiff) "filename.tiff"

-- Sample TIFF processing function
process_tiff :: MonadIO m => Maybe (IM.IntMap TIFFDE) ->
  IterateeGM [] Word8 m (Maybe String)
process_tiff Nothing = return $ Just "No dictionary"
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 ->
                IterateeGM [] 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
 step count hist (Chunk ch)
   | SC.null ch  = compute_hist' count hist
   | otherwise = compute_hist' (count + SC.length ch) (foldr accum hist ch)
 step count hist s        = liftI $ Done (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)] -> IterateeGM [] 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 = liftI $ Cont (step n m)
 step n m (Chunk xs)
   | SC.null xs = verify n m
   | otherwise = let (h, t) = (SC.head xs, SC.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 iterErr $ unwords ["Pixel #",show n,
					      "expected:",show v,
					      "found", show h]
    (Nothing,m')->    step (succ n) m' (Chunk t)
 step _n _m s = liftI $ Done () 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
		    }

data TIFFDE_ENUM =
  TEN_CHAR (forall a m. Monad m => EnumeratorGMM [] Word8 [] Char m a)
  | TEN_BYTE (forall a m. Monad m => EnumeratorGMM [] Word8 [] Word8 m a)
  | TEN_INT  (forall a m. Monad m => EnumeratorGMM [] Word8 [] Int m a)
  | TEN_RAT  (forall a m. Monad m => EnumeratorGMM [] 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 :: IterateeGM [] Word8 IO (Maybe TIFFDict)
tiff_reader = do
  endian <- read_magic
  check_version
  case endian of
    Just e -> bindm (endian_read4 e) $ \dict_offset -> do
              Iter.seek (fromIntegral dict_offset)
              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
      (Just 0x4d, Just 0x4d) -> return $ Just MSB
      (Just 0x49, Just 0x49) -> return $ Just LSB
      _ -> (iterErr $ "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 <- endian_read2 MSB
     case v of
      Just v' | v' == tiff_version -> return ()
      _ -> iterErr $ "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) => [String] -> IterateeGM [] el m ()
note = lift . 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 -> IterateeGM [] Word8 m (Maybe TIFFDict)
load_dict e =
  bindm (endian_read2 e) $ \nentries -> do
   dict <- foldr (const read_entry) (return (Just IM.empty)) [1..nentries]
   bindm (endian_read4 e) $ \next_dict -> do
   when (next_dict > 0) $
      note ["The TIFF file contains several images, ",
	         "only the first one will be considered"]
   return dict
 where
  read_entry dictM =
    bindm dictM $ \dict ->
     bindm (endian_read2 e) $ \tag ->    
     bindm (endian_read2 e) $ \typ' ->    
     bindm (convert_type (fromIntegral typ')) $ \typ ->    
     bindm (endian_read4 e) $ \count -> do
      -- 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 <- read_value typ e (fromIntegral count)
     case enum_m of
      Just enum ->
       return . Just $ IM.insert (fromIntegral tag) 
		                 (TIFFDE (fromIntegral count) enum) dict
      _ -> return (Just dict)

  convert_type :: (Monad m) => Int -> IterateeGM [] el m (Maybe TIFF_TYPE)
  convert_type typ | typ > 0 && typ <= fromEnum (maxBound::TIFF_TYPE)
      = return . Just . toEnum $ typ
  convert_type typ = do
      iterErr $ "Bad type of entry: " ++ show typ
      return Nothing

  read_value :: MonadIO m => TIFF_TYPE -> Endian -> Int -> 
                IterateeGM [] Word8 m (Maybe TIFFDE_ENUM)

  read_value typ e' 0 =
    bindm (endian_read4 e') $ \_offset -> do
      iterErr $ "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 = -- for sure, val-offset is offset
    bindm (endian_read4 e') $ \offset ->
      return . Just . TEN_CHAR $ \iter_char -> do
            Iter.seek (fromIntegral offset)
            let iter = convStream 
                         (bindm Iter.head (return. Just .(:[]). chr . fromIntegral))
                         iter_char
            Iter.joinI $ Iter.joinI $ Iter.takeR (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 = bindm Iter.head (\v -> loop ((chr . fromIntegral $ v):acc)
                                             (pred n))
    bindm (loop [] len) $ \str -> do
      Iter.drop (4-len)
      return . Just . TEN_CHAR $ immed_value str

			-- Read the array of signed or unsigned bytes
  read_value typ e' count | count > 4 && typ == TT_byte || typ == TT_sbyte =
    bindm (endian_read4 e') $ \offset ->
      return . Just . TEN_INT $ \iter_int -> do
            Iter.seek (fromIntegral offset)
            let iter = convStream 
                         (bindm Iter.head (return . Just . (:[]) . conv_byte typ))
                         iter_int
            Iter.joinI $ Iter.joinI $ Iter.takeR 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 = bindm Iter.head (\v -> loop (conv_byte typ v:acc)
                                             (pred n))
    bindm (loop [] count) $ \str -> do
      Iter.drop (4-count)
      return . Just . TEN_INT $ immed_value str

			-- Read the array of Word8
  read_value TT_undefined e' count | count > 4 =
    bindm (endian_read4 e') $ \offset ->
      return . Just . TEN_BYTE $ \iter -> do
            Iter.seek (fromIntegral offset)
            Iter.joinI $ Iter.takeR 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 = bindm Iter.head (\v -> loop (v:acc) (pred n))
    bindm (loop [] count) $ \str -> do
      Iter.drop (4-count)
      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 =
    bindm (endian_read2 e') $ \item -> do
      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 =
    bindm (endian_read2 e') $ \i1 -> 
     bindm (endian_read2 e') $ \i2 ->
      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 =
    bindm (endian_read4 e') $ \offset ->
      return . Just . TEN_INT $ \iter_int -> do
            Iter.seek (fromIntegral offset)
            let iter = convStream 
                         (bindm (endian_read2 e') 
			  (return . Just . (:[]) . conv_short typ))
                         iter_int
            Iter.joinI $ Iter.joinI $ Iter.takeR (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 =
    bindm (endian_read4 e') $ \item ->
      return . Just . TEN_INT $ immed_value [conv_long typ item]

			-- of n elements
  read_value typ e' count | typ == TT_long || typ == TT_slong =
    bindm (endian_read4 e') $ \offset ->
      return . Just . TEN_INT $ \iter_int -> do
            Iter.seek (fromIntegral offset)
            let iter = convStream 
                         (bindm (endian_read4 e')  
			  (return . Just . (:[]) . conv_long typ))
                         iter_int
            Iter.joinI $ Iter.joinI $ Iter.takeR (4*count) ==<< iter

			-- Read the array of rationals. A rational can't
			-- be packed into the offset field
{-
  read_value typ e count | typ == TT_rational || typ == TT_srational = do 
    bindm (endian_read4 e) $ \offset ->
      return . Just . TEN_RAT $ \iter_rat -> do
            Iter.seek (fromIntegral offset)
            let iter = convStream 
                         (bindm (endian_read4 e) $ \i1 ->
			   bindm (endian_read4 e) $ \i2 ->
			    (return . Just . (:[]) $ conv_rat typ i1 i2))
                         iter_rat
            Iter.joinI $ Iter.joinI $ Iter.takeR (8*count) ==<< iter
-}


  read_value typ e' count = -- stub
    bindm (endian_read4 e') $ \_offset -> do
     note ["unhandled type: ", show typ, " with count ", show count]
     return Nothing

  immed_value :: (Monad m) => [el] -> EnumeratorGMM [] Word8 [] el m a
  immed_value item iter =
     (Iter.enumPure1Chunk item >. enumEof) iter >>== Iter.joinI . return

  conv_byte :: TIFF_TYPE -> Word8 -> Int
  conv_byte TT_byte  = fromIntegral
  conv_byte TT_sbyte = fromIntegral . u8_to_s8
  conv_byte _ = error "This should never happen"

  conv_short :: TIFF_TYPE -> Word16 -> Int
  conv_short TT_short  = fromIntegral
  conv_short TT_sshort = fromIntegral . u16_to_s16
  conv_short _ = error "This should never happen"

  conv_long :: TIFF_TYPE -> Word32 -> Int
  conv_long TT_long  = fromIntegral
  conv_long TT_slong = fromIntegral . u32_to_s32
  conv_long _ = error "This should never happen"

{- this code is never used...
  conv_rat :: TIFF_TYPE -> Word32 -> Word32 -> Rational
  conv_rat TT_rational v1 v2 = (fromIntegral v1) % (fromIntegral v2)
  conv_rat TT_srational v1 v2 = (fromIntegral (u32_to_s32 v1)) % 
				(fromIntegral (u32_to_s32 v2))
  conv_rat _tt _ _ = error "This should never happen"
-}

-- Reading the pixel matrix
-- For simplicity, we assume no compression and 8-bit pixels
pixel_matrix_enum :: MonadIO m => TIFFDict -> EnumeratorN [] Word8 [] Word8 m a
pixel_matrix_enum dict iter = validate_dict >>= proceed
 where
   -- Make sure we can handle this particular TIFF image
   validate_dict =
      dict_assert TG_COMPRESSION 1         `bindm`  \() ->
      dict_assert TG_SAMPLESPERPIXEL 1    `bindm`  \() ->
      dict_assert TG_BITSPERSAMPLE 8      `bindm`  \() ->
      dict_read_int TG_IMAGEWIDTH dict    `bindm`  \ncols ->
      dict_read_int TG_IMAGELENGTH dict   `bindm`  \nrows ->
      dict_read_ints TG_STRIPOFFSETS dict `bindm`  \strip_offsets -> do
        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 ()
	_ -> iterErr (unwords ["dict_assert: tag:", show tag,
				"expected:", show v, "found:", show vfound]) >>
             return Nothing

   proceed Nothing = enumErr "Can't handle this TIFF" iter >>== return

   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'@Done{} = return iter'
         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.takeR (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 ->
                 IterateeGM [] 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 -> 
		  IterateeGM [] 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 <- enum  ==<< Iter.stream2list
	     return (Just e)
      _ -> return Nothing

dict_read_rat :: Monad m => TIFF_TAG -> TIFFDict ->
                 IterateeGM [] 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] <- enum  ==<< Iter.stream2list
	     return (Just e)
      _ -> return Nothing

dict_read_string :: Monad m => TIFF_TAG -> TIFFDict ->
                    IterateeGM [] 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 <- enum  ==<< Iter.stream2list
	     return (Just e)
      _ -> return Nothing