{-# OPTIONS_HADDOCK hide #-}
module Codec.BMP.BitmapInfo
        ( BitmapInfo    (..)
        , getBitmapInfoV3)
where

import Codec.BMP.BitmapInfoV3
import Codec.BMP.BitmapInfoV4
import Codec.BMP.BitmapInfoV5
import Control.Applicative 
import Data.Binary
import Data.Binary.Get


-- | A wrapper for the various image header types.
--   
data BitmapInfo
        = InfoV3 BitmapInfoV3
        | InfoV4 BitmapInfoV4
        | InfoV5 BitmapInfoV5
        deriving (Int -> BitmapInfo -> ShowS
[BitmapInfo] -> ShowS
BitmapInfo -> String
(Int -> BitmapInfo -> ShowS)
-> (BitmapInfo -> String)
-> ([BitmapInfo] -> ShowS)
-> Show BitmapInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BitmapInfo -> ShowS
showsPrec :: Int -> BitmapInfo -> ShowS
$cshow :: BitmapInfo -> String
show :: BitmapInfo -> String
$cshowList :: [BitmapInfo] -> ShowS
showList :: [BitmapInfo] -> ShowS
Show)


instance Binary BitmapInfo where
 get :: Get BitmapInfo
get = 
  (do Word32
40 <- Get Word32
getWord32le
      BitmapInfoV3
info <- Get BitmapInfoV3
forall t. Binary t => Get t
get
      BitmapInfo -> Get BitmapInfo
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (BitmapInfo -> Get BitmapInfo) -> BitmapInfo -> Get BitmapInfo
forall a b. (a -> b) -> a -> b
$ BitmapInfoV3 -> BitmapInfo
InfoV3 BitmapInfoV3
info)
  Get BitmapInfo -> Get BitmapInfo -> Get BitmapInfo
forall a. Get a -> Get a -> Get a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  (do Word32
108 <- Get Word32
getWord32le
      BitmapInfoV4
info <- Get BitmapInfoV4
forall t. Binary t => Get t
get
      BitmapInfo -> Get BitmapInfo
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (BitmapInfo -> Get BitmapInfo) -> BitmapInfo -> Get BitmapInfo
forall a b. (a -> b) -> a -> b
$ BitmapInfoV4 -> BitmapInfo
InfoV4 BitmapInfoV4
info)
  Get BitmapInfo -> Get BitmapInfo -> Get BitmapInfo
forall a. Get a -> Get a -> Get a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  (do Word32
120 <- Get Word32
getWord32le
      BitmapInfoV5
info <- Get BitmapInfoV5
forall t. Binary t => Get t
get
      BitmapInfo -> Get BitmapInfo
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (BitmapInfo -> Get BitmapInfo) -> BitmapInfo -> Get BitmapInfo
forall a b. (a -> b) -> a -> b
$ BitmapInfoV5 -> BitmapInfo
InfoV5 BitmapInfoV5
info)
  Get BitmapInfo -> Get BitmapInfo -> Get BitmapInfo
forall a. Get a -> Get a -> Get a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> 
  (String -> Get BitmapInfo
forall a. HasCallStack => String -> a
error String
"Codec.BMP.BitmapInfo.get: unhandled header size")
        
 put :: BitmapInfo -> Put
put BitmapInfo
xx
  = case BitmapInfo
xx of
        InfoV3 BitmapInfoV3
info     -> BitmapInfoV3 -> Put
forall t. Binary t => t -> Put
put BitmapInfoV3
info
        InfoV4 BitmapInfoV4
info     -> BitmapInfoV4 -> Put
forall t. Binary t => t -> Put
put BitmapInfoV4
info
        InfoV5 BitmapInfoV5
info     -> BitmapInfoV5 -> Put
forall t. Binary t => t -> Put
put BitmapInfoV5
info
        

-- | Get the common `BitmapInfoV3` structure from a `BitmapInfo`
getBitmapInfoV3 :: BitmapInfo -> BitmapInfoV3
getBitmapInfoV3 :: BitmapInfo -> BitmapInfoV3
getBitmapInfoV3 BitmapInfo
bi
 = case BitmapInfo
bi of
        InfoV3 BitmapInfoV3
info     -> BitmapInfoV3
info
        InfoV4 BitmapInfoV4
info     -> BitmapInfoV4 -> BitmapInfoV3
dib4InfoV3 BitmapInfoV4
info
        InfoV5 BitmapInfoV5
info     -> BitmapInfoV4 -> BitmapInfoV3
dib4InfoV3 (BitmapInfoV4 -> BitmapInfoV3) -> BitmapInfoV4 -> BitmapInfoV3
forall a b. (a -> b) -> a -> b
$ BitmapInfoV5 -> BitmapInfoV4
dib5InfoV4 BitmapInfoV5
info