-- | Reading and writing uncompressed BMP files.
--
--   Supports uncompressed 24bit RGB and 32bit RGBA
--      WindowsV3, WindowsV4 and WindowsV5 formats.
-- 
--   We don't support the plain OS/2 BitmapCoreHeader
--       and BitmapCoreHeader2 image headers, but I haven't yet seen one of
--       these in the wild.
-- 
-- To write a file do something like:
--
--  > do let rgba   = Data.ByteString.pack [some list of Word8s]
--  >    let bmp    = packRGBA32ToBMP width height rgba
--  >    writeBMP fileName bmp
--
-- To read a file do something like:
--
--  > do Right bmp  <- readBMP fileName
--  >    let rgba   =  unpackBMPToRGBA32 bmp
--  >    let (width, height) = bmpDimensions bmp
--  >    ... 
--      
-- Release Notes:
--
--  >  * bmp 1.2.5
--  >    Add support for writing uncompressed 32-bit files.
--  >
--  >  * bmp 1.2.4
--  >    Update to use binary 0.6.
--  >
--  >  * bmp 1.2.3
--  >    Add pure parseBMP / renderBMP API.
--  >
--  >  * bmp 1.2.2
--  >    Allow the physical image buffer to be larger than the image
--  >     size stated in the header, to accept output of foolish Win7 codec.
--
module Codec.BMP
        ( -- * Data Structures
          BMP             (..)
        , FileHeader      (..)
        , BitmapInfo      (..)
        , BitmapInfoV3    (..)
        , BitmapInfoV4    (..)
        , BitmapInfoV5    (..)
        , Compression     (..)
        , CIEXYZ          (..)
        , Error           (..)

          -- * Reading
        , readBMP,  hGetBMP, parseBMP

          -- * Writing
        , writeBMP, hPutBMP, renderBMP

          -- * Pack and Unpack
        , packRGBA32ToBMP
        , packRGBA32ToBMP32
        , packRGBA32ToBMP24
        , unpackBMPToRGBA32
        , bmpDimensions)
where
import Codec.BMP.Base
import Codec.BMP.Error
import Codec.BMP.Unpack
import Codec.BMP.Pack
import Codec.BMP.FileHeader
import Codec.BMP.BitmapInfo
import Codec.BMP.BitmapInfoV3
import Codec.BMP.BitmapInfoV4
import Codec.BMP.BitmapInfoV5
import System.IO
import Data.ByteString.Lazy     as BSL
import Data.Binary
import Data.Binary.Get

-- Reading --------------------------------------------------------------------
-- | Read a BMP from a file.
--      The file is checked for problems and unsupported features when read.
--      If there is anything wrong this gives an `Error` instead.
readBMP :: FilePath -> IO (Either Error BMP)
readBMP fileName
 = do   h       <- openBinaryFile fileName ReadMode
        hGetBMP h
        
-- | Get a BMP image from a file handle.
hGetBMP :: Handle -> IO (Either Error BMP)
hGetBMP h
 = do   -- lazily load the whole file
        buf     <- BSL.hGetContents h
        return $ parseBMP buf


-- | Parse a BMP image from a lazy `ByteString`
parseBMP :: BSL.ByteString -> Either Error BMP
parseBMP buf
 = let  -- split off the file header
        (bufFileHeader, bufRest) 
               = BSL.splitAt (fromIntegral sizeOfFileHeader) buf

   in   if (fromIntegral $ BSL.length bufFileHeader) /= sizeOfFileHeader
         then   Left ErrorFileHeaderTruncated
         else   parseBMP2 bufRest (decode bufFileHeader)
        
