module Codec.BMP.Unpack
(unpackBMPToRGBA32)
where
import Codec.BMP.Base
import Codec.BMP.BitmapInfo
import Foreign.Ptr
import Foreign.Marshal.Alloc
import Foreign.Storable
import System.IO.Unsafe
import Data.Word
import Data.ByteString as BS
import Data.ByteString.Unsafe as BS
import Prelude as P
unpackBMPToRGBA32 :: BMP -> ByteString
unpackBMPToRGBA32 bmp
= case bmpBitmapInfo bmp of
InfoV3 info
-> packRGB24ToRGBA32
(fromIntegral $ dib3Width info)
(fromIntegral $ dib3Height info)
(bmpRawImageData bmp)
packRGB24ToRGBA32
:: Int
-> Int
-> ByteString
-> ByteString
packRGB24ToRGBA32 width height str
= let bytesPerLine = BS.length str `div` height
padPerLine = bytesPerLine width * 3
sizeDest = width * height * 4
in if height * (width * 3 + padPerLine) /= BS.length str
then error "Codec.BMP.unpackRGB24ToRGBA32: given image dimensions don't match input data."
else unsafePerformIO
$ allocaBytes sizeDest $ \bufDest ->
BS.unsafeUseAsCString str $ \bufSrc ->
do packRGB24ToRGBA32' width height padPerLine (castPtr bufSrc) (castPtr bufDest)
packCStringLen (bufDest, sizeDest)
packRGB24ToRGBA32' width height pad ptrSrc ptrDest
= go 0 0 0 0
where
go posX posY oSrc oDest
| posX == width
= go 0 (posY + 1) (oSrc + pad) oDest
| posY == height
= return ()
| otherwise
= do blue :: Word8 <- peekByteOff ptrSrc (oSrc + 0)
green :: Word8 <- peekByteOff ptrSrc (oSrc + 1)
red :: Word8 <- peekByteOff ptrSrc (oSrc + 2)
pokeByteOff ptrDest (oDest + 0) red
pokeByteOff ptrDest (oDest + 1) green
pokeByteOff ptrDest (oDest + 2) blue
pokeByteOff ptrDest (oDest + 3) (255 :: Word8)
go (posX + 1) posY (oSrc + 3) (oDest + 4)