JuicyPixels 3.3.3 → 3.3.3.1
raw patch · 12 files changed
+582/−550 lines, 12 filesdep ~basedep ~binaryPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: base, binary
API changes (from Hackage documentation)
Files
- JuicyPixels.cabal +4/−4
- changelog +7/−0
- src/Codec/Picture/Bitmap.hs +16/−12
- src/Codec/Picture/ColorQuant.hs +1/−1
- src/Codec/Picture/HDR.hs +534/−530
- src/Codec/Picture/Jpg.hs +4/−2
- src/Codec/Picture/Jpg/Internal/Types.hs +4/−0
- src/Codec/Picture/Png.hs +4/−0
- src/Codec/Picture/Png/Internal/Export.hs +2/−0
- src/Codec/Picture/Png/Internal/Metadata.hs +2/−0
- src/Codec/Picture/Tiff/Internal/Metadata.hs +2/−0
- src/Codec/Picture/Types.hs +2/−1
JuicyPixels.cabal view
@@ -1,5 +1,5 @@ Name: JuicyPixels -Version: 3.3.3 +Version: 3.3.3.1 Synopsis: Picture loading/serialization (in png, jpeg, bitmap, gif, tga, tiff and radiance) Description: <<data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAMAAAADABAMAAACg8nE0AAAAElBMVEUAAABJqDSTWEL/qyb///8AAABH/1GTAAAAAXRSTlMAQObYZgAAAN5JREFUeF7s1sEJgFAQxFBbsAV72v5bEVYWPwT/XDxmCsi7zvHXavYREBDI3XP2GgICqBBYuwIC+/rVayPUAyAg0HvIXBcQoDFDGnUBgWQQ2Bx3AYFaRoBpAQHWb3bt2ARgGAiCYFFuwf3X5HA/McgGJWI2FdykCv4aBYzmKwDwvl6NVmUAAK2vlwEALK7fo88GANB6HQsAAAAAAAAA7P94AQCzswEAAAAAAAAAAAAAAAAAAICzh4UAO4zWAYBfRutHA4Bn5C69JhowAMGoBaMWDG0wCkbBKBgFo2AUAACPmegUST/IJAAAAABJRU5ErkJggg==>> @@ -28,7 +28,7 @@ Source-Repository this Type: git Location: git://github.com/Twinside/Juicy.Pixels.git - Tag: v3.3.3 + Tag: v3.3.3.1 Flag Mmap Description: Enable the file loading via mmap (memory map) @@ -69,11 +69,11 @@ Build-depends: base >= 4.8 && < 6, bytestring >= 0.9 && < 0.11, mtl >= 1.1 && < 2.3, - binary >= 0.5 && < 0.9, + binary >= 0.8.1 && < 0.9, zlib >= 0.5.3.1 && < 0.7, transformers >= 0.2, vector >= 0.10 && < 0.13, - primitive >= 0.4 && < 0.7, + primitive >= 0.4, deepseq >= 1.1 && < 1.5, containers >= 0.4.2 && < 0.7
changelog view
@@ -1,6 +1,11 @@ Change log ========== +v3.3.3.1 June 2019 +------------------ + + * New GHC maintenance (thanks to ekmett) + v3.3.3 December 2018 -------------------- @@ -8,6 +13,8 @@ * Refactoring: exposing more internal modules (thanks to wyager) * Refactoring: exposing dynamicMap & dynamicPixelMap through `Codec.Picture` (thnks to LightAndLight) + + * v3.3.3.1: fixing compilation with older GHC v3.3.2 October 2018 -------------------
src/Codec/Picture/Bitmap.hs view
@@ -12,9 +12,9 @@ , decodeBitmap , decodeBitmapWithMetadata , decodeBitmapWithPaletteAndMetadata - , encodeDynamicBitmap + , encodeDynamicBitmap , encodeBitmapWithPaletteAndMetadata - , writeDynamicBitmap + , writeDynamicBitmap -- * Accepted format in output , BmpEncodable( ) ) where @@ -36,12 +36,12 @@ , putInt32le , putWord16le , putWord32le - , putByteString + , putByteString ) import Data.Binary.Get( Get , getWord8 - , getWord16le + , getWord16le , getWord32le , getInt32le , getByteString @@ -400,7 +400,7 @@ instance BmpEncodable PixelRGBA8 where hasAlpha _ = True bitsPerPixel _ = 32 - bmpEncode (Image {imageWidth = w, imageHeight = h, imageData = arr}) = + bmpEncode (Image {imageWidth = w, imageHeight = h, imageData = arr}) = forM_ [h - 1, h - 2 .. 0] $ \l -> putVector $ runST $ putLine l where putVector vec = putByteString . blitVector vec 0 $ w * 4 @@ -445,7 +445,7 @@ let r = arr `VS.unsafeIndex` readIdx g = arr `VS.unsafeIndex` (readIdx + 1) b = arr `VS.unsafeIndex` (readIdx + 2) - + (buff `M.unsafeWrite` writeIdx) b (buff `M.unsafeWrite` (writeIdx + 1)) g (buff `M.unsafeWrite` (writeIdx + 2)) r @@ -624,7 +624,7 @@ VS.unsafeFreeze arr padding = linePadding (fromIntegral bpp) wi - + readLine :: forall s. M.MVector s Word8 -> Int -> Int -> ST s Int readLine arr readIndex line = case lowBPP of OneBPP -> inner1 readIndex writeIndex @@ -678,7 +678,7 @@ inner (0 : 1 : _) _ = return () inner (0 : 2 : hOffset : vOffset : rest) (yOffset, _) = inner rest (yOffset - (wi * fromIntegral vOffset), fromIntegral hOffset) - inner (0 : n : rest) writePos = + inner (0 : n : rest) writePos = let isPadded = if is4bpp then (n + 3) .&. 0x3 < 2 else odd n in copyN isPadded (fromIntegral n) rest writePos inner (n : b : rest) writePos = writeN (fromIntegral n) b rest writePos @@ -735,7 +735,7 @@ metadataOfHeader :: BmpV5Header -> Maybe B.ByteString -> Metadatas metadataOfHeader hdr iccProfile = - cs <> Met.simpleMetadata Met.SourceBitmap (width hdr) (abs $ height hdr) dpiX dpiY + cs `mappend` Met.simpleMetadata Met.SourceBitmap (width hdr) (abs $ height hdr) dpiX dpiY where dpiX = Met.dotsPerMeterToDotPerInch . fromIntegral $ xResolution hdr dpiY = Met.dotsPerMeterToDotPerInch . fromIntegral $ yResolution hdr @@ -847,7 +847,7 @@ decodeImageRGB8 RGB24 hdr rest (16, 1, 0) -> do rest <- getData - return . TrueColorImage . ImageRGB8 $ + return . TrueColorImage . ImageRGB8 $ decodeImageRGB8 (RGB16 defaultBitfieldsRGB16) hdr rest (16, 1, 3) -> do r <- getBitfield . fromIntegral $ 0xFFFF .&. redMask hdr @@ -884,7 +884,11 @@ a -> fail $ "Can't handle BMP file " ++ show a -- | Decode a bitfield. Will fail if the bitfield is empty. +#if MIN_VERSION_base(4,13,0) +getBitfield :: (FiniteBits t, Integral t, Num t, MonadFail m) => t -> m (Bitfield t) +#else getBitfield :: (FiniteBits t, Integral t, Num t, Monad m) => t -> m (Bitfield t) +#endif getBitfield 0 = fail $ "Codec.Picture.Bitmap.getBitfield: bitfield cannot be 0" getBitfield w = return (makeBitfield w) @@ -911,7 +915,7 @@ -- the following metadatas: -- -- * 'Codec.Picture.Metadata.DpiX' --- * 'Codec.Picture.Metadata.DpiY' +-- * 'Codec.Picture.Metadata.DpiY' -- encodeBitmapWithMetadata :: forall pixel. BmpEncodable pixel => Metadatas -> Image pixel -> L.ByteString @@ -952,7 +956,7 @@ -- the following metadatas: -- -- * 'Codec.Picture.Metadata.DpiX' --- * 'Codec.Picture.Metadata.DpiY' +-- * 'Codec.Picture.Metadata.DpiY' -- encodeBitmapWithPaletteAndMetadata :: forall pixel. (BmpEncodable pixel) => Metadatas -> BmpPalette -> Image pixel
src/Codec/Picture/ColorQuant.hs view
@@ -120,7 +120,7 @@ (bg, br, bb) = bitDiv3 maxCols (dr, dg, db) = (2^(8-br), 2^(8-bg), 2^(8-bb)) paletteIndex (PixelRGB8 r g b) = fromIntegral $ fromMaybe 0 (elemIndex - (PixelRGB8 (r .&. (256 - dr)) (g .&. (256 - dg)) (b .&. (256 - db))) + (PixelRGB8 (r .&. negate dr) (g .&. negate dg) (b .&. negate db)) paletteList) isColorCountBelow :: Int -> Image PixelRGB8 -> (Set.Set PixelRGB8, Bool)
src/Codec/Picture/HDR.hs view
@@ -1,530 +1,534 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TupleSections #-}--- | Module dedicated of Radiance file decompression (.hdr or .pic) file.--- Radiance file format is used for High dynamic range imaging.-module Codec.Picture.HDR( decodeHDR- , decodeHDRWithMetadata- , encodeHDR- , encodeRawHDR- , encodeRLENewStyleHDR- , writeHDR- , writeRLENewStyleHDR- ) where--#if !MIN_VERSION_base(4,8,0)-import Control.Applicative( pure, (<*>), (<$>) )-#endif--import Data.Bits( Bits, (.&.), (.|.), unsafeShiftL, unsafeShiftR )-import Data.Char( ord, chr, isDigit )-import Data.Word( Word8 )-import Data.Monoid( (<>) )-import Control.Monad( when, foldM, foldM_, forM, forM_, unless )-import Control.Monad.Trans.Class( lift )-import qualified Data.ByteString as B-import qualified Data.ByteString.Lazy as L-import qualified Data.ByteString.Char8 as BC--import Data.List( partition )-import Data.Binary( Binary( .. ), encode )-import Data.Binary.Get( Get, getByteString, getWord8 )-import Data.Binary.Put( putByteString, putLazyByteString )--import Control.Monad.ST( ST, runST )-import Foreign.Storable ( Storable )-import Control.Monad.Primitive ( PrimState, PrimMonad )-import qualified Data.Vector.Storable as V-import qualified Data.Vector.Storable.Mutable as M--import Codec.Picture.Metadata( Metadatas- , SourceFormat( SourceHDR )- , basicMetadata )-import Codec.Picture.InternalHelper-import Codec.Picture.Types-import Codec.Picture.VectorByteConversion--#if MIN_VERSION_transformers(0, 4, 0)-import Control.Monad.Trans.Except( ExceptT, throwE, runExceptT )-#else--- Transfomers 0.3 compat-import Control.Monad.Trans.Error( Error, ErrorT, throwError, runErrorT )--type ExceptT = ErrorT--throwE :: (Monad m, Error e) => e -> ErrorT e m a-throwE = throwError--runExceptT :: ErrorT e m a -> m (Either e a)-runExceptT = runErrorT-#endif--{-# INLINE (.<<.) #-}-(.<<.), (.>>.) :: (Bits a) => a -> Int -> a-(.<<.) = unsafeShiftL-(.>>.) = unsafeShiftR--{-# INLINE (.<-.) #-}-(.<-.) :: (PrimMonad m, Storable a)- => M.STVector (PrimState m) a -> Int -> a -> m ()-(.<-.) = M.write - {-M.unsafeWrite-}--type HDRReader s a = ExceptT String (ST s) a--data RGBE = RGBE !Word8 !Word8 !Word8 !Word8--instance Binary RGBE where- put (RGBE r g b e) = put r >> put g >> put b >> put e- get = RGBE <$> get <*> get <*> get <*> get--checkLineLength :: RGBE -> Int-checkLineLength (RGBE _ _ a b) =- (fromIntegral a .<<. 8) .|. fromIntegral b--isNewRunLengthMarker :: RGBE -> Bool-isNewRunLengthMarker (RGBE 2 2 _ _) = True-isNewRunLengthMarker _ = False--data RadianceFormat =- FormatRGBE- | FormatXYZE--radiance32bitRleRGBEFormat, radiance32bitRleXYZEFromat :: B.ByteString-radiance32bitRleRGBEFormat = BC.pack "32-bit_rle_rgbe"-radiance32bitRleXYZEFromat = BC.pack "32-bit_rle_xyze"--instance Binary RadianceFormat where- put FormatRGBE = putByteString radiance32bitRleRGBEFormat- put FormatXYZE = putByteString radiance32bitRleXYZEFromat-- get = getByteString (B.length radiance32bitRleRGBEFormat) >>= format- where format sig- | sig == radiance32bitRleRGBEFormat = pure FormatRGBE- | sig == radiance32bitRleXYZEFromat = pure FormatXYZE- | otherwise = fail "Unrecognized Radiance format"--toRGBE :: PixelRGBF -> RGBE-toRGBE (PixelRGBF r g b)- | d <= 1e-32 = RGBE 0 0 0 0- | otherwise = RGBE (fix r) (fix g) (fix b) (fromIntegral $ e + 128)- where d = maximum [r, g, b]- e = exponent d- coeff = significand d * 255.9999 / d- fix v = truncate $ v * coeff---dropUntil :: Word8 -> Get ()-dropUntil c = getWord8 >>= inner- where inner val | val == c = pure ()- inner _ = getWord8 >>= inner--getUntil :: (Word8 -> Bool) -> B.ByteString -> Get B.ByteString-getUntil f initialAcc = getWord8 >>= inner initialAcc- where inner acc c | f c = pure acc- inner acc c = getWord8 >>= inner (B.snoc acc c)--data RadianceHeader = RadianceHeader- { radianceInfos :: [(B.ByteString, B.ByteString)]- , radianceFormat :: RadianceFormat- , radianceHeight :: !Int- , radianceWidth :: !Int- , radianceData :: L.ByteString- }--radianceFileSignature :: B.ByteString-radianceFileSignature = BC.pack "#?RADIANCE\n"--unpackColor :: L.ByteString -> Int -> RGBE-unpackColor str idx = RGBE (at 0) (at 1) (at 2) (at 3)- where at n = L.index str . fromIntegral $ idx + n--storeColor :: M.STVector s Word8 -> Int -> RGBE -> ST s ()-storeColor vec idx (RGBE r g b e) = do- (vec .<-. (idx + 0)) r- (vec .<-. (idx + 1)) g- (vec .<-. (idx + 2)) b- (vec .<-. (idx + 3)) e--parsePair :: Char -> Get (B.ByteString, B.ByteString)-parsePair firstChar = do- let eol c = c == fromIntegral (ord '\n')- line <- getUntil eol B.empty- case BC.split '=' line of- [] -> pure (BC.singleton firstChar, B.empty)- [val] -> pure (BC.singleton firstChar, val)- [key, val] -> pure (BC.singleton firstChar <> key, val)- (key : vals) -> pure (BC.singleton firstChar <> key, B.concat vals)--decodeInfos :: Get [(B.ByteString, B.ByteString)]-decodeInfos = do- char <- getChar8- case char of- -- comment- '#' -> dropUntil (fromIntegral $ ord '\n') >> decodeInfos- -- end of header, no more information- '\n' -> pure []- -- Classical parsing- c -> (:) <$> parsePair c <*> decodeInfos----- | Decode an HDR (radiance) image, the resulting image can be:------ * 'ImageRGBF'----decodeHDR :: B.ByteString -> Either String DynamicImage-decodeHDR = fmap fst . decodeHDRWithMetadata---- | Equivalent to decodeHDR but with aditional metadatas.-decodeHDRWithMetadata :: B.ByteString -> Either String (DynamicImage, Metadatas)-decodeHDRWithMetadata str = runST $ runExceptT $- case runGet decodeHeader $ L.fromChunks [str] of- Left err -> throwE err- Right rez ->- let meta = basicMetadata SourceHDR (abs $ radianceWidth rez) (abs $ radianceHeight rez) in- (, meta) . ImageRGBF <$> (decodeRadiancePicture rez >>= lift . unsafeFreezeImage)--getChar8 :: Get Char-getChar8 = chr . fromIntegral <$> getWord8--isSign :: Char -> Bool-isSign c = c == '+' || c == '-'--isAxisLetter :: Char -> Bool-isAxisLetter c = c == 'X' || c == 'Y'--decodeNum :: Get Int-decodeNum = do- sign <- getChar8- letter <- getChar8- space <- getChar8-- unless (isSign sign && isAxisLetter letter && space == ' ')- (fail "Invalid radiance size declaration")-- let numDec acc c | isDigit c =- getChar8 >>= numDec (acc * 10 + ord c - ord '0')- numDec acc _- | sign == '-' = pure $ negate acc- | otherwise = pure acc-- getChar8 >>= numDec 0--copyPrevColor :: M.STVector s Word8 -> Int -> ST s ()-copyPrevColor scanLine idx = do- r <- scanLine `M.unsafeRead` (idx - 4)- g <- scanLine `M.unsafeRead` (idx - 3)- b <- scanLine `M.unsafeRead` (idx - 2)- e <- scanLine `M.unsafeRead` (idx - 1)-- (scanLine `M.unsafeWrite` (idx + 0)) r- (scanLine `M.unsafeWrite` (idx + 1)) g- (scanLine `M.unsafeWrite` (idx + 2)) b- (scanLine `M.unsafeWrite` (idx + 3)) e--oldStyleRLE :: L.ByteString -> Int -> M.STVector s Word8- -> HDRReader s Int-oldStyleRLE inputData initialIdx scanLine = inner initialIdx 0 0- where maxOutput = M.length scanLine- maxInput = fromIntegral $ L.length inputData-- inner readIdx writeIdx _- | readIdx >= maxInput || writeIdx >= maxOutput = pure readIdx- inner readIdx writeIdx shift = do- let color@(RGBE r g b e) = unpackColor inputData readIdx- isRun = r == 1 && g == 1 && b == 1-- if not isRun- then do- lift $ storeColor scanLine writeIdx color- inner (readIdx + 4) (writeIdx + 4) 0- - else do- let count = fromIntegral e .<<. shift- lift $ forM_ [0 .. count] $ \i -> copyPrevColor scanLine (writeIdx + 4 * i)- inner (readIdx + 4) (writeIdx + 4 * count) (shift + 8)--newStyleRLE :: L.ByteString -> Int -> M.STVector s Word8- -> HDRReader s Int-newStyleRLE inputData initialIdx scanline = foldM inner initialIdx [0 .. 3]- where dataAt idx- | fromIntegral idx >= maxInput = throwE $ "Read index out of bound (" ++ show idx ++ ")"- | otherwise = pure $ L.index inputData (fromIntegral idx)-- maxOutput = M.length scanline- maxInput = fromIntegral $ L.length inputData- stride = 4--- strideSet count destIndex _ | endIndex > maxOutput + stride =- throwE $ "Out of bound HDR scanline " ++ show endIndex ++ " (max " ++ show maxOutput ++ ")"- where endIndex = destIndex + count * stride- strideSet count destIndex val = aux destIndex count- where aux i 0 = pure i- aux i c = do- lift $ (scanline .<-. i) val- aux (i + stride) (c - 1)--- strideCopy _ count destIndex- | writeEndBound > maxOutput + stride = throwE "Out of bound HDR scanline"- where writeEndBound = destIndex + count * stride- strideCopy sourceIndex count destIndex = aux sourceIndex destIndex count- where aux _ j 0 = pure j- aux i j c = do- val <- dataAt i- lift $ (scanline .<-. j) val- aux (i + 1) (j + stride) (c - 1)-- inner readIdx writeIdx- | readIdx >= maxInput || writeIdx >= maxOutput = pure readIdx- inner readIdx writeIdx = do- code <- dataAt readIdx- if code > 128- then do- let repeatCount = fromIntegral code .&. 0x7F- newVal <- dataAt $ readIdx + 1- endIndex <- strideSet repeatCount writeIdx newVal- inner (readIdx + 2) endIndex -- else do- let iCode = fromIntegral code- endIndex <- strideCopy (readIdx + 1) iCode writeIdx- inner (readIdx + iCode + 1) endIndex--instance Binary RadianceHeader where- get = decodeHeader- put hdr = do- putByteString radianceFileSignature- putByteString $ BC.pack "FORMAT="- put $ radianceFormat hdr- let sizeString =- BC.pack $ "\n\n-Y " ++ show (radianceHeight hdr)- ++ " +X " ++ show (radianceWidth hdr) ++ "\n"- putByteString sizeString- putLazyByteString $ radianceData hdr---decodeHeader :: Get RadianceHeader-decodeHeader = do- sig <- getByteString $ B.length radianceFileSignature- when (sig /= radianceFileSignature)- (fail "Invalid radiance file signature")-- infos <- decodeInfos- let formatKey = BC.pack "FORMAT"- case partition (\(k,_) -> k /= formatKey) infos of- (_, []) -> fail "No radiance format specified"- (info, [(_, formatString)]) ->- case runGet get $ L.fromChunks [formatString] of- Left err -> fail err- Right format -> do- (n1, n2, b) <- (,,) <$> decodeNum- <*> decodeNum- <*> getRemainingBytes- return . RadianceHeader info format n1 n2 $ L.fromChunks [b]-- _ -> fail "Multiple radiance format specified"--toFloat :: RGBE -> PixelRGBF-toFloat (RGBE r g b e) = PixelRGBF rf gf bf- where f = encodeFloat 1 $ fromIntegral e - (128 + 8)- rf = (fromIntegral r + 0.0) * f- gf = (fromIntegral g + 0.0) * f- bf = (fromIntegral b + 0.0) * f--encodeScanlineColor :: M.STVector s Word8- -> M.STVector s Word8- -> Int- -> ST s Int-encodeScanlineColor vec outVec outIdx = do- val <- vec `M.unsafeRead` 0- runLength 1 0 val 1 outIdx- where maxIndex = M.length vec-- pushRun len val at = do- (outVec `M.unsafeWrite` at) $ fromIntegral $ len .|. 0x80- (outVec `M.unsafeWrite` (at + 1)) val- return $ at + 2-- pushData start len at = do- (outVec `M.unsafeWrite` at) $ fromIntegral len- let first = start - len- end = start - 1- offset = at - first + 1- forM_ [first .. end] $ \i -> do- v <- vec `M.unsafeRead` i- (outVec `M.unsafeWrite` (offset + i)) v-- return $ at + len + 1-- -- End of scanline, empty the thing- runLength run cpy prev idx at | idx >= maxIndex =- case (run, cpy) of- (0, 0) -> pure at- (0, n) -> pushData idx n at- (n, 0) -> pushRun n prev at- (_, _) -> error "HDR - Run length algorithm is wrong"-- -- full runlength, we must write the packet- runLength r@127 _ prev idx at = do- val <- vec `M.unsafeRead` idx- pushRun r prev at >>=- runLength 1 0 val (idx + 1)-- -- full copy, we must write the packet- runLength _ c@127 _ idx at = do- val <- vec `M.unsafeRead` idx- pushData idx c at >>=- runLength 1 0 val (idx + 1)-- runLength n 0 prev idx at = do- val <- vec `M.unsafeRead` idx- case val == prev of- True -> runLength (n + 1) 0 prev (idx + 1) at- False | n < 4 -> runLength 0 (n + 1) val (idx + 1) at- False ->- pushRun n prev at >>=- runLength 1 0 val (idx + 1)-- runLength 0 n prev idx at = do- val <- vec `M.unsafeRead` idx- if val /= prev- then runLength 0 (n + 1) val (idx + 1) at- else- pushData (idx - 1) (n - 1) at >>=- runLength (2 :: Int) 0 val (idx + 1)-- runLength _ _ _ _ _ =- error "HDR RLE inconsistent state"---- | Write an High dynamic range image into a radiance--- image file on disk.-writeHDR :: FilePath -> Image PixelRGBF -> IO ()-writeHDR filename img = L.writeFile filename $ encodeHDR img---- | Write a RLE encoded High dynamic range image into a radiance--- image file on disk.-writeRLENewStyleHDR :: FilePath -> Image PixelRGBF -> IO ()-writeRLENewStyleHDR filename img =- L.writeFile filename $ encodeRLENewStyleHDR img---- | Encode an High dynamic range image into a radiance image--- file format.--- Alias for encodeRawHDR-encodeHDR :: Image PixelRGBF -> L.ByteString-encodeHDR = encodeRawHDR---- | Encode an High dynamic range image into a radiance image--- file format. without compression-encodeRawHDR :: Image PixelRGBF -> L.ByteString-encodeRawHDR pic = encode descriptor- where- newImage = pixelMap rgbeInRgba pic- -- we are cheating to death here, the layout we want- -- correspond to the layout of pixelRGBA8, so we- -- convert- rgbeInRgba pixel = PixelRGBA8 r g b e- where RGBE r g b e = toRGBE pixel-- descriptor = RadianceHeader- { radianceInfos = []- , radianceFormat = FormatRGBE- , radianceHeight = imageHeight pic- , radianceWidth = imageWidth pic- , radianceData = L.fromChunks [toByteString $ imageData newImage]- }----- | Encode an High dynamic range image into a radiance image--- file format using a light RLE compression. Some problems--- seem to arise with some image viewer.-encodeRLENewStyleHDR :: Image PixelRGBF -> L.ByteString-encodeRLENewStyleHDR pic = encode $ runST $ do- let w = imageWidth pic- h = imageHeight pic-- scanLineR <- M.new w :: ST s (M.STVector s Word8)- scanLineG <- M.new w- scanLineB <- M.new w- scanLineE <- M.new w-- encoded <-- forM [0 .. h - 1] $ \line -> do- buff <- M.new $ w * 4 + w `div` 127 + 2- let columner col | col >= w = return ()- columner col = do- let RGBE r g b e = toRGBE $ pixelAt pic col line- (scanLineR `M.unsafeWrite` col) r- (scanLineG `M.unsafeWrite` col) g- (scanLineB `M.unsafeWrite` col) b- (scanLineE `M.unsafeWrite` col) e-- columner (col + 1)-- columner 0-- (buff `M.unsafeWrite` 0) 2- (buff `M.unsafeWrite` 1) 2- (buff `M.unsafeWrite` 2) $ fromIntegral ((w .>>. 8) .&. 0xFF)- (buff `M.unsafeWrite` 3) $ fromIntegral (w .&. 0xFF)-- i1 <- encodeScanlineColor scanLineR buff 4 - i2 <- encodeScanlineColor scanLineG buff i1- i3 <- encodeScanlineColor scanLineB buff i2- endIndex <- encodeScanlineColor scanLineE buff i3-- (\v -> blitVector v 0 endIndex) <$> V.unsafeFreeze buff-- pure RadianceHeader- { radianceInfos = []- , radianceFormat = FormatRGBE- , radianceHeight = h- , radianceWidth = w- , radianceData = L.fromChunks encoded - }- --decodeRadiancePicture :: RadianceHeader -> HDRReader s (MutableImage s PixelRGBF)-decodeRadiancePicture hdr = do- let width = abs $ radianceWidth hdr- height = abs $ radianceHeight hdr- packedData = radianceData hdr-- scanLine <- lift $ M.new $ width * 4- resultBuffer <- lift $ M.new $ width * height * 3-- let scanLineImage = MutableImage- { mutableImageWidth = width- , mutableImageHeight = 1- , mutableImageData = scanLine- }-- finalImage = MutableImage- { mutableImageWidth = width- , mutableImageHeight = height- , mutableImageData = resultBuffer- }-- let scanLineExtractor readIdx line = do- let color = unpackColor packedData readIdx- inner | isNewRunLengthMarker color = do- let calcSize = checkLineLength color- when (calcSize /= width)- (throwE "Invalid sanline size")- pure $ \idx -> newStyleRLE packedData (idx + 4)- | otherwise = pure $ oldStyleRLE packedData- f <- inner- newRead <- f readIdx scanLine- forM_ [0 .. width - 1] $ \i -> do- -- mokay, it's a hack, but I don't want to define a- -- pixel instance of RGBE...- PixelRGBA8 r g b e <- lift $ readPixel scanLineImage i 0- lift $ writePixel finalImage i line . toFloat $ RGBE r g b e-- return newRead-- foldM_ scanLineExtractor 0 [0 .. height - 1]-- return finalImage-+{-# LANGUAGE CPP #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TupleSections #-} +-- | Module dedicated of Radiance file decompression (.hdr or .pic) file. +-- Radiance file format is used for High dynamic range imaging. +module Codec.Picture.HDR( decodeHDR + , decodeHDRWithMetadata + , encodeHDR + , encodeRawHDR + , encodeRLENewStyleHDR + , writeHDR + , writeRLENewStyleHDR + ) where + +#if !MIN_VERSION_base(4,8,0) +import Control.Applicative( pure, (<*>), (<$>) ) +#endif + +import Data.Bits( Bits, (.&.), (.|.), unsafeShiftL, unsafeShiftR ) +import Data.Char( ord, chr, isDigit ) +import Data.Word( Word8 ) + +#if !MIN_VERSION_base(4,11,0) +import Data.Monoid( (<>) ) +#endif + +import Control.Monad( when, foldM, foldM_, forM, forM_, unless ) +import Control.Monad.Trans.Class( lift ) +import qualified Data.ByteString as B +import qualified Data.ByteString.Lazy as L +import qualified Data.ByteString.Char8 as BC + +import Data.List( partition ) +import Data.Binary( Binary( .. ), encode ) +import Data.Binary.Get( Get, getByteString, getWord8 ) +import Data.Binary.Put( putByteString, putLazyByteString ) + +import Control.Monad.ST( ST, runST ) +import Foreign.Storable ( Storable ) +import Control.Monad.Primitive ( PrimState, PrimMonad ) +import qualified Data.Vector.Storable as V +import qualified Data.Vector.Storable.Mutable as M + +import Codec.Picture.Metadata( Metadatas + , SourceFormat( SourceHDR ) + , basicMetadata ) +import Codec.Picture.InternalHelper +import Codec.Picture.Types +import Codec.Picture.VectorByteConversion + +#if MIN_VERSION_transformers(0, 4, 0) +import Control.Monad.Trans.Except( ExceptT, throwE, runExceptT ) +#else +-- Transfomers 0.3 compat +import Control.Monad.Trans.Error( Error, ErrorT, throwError, runErrorT ) + +type ExceptT = ErrorT + +throwE :: (Monad m, Error e) => e -> ErrorT e m a +throwE = throwError + +runExceptT :: ErrorT e m a -> m (Either e a) +runExceptT = runErrorT +#endif + +{-# INLINE (.<<.) #-} +(.<<.), (.>>.) :: (Bits a) => a -> Int -> a +(.<<.) = unsafeShiftL +(.>>.) = unsafeShiftR + +{-# INLINE (.<-.) #-} +(.<-.) :: (PrimMonad m, Storable a) + => M.STVector (PrimState m) a -> Int -> a -> m () +(.<-.) = M.write + {-M.unsafeWrite-} + +type HDRReader s a = ExceptT String (ST s) a + +data RGBE = RGBE !Word8 !Word8 !Word8 !Word8 + +instance Binary RGBE where + put (RGBE r g b e) = put r >> put g >> put b >> put e + get = RGBE <$> get <*> get <*> get <*> get + +checkLineLength :: RGBE -> Int +checkLineLength (RGBE _ _ a b) = + (fromIntegral a .<<. 8) .|. fromIntegral b + +isNewRunLengthMarker :: RGBE -> Bool +isNewRunLengthMarker (RGBE 2 2 _ _) = True +isNewRunLengthMarker _ = False + +data RadianceFormat = + FormatRGBE + | FormatXYZE + +radiance32bitRleRGBEFormat, radiance32bitRleXYZEFromat :: B.ByteString +radiance32bitRleRGBEFormat = BC.pack "32-bit_rle_rgbe" +radiance32bitRleXYZEFromat = BC.pack "32-bit_rle_xyze" + +instance Binary RadianceFormat where + put FormatRGBE = putByteString radiance32bitRleRGBEFormat + put FormatXYZE = putByteString radiance32bitRleXYZEFromat + + get = getByteString (B.length radiance32bitRleRGBEFormat) >>= format + where format sig + | sig == radiance32bitRleRGBEFormat = pure FormatRGBE + | sig == radiance32bitRleXYZEFromat = pure FormatXYZE + | otherwise = fail "Unrecognized Radiance format" + +toRGBE :: PixelRGBF -> RGBE +toRGBE (PixelRGBF r g b) + | d <= 1e-32 = RGBE 0 0 0 0 + | otherwise = RGBE (fix r) (fix g) (fix b) (fromIntegral $ e + 128) + where d = maximum [r, g, b] + e = exponent d + coeff = significand d * 255.9999 / d + fix v = truncate $ v * coeff + + +dropUntil :: Word8 -> Get () +dropUntil c = getWord8 >>= inner + where inner val | val == c = pure () + inner _ = getWord8 >>= inner + +getUntil :: (Word8 -> Bool) -> B.ByteString -> Get B.ByteString +getUntil f initialAcc = getWord8 >>= inner initialAcc + where inner acc c | f c = pure acc + inner acc c = getWord8 >>= inner (B.snoc acc c) + +data RadianceHeader = RadianceHeader + { radianceInfos :: [(B.ByteString, B.ByteString)] + , radianceFormat :: RadianceFormat + , radianceHeight :: !Int + , radianceWidth :: !Int + , radianceData :: L.ByteString + } + +radianceFileSignature :: B.ByteString +radianceFileSignature = BC.pack "#?RADIANCE\n" + +unpackColor :: L.ByteString -> Int -> RGBE +unpackColor str idx = RGBE (at 0) (at 1) (at 2) (at 3) + where at n = L.index str . fromIntegral $ idx + n + +storeColor :: M.STVector s Word8 -> Int -> RGBE -> ST s () +storeColor vec idx (RGBE r g b e) = do + (vec .<-. (idx + 0)) r + (vec .<-. (idx + 1)) g + (vec .<-. (idx + 2)) b + (vec .<-. (idx + 3)) e + +parsePair :: Char -> Get (B.ByteString, B.ByteString) +parsePair firstChar = do + let eol c = c == fromIntegral (ord '\n') + line <- getUntil eol B.empty + case BC.split '=' line of + [] -> pure (BC.singleton firstChar, B.empty) + [val] -> pure (BC.singleton firstChar, val) + [key, val] -> pure (BC.singleton firstChar <> key, val) + (key : vals) -> pure (BC.singleton firstChar <> key, B.concat vals) + +decodeInfos :: Get [(B.ByteString, B.ByteString)] +decodeInfos = do + char <- getChar8 + case char of + -- comment + '#' -> dropUntil (fromIntegral $ ord '\n') >> decodeInfos + -- end of header, no more information + '\n' -> pure [] + -- Classical parsing + c -> (:) <$> parsePair c <*> decodeInfos + + +-- | Decode an HDR (radiance) image, the resulting image can be: +-- +-- * 'ImageRGBF' +-- +decodeHDR :: B.ByteString -> Either String DynamicImage +decodeHDR = fmap fst . decodeHDRWithMetadata + +-- | Equivalent to decodeHDR but with aditional metadatas. +decodeHDRWithMetadata :: B.ByteString -> Either String (DynamicImage, Metadatas) +decodeHDRWithMetadata str = runST $ runExceptT $ + case runGet decodeHeader $ L.fromChunks [str] of + Left err -> throwE err + Right rez -> + let meta = basicMetadata SourceHDR (abs $ radianceWidth rez) (abs $ radianceHeight rez) in + (, meta) . ImageRGBF <$> (decodeRadiancePicture rez >>= lift . unsafeFreezeImage) + +getChar8 :: Get Char +getChar8 = chr . fromIntegral <$> getWord8 + +isSign :: Char -> Bool +isSign c = c == '+' || c == '-' + +isAxisLetter :: Char -> Bool +isAxisLetter c = c == 'X' || c == 'Y' + +decodeNum :: Get Int +decodeNum = do + sign <- getChar8 + letter <- getChar8 + space <- getChar8 + + unless (isSign sign && isAxisLetter letter && space == ' ') + (fail "Invalid radiance size declaration") + + let numDec acc c | isDigit c = + getChar8 >>= numDec (acc * 10 + ord c - ord '0') + numDec acc _ + | sign == '-' = pure $ negate acc + | otherwise = pure acc + + getChar8 >>= numDec 0 + +copyPrevColor :: M.STVector s Word8 -> Int -> ST s () +copyPrevColor scanLine idx = do + r <- scanLine `M.unsafeRead` (idx - 4) + g <- scanLine `M.unsafeRead` (idx - 3) + b <- scanLine `M.unsafeRead` (idx - 2) + e <- scanLine `M.unsafeRead` (idx - 1) + + (scanLine `M.unsafeWrite` (idx + 0)) r + (scanLine `M.unsafeWrite` (idx + 1)) g + (scanLine `M.unsafeWrite` (idx + 2)) b + (scanLine `M.unsafeWrite` (idx + 3)) e + +oldStyleRLE :: L.ByteString -> Int -> M.STVector s Word8 + -> HDRReader s Int +oldStyleRLE inputData initialIdx scanLine = inner initialIdx 0 0 + where maxOutput = M.length scanLine + maxInput = fromIntegral $ L.length inputData + + inner readIdx writeIdx _ + | readIdx >= maxInput || writeIdx >= maxOutput = pure readIdx + inner readIdx writeIdx shift = do + let color@(RGBE r g b e) = unpackColor inputData readIdx + isRun = r == 1 && g == 1 && b == 1 + + if not isRun + then do + lift $ storeColor scanLine writeIdx color + inner (readIdx + 4) (writeIdx + 4) 0 + + else do + let count = fromIntegral e .<<. shift + lift $ forM_ [0 .. count] $ \i -> copyPrevColor scanLine (writeIdx + 4 * i) + inner (readIdx + 4) (writeIdx + 4 * count) (shift + 8) + +newStyleRLE :: L.ByteString -> Int -> M.STVector s Word8 + -> HDRReader s Int +newStyleRLE inputData initialIdx scanline = foldM inner initialIdx [0 .. 3] + where dataAt idx + | fromIntegral idx >= maxInput = throwE $ "Read index out of bound (" ++ show idx ++ ")" + | otherwise = pure $ L.index inputData (fromIntegral idx) + + maxOutput = M.length scanline + maxInput = fromIntegral $ L.length inputData + stride = 4 + + + strideSet count destIndex _ | endIndex > maxOutput + stride = + throwE $ "Out of bound HDR scanline " ++ show endIndex ++ " (max " ++ show maxOutput ++ ")" + where endIndex = destIndex + count * stride + strideSet count destIndex val = aux destIndex count + where aux i 0 = pure i + aux i c = do + lift $ (scanline .<-. i) val + aux (i + stride) (c - 1) + + + strideCopy _ count destIndex + | writeEndBound > maxOutput + stride = throwE "Out of bound HDR scanline" + where writeEndBound = destIndex + count * stride + strideCopy sourceIndex count destIndex = aux sourceIndex destIndex count + where aux _ j 0 = pure j + aux i j c = do + val <- dataAt i + lift $ (scanline .<-. j) val + aux (i + 1) (j + stride) (c - 1) + + inner readIdx writeIdx + | readIdx >= maxInput || writeIdx >= maxOutput = pure readIdx + inner readIdx writeIdx = do + code <- dataAt readIdx + if code > 128 + then do + let repeatCount = fromIntegral code .&. 0x7F + newVal <- dataAt $ readIdx + 1 + endIndex <- strideSet repeatCount writeIdx newVal + inner (readIdx + 2) endIndex + + else do + let iCode = fromIntegral code + endIndex <- strideCopy (readIdx + 1) iCode writeIdx + inner (readIdx + iCode + 1) endIndex + +instance Binary RadianceHeader where + get = decodeHeader + put hdr = do + putByteString radianceFileSignature + putByteString $ BC.pack "FORMAT=" + put $ radianceFormat hdr + let sizeString = + BC.pack $ "\n\n-Y " ++ show (radianceHeight hdr) + ++ " +X " ++ show (radianceWidth hdr) ++ "\n" + putByteString sizeString + putLazyByteString $ radianceData hdr + + +decodeHeader :: Get RadianceHeader +decodeHeader = do + sig <- getByteString $ B.length radianceFileSignature + when (sig /= radianceFileSignature) + (fail "Invalid radiance file signature") + + infos <- decodeInfos + let formatKey = BC.pack "FORMAT" + case partition (\(k,_) -> k /= formatKey) infos of + (_, []) -> fail "No radiance format specified" + (info, [(_, formatString)]) -> + case runGet get $ L.fromChunks [formatString] of + Left err -> fail err + Right format -> do + (n1, n2, b) <- (,,) <$> decodeNum + <*> decodeNum + <*> getRemainingBytes + return . RadianceHeader info format n1 n2 $ L.fromChunks [b] + + _ -> fail "Multiple radiance format specified" + +toFloat :: RGBE -> PixelRGBF +toFloat (RGBE r g b e) = PixelRGBF rf gf bf + where f = encodeFloat 1 $ fromIntegral e - (128 + 8) + rf = (fromIntegral r + 0.0) * f + gf = (fromIntegral g + 0.0) * f + bf = (fromIntegral b + 0.0) * f + +encodeScanlineColor :: M.STVector s Word8 + -> M.STVector s Word8 + -> Int + -> ST s Int +encodeScanlineColor vec outVec outIdx = do + val <- vec `M.unsafeRead` 0 + runLength 1 0 val 1 outIdx + where maxIndex = M.length vec + + pushRun len val at = do + (outVec `M.unsafeWrite` at) $ fromIntegral $ len .|. 0x80 + (outVec `M.unsafeWrite` (at + 1)) val + return $ at + 2 + + pushData start len at = do + (outVec `M.unsafeWrite` at) $ fromIntegral len + let first = start - len + end = start - 1 + offset = at - first + 1 + forM_ [first .. end] $ \i -> do + v <- vec `M.unsafeRead` i + (outVec `M.unsafeWrite` (offset + i)) v + + return $ at + len + 1 + + -- End of scanline, empty the thing + runLength run cpy prev idx at | idx >= maxIndex = + case (run, cpy) of + (0, 0) -> pure at + (0, n) -> pushData idx n at + (n, 0) -> pushRun n prev at + (_, _) -> error "HDR - Run length algorithm is wrong" + + -- full runlength, we must write the packet + runLength r@127 _ prev idx at = do + val <- vec `M.unsafeRead` idx + pushRun r prev at >>= + runLength 1 0 val (idx + 1) + + -- full copy, we must write the packet + runLength _ c@127 _ idx at = do + val <- vec `M.unsafeRead` idx + pushData idx c at >>= + runLength 1 0 val (idx + 1) + + runLength n 0 prev idx at = do + val <- vec `M.unsafeRead` idx + case val == prev of + True -> runLength (n + 1) 0 prev (idx + 1) at + False | n < 4 -> runLength 0 (n + 1) val (idx + 1) at + False -> + pushRun n prev at >>= + runLength 1 0 val (idx + 1) + + runLength 0 n prev idx at = do + val <- vec `M.unsafeRead` idx + if val /= prev + then runLength 0 (n + 1) val (idx + 1) at + else + pushData (idx - 1) (n - 1) at >>= + runLength (2 :: Int) 0 val (idx + 1) + + runLength _ _ _ _ _ = + error "HDR RLE inconsistent state" + +-- | Write an High dynamic range image into a radiance +-- image file on disk. +writeHDR :: FilePath -> Image PixelRGBF -> IO () +writeHDR filename img = L.writeFile filename $ encodeHDR img + +-- | Write a RLE encoded High dynamic range image into a radiance +-- image file on disk. +writeRLENewStyleHDR :: FilePath -> Image PixelRGBF -> IO () +writeRLENewStyleHDR filename img = + L.writeFile filename $ encodeRLENewStyleHDR img + +-- | Encode an High dynamic range image into a radiance image +-- file format. +-- Alias for encodeRawHDR +encodeHDR :: Image PixelRGBF -> L.ByteString +encodeHDR = encodeRawHDR + +-- | Encode an High dynamic range image into a radiance image +-- file format. without compression +encodeRawHDR :: Image PixelRGBF -> L.ByteString +encodeRawHDR pic = encode descriptor + where + newImage = pixelMap rgbeInRgba pic + -- we are cheating to death here, the layout we want + -- correspond to the layout of pixelRGBA8, so we + -- convert + rgbeInRgba pixel = PixelRGBA8 r g b e + where RGBE r g b e = toRGBE pixel + + descriptor = RadianceHeader + { radianceInfos = [] + , radianceFormat = FormatRGBE + , radianceHeight = imageHeight pic + , radianceWidth = imageWidth pic + , radianceData = L.fromChunks [toByteString $ imageData newImage] + } + + +-- | Encode an High dynamic range image into a radiance image +-- file format using a light RLE compression. Some problems +-- seem to arise with some image viewer. +encodeRLENewStyleHDR :: Image PixelRGBF -> L.ByteString +encodeRLENewStyleHDR pic = encode $ runST $ do + let w = imageWidth pic + h = imageHeight pic + + scanLineR <- M.new w :: ST s (M.STVector s Word8) + scanLineG <- M.new w + scanLineB <- M.new w + scanLineE <- M.new w + + encoded <- + forM [0 .. h - 1] $ \line -> do + buff <- M.new $ w * 4 + w `div` 127 + 2 + let columner col | col >= w = return () + columner col = do + let RGBE r g b e = toRGBE $ pixelAt pic col line + (scanLineR `M.unsafeWrite` col) r + (scanLineG `M.unsafeWrite` col) g + (scanLineB `M.unsafeWrite` col) b + (scanLineE `M.unsafeWrite` col) e + + columner (col + 1) + + columner 0 + + (buff `M.unsafeWrite` 0) 2 + (buff `M.unsafeWrite` 1) 2 + (buff `M.unsafeWrite` 2) $ fromIntegral ((w .>>. 8) .&. 0xFF) + (buff `M.unsafeWrite` 3) $ fromIntegral (w .&. 0xFF) + + i1 <- encodeScanlineColor scanLineR buff 4 + i2 <- encodeScanlineColor scanLineG buff i1 + i3 <- encodeScanlineColor scanLineB buff i2 + endIndex <- encodeScanlineColor scanLineE buff i3 + + (\v -> blitVector v 0 endIndex) <$> V.unsafeFreeze buff + + pure RadianceHeader + { radianceInfos = [] + , radianceFormat = FormatRGBE + , radianceHeight = h + , radianceWidth = w + , radianceData = L.fromChunks encoded + } + + +decodeRadiancePicture :: RadianceHeader -> HDRReader s (MutableImage s PixelRGBF) +decodeRadiancePicture hdr = do + let width = abs $ radianceWidth hdr + height = abs $ radianceHeight hdr + packedData = radianceData hdr + + scanLine <- lift $ M.new $ width * 4 + resultBuffer <- lift $ M.new $ width * height * 3 + + let scanLineImage = MutableImage + { mutableImageWidth = width + , mutableImageHeight = 1 + , mutableImageData = scanLine + } + + finalImage = MutableImage + { mutableImageWidth = width + , mutableImageHeight = height + , mutableImageData = resultBuffer + } + + let scanLineExtractor readIdx line = do + let color = unpackColor packedData readIdx + inner | isNewRunLengthMarker color = do + let calcSize = checkLineLength color + when (calcSize /= width) + (throwE "Invalid sanline size") + pure $ \idx -> newStyleRLE packedData (idx + 4) + | otherwise = pure $ oldStyleRLE packedData + f <- inner + newRead <- f readIdx scanLine + forM_ [0 .. width - 1] $ \i -> do + -- mokay, it's a hack, but I don't want to define a + -- pixel instance of RGBE... + PixelRGBA8 r g b e <- lift $ readPixel scanLineImage i 0 + lift $ writePixel finalImage i line . toFloat $ RGBE r g b e + + return newRead + + foldM_ scanLineExtractor 0 [0 .. height - 1] + + return finalImage +
src/Codec/Picture/Jpg.hs view
@@ -31,7 +31,9 @@ import Control.Monad.Trans.RWS.Strict( RWS, modify, tell, gets, execRWS ) import Data.Bits( (.|.), unsafeShiftL ) +#if !MIN_VERSION_base(4,11,0) import Data.Monoid( (<>) ) +#endif import Data.Int( Int16, Int32 ) import Data.Word(Word8, Word32) import Data.Binary( Binary(..), encode ) @@ -309,7 +311,7 @@ scanSpecifier scanCount scanSpec = do compMapping <- gets componentIndexMapping comp <- case lookup (componentSelector scanSpec) compMapping of - Nothing -> fail "Jpg decoding error - bad component selector in blob." + Nothing -> error "Jpg decoding error - bad component selector in blob." Just v -> return v let maximumHuffmanTable = 4 dcIndex = min (maximumHuffmanTable - 1) @@ -326,7 +328,7 @@ frameInfo <- gets currentFrame blobId <- gets seenBlobs case frameInfo of - Nothing -> fail "Jpg decoding error - no previous frame" + Nothing -> error "Jpg decoding error - no previous frame" Just v -> do let compDesc = jpgComponents v !! comp compCount = length $ jpgComponents v
src/Codec/Picture/Jpg/Internal/Types.hs view
@@ -34,7 +34,11 @@ import Control.Monad.ST( ST ) import Data.Bits( (.|.), (.&.), unsafeShiftL, unsafeShiftR ) import Data.List( partition ) + +#if !MIN_VERSION_base(4,11,0) import Data.Monoid( (<>) ) +#endif + import Foreign.Storable ( Storable ) import Data.Vector.Unboxed( (!) ) import qualified Data.Vector as V
src/Codec/Picture/Png.hs view
@@ -36,7 +36,11 @@ import Control.Arrow( first ) import Control.Monad( forM_, foldM_, when, void ) import Control.Monad.ST( ST, runST ) + +#if !MIN_VERSION_base(4,11,0) import Data.Monoid( (<>) ) +#endif + import Data.Binary( Binary( get) ) import qualified Data.Vector.Storable as V
src/Codec/Picture/Png/Internal/Export.hs view
@@ -19,7 +19,9 @@ import Control.Monad.ST( ST, runST ) import Data.Bits( unsafeShiftR, (.&.) ) import Data.Binary( encode ) +#if !MIN_VERSION_base(4,11,0) import Data.Monoid( (<>) ) +#endif import Data.Word(Word8, Word16) import qualified Codec.Compression.Zlib as Z import qualified Data.ByteString as B
src/Codec/Picture/Png/Internal/Metadata.hs view
@@ -16,7 +16,9 @@ import Data.Binary.Get( getLazyByteStringNul ) import Data.Binary.Put( putLazyByteString, putWord8 ) import qualified Data.ByteString.Lazy.Char8 as L +#if !MIN_VERSION_base(4,11,0) import Data.Monoid( (<>) ) +#endif import Codec.Picture.InternalHelper import qualified Codec.Picture.Metadata as Met
src/Codec/Picture/Tiff/Internal/Metadata.hs view
@@ -16,7 +16,9 @@ import Data.List( sortBy ) import Data.Function( on ) import qualified Data.Foldable as F +#if !MIN_VERSION_base(4,11,0) import Data.Monoid( (<>) ) +#endif import Codec.Picture.Metadata( Metadatas ) import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as BC
src/Codec/Picture/Types.hs view
@@ -109,8 +109,9 @@ import Data.Monoid( Monoid, mempty ) import Control.Applicative( Applicative, pure, (<*>), (<$>) ) #endif - +#if !MIN_VERSION_base(4,11,0) import Data.Monoid( (<>) ) +#endif import Control.Monad( foldM, liftM, ap ) import Control.DeepSeq( NFData( .. ) ) import Control.Monad.ST( ST, runST )