-- | 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		as BS
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	= BS.concat $ BSL.toChunks 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)