parseBMP2 buf fileHeader
 -- Check the magic before doing anything else.
 | fileHeaderType fileHeader /= bmpMagic
 = Left $ ErrorBadMagic (fileHeaderType fileHeader)
        
 | otherwise
 = let  -- Next comes the image header. 
        -- The first word tells us how long it is.
        sizeHeader      = runGet getWord32le buf
        
        -- split off the image header
        (bufImageHeader, bufRest)
                = BSL.splitAt (fromIntegral sizeHeader) buf
        
        -- How much non-header data is present in the file.
        -- For uncompressed data without a colour table, the remaining data
        -- should be the image, but there may also be padding bytes on the
        -- end.
        physicalBufferSize
                = (fromIntegral $ BSL.length bufRest) :: Word32

   in if (fromIntegral $ BSL.length bufImageHeader) /= sizeHeader
         then   Left ErrorImageHeaderTruncated
         else   parseBMP3 fileHeader bufImageHeader bufRest physicalBufferSize


parseBMP3 fileHeader bufImageHeader bufRest physicalBufferSize
        | BSL.length bufImageHeader == 40 
        = let info      = decode bufImageHeader
          in  case checkBitmapInfoV3 info physicalBufferSize of
                 Just err       -> Left err
                 Nothing
                  |  Just imageSize      <- imageSizeFromBitmapInfoV3 info
                  -> parseBMP4 fileHeader (InfoV3 info) bufRest imageSize

                  |  otherwise
                  -> Left $ ErrorInternalErrorPleaseReport

        | BSL.length bufImageHeader == 108
        = let info      = decode bufImageHeader
          in  case checkBitmapInfoV4 info physicalBufferSize of
                 Just err       -> Left err
                 Nothing        
                  | Just imageSize      <- imageSizeFromBitmapInfoV4 info
                  -> parseBMP4 fileHeader (InfoV4 info) bufRest imageSize

                  | otherwise
                  -> Left $ ErrorInternalErrorPleaseReport
                
        | BSL.length bufImageHeader == 124
        = let info      = decode bufImageHeader
          in  case checkBitmapInfoV5 info physicalBufferSize of
                 Just err       -> Left err
                 Nothing        
                  | Just imageSize      <- imageSizeFromBitmapInfoV5 info
                  -> parseBMP4 fileHeader (InfoV5 info) bufRest imageSize

                  | otherwise
                  -> Left $ ErrorInternalErrorPleaseReport
                
        | otherwise
        = Left $ ErrorUnhandledBitmapHeaderSize 
               $ fromIntegral $ BSL.length bufImageHeader


parseBMP4 fileHeader imageHeader bufImage (sizeImage :: Int)
 = let  bufLen  = fromIntegral $ BSL.length bufImage
   in   if bufLen < sizeImage
         then Left $ ErrorImageDataTruncated sizeImage bufLen
         else Right $ BMP 
                { bmpFileHeader         = fileHeader
                , bmpBitmapInfo         = imageHeader
                , bmpRawImageData       = BSL.toStrict bufImage }


-- Writing --------------------------------------------------------------------
-- | Wrapper for `hPutBMP`
writeBMP :: FilePath -> BMP -> IO ()
writeBMP fileName bmp
 = do   h       <- openBinaryFile fileName WriteMode
        hPutBMP h bmp
        hFlush h
        hClose h


-- | Put a BMP image to a file handle.
hPutBMP :: Handle -> BMP -> IO ()
hPutBMP h bmp
        = BSL.hPut h (renderBMP bmp)


-- | Render a BMP image to a lazy `ByteString`.
renderBMP :: BMP -> BSL.ByteString
renderBMP bmp
        = BSL.append    (encode $ bmpFileHeader bmp)
        $ BSL.append    (encode $ bmpBitmapInfo bmp)
        $ BSL.fromStrict (bmpRawImageData bmp) 


-- | Get the width and height of an image.
--      It's better to use this function than to access the headers directly.
bmpDimensions :: BMP -> (Int, Int)
bmpDimensions bmp       
 = let  info    = getBitmapInfoV3 $ bmpBitmapInfo bmp
   in   ( fromIntegral $ dib3Width info
        , fromIntegral $ dib3Height info)