packages feed

JuicyPixels 3.2.3 → 3.2.3.1

raw patch · 19 files changed

+151/−79 lines, 19 filesdep ~primitivePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: primitive

API changes (from Hackage documentation)

Files

JuicyPixels.cabal view
@@ -1,5 +1,5 @@ Name:                JuicyPixels
-Version:             3.2.3
+Version:             3.2.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.2.3
+    Tag:       v3.2.3.1
 
 Flag Mmap
     Description: Enable the file loading via mmap (memory map)
@@ -58,7 +58,7 @@                  zlib                >= 0.5.3.1 && < 0.6,
                  transformers        >= 0.2,
                  vector              >= 0.9     && < 0.11,
-                 primitive           >= 0.4     && < 0.6,
+                 primitive           >= 0.4     && < 0.7,
                  deepseq             >= 1.1     && < 1.5,
                  containers          >= 0.4.2   && < 0.6
 
changelog view
@@ -1,5 +1,10 @@ -*-change-log-*-
 
+v3.2.3.1 March 2015
+ * Bumping: primitive to allow 0.6
+ * Fix: BMP output generated wrong size (thanks to mtolly).
+ * Fix: 7.10.1 warning free
+
 v3.2.3 March 2015
  * Adding: Support for RGB in jpeg (yeah, that exist...)
  * Adding: Support of CMYK & YCrCbK color space in jpeg files.
src/Codec/Picture.hs view
@@ -126,7 +126,10 @@                      , imageFromUnsafePtr
                      ) where
 
+#if !MIN_VERSION_base(4,8,0)
 import Control.Applicative( (<$>) )
+#endif
+
 import Control.DeepSeq( NFData, deepseq )
 import qualified Control.Exception as Exc ( catch, IOException )
 import Codec.Picture.Bitmap( BmpEncodable, decodeBitmap
src/Codec/Picture/BitWriter.hs view
@@ -26,11 +26,10 @@                               ) where
 
 #if !MIN_VERSION_base(4,8,0)
-import Control.Applicative( (<*>) )
+import Control.Applicative( (<*>), (<$>) )
 #endif
 
 import Data.STRef
-import Control.Applicative( (<$>) )
 import Control.Monad( when )
 import Control.Monad.ST( ST )
 import qualified Control.Monad.Trans.State.Strict as S
src/Codec/Picture/Bitmap.hs view
@@ -384,8 +384,8 @@ 
           paletteSize = fromIntegral $ length palette
           bpp = bitsPerPixel (undefined :: pixel)
-          padding = linePadding bpp (imgWidth + 1)
-          imagePixelSize = fromIntegral $ (imgWidth + padding) * imgHeight * 4
+          padding = linePadding bpp imgWidth
+          imagePixelSize = fromIntegral $ (imgWidth * div bpp 8 + padding) * imgHeight
           hdr = BmpHeader {
               magicIdentifier = bitmapMagicIdentifier,
               fileSize = sizeofBmpHeader + sizeofBmpInfo + 4 * paletteSize + imagePixelSize,
src/Codec/Picture/ColorQuant.hs view
@@ -16,10 +16,9 @@     ) where
 
 #if !MIN_VERSION_base(4,8,0)
-import           Control.Applicative (Applicative (..))
+import           Control.Applicative (Applicative (..), (<$>))
 #endif
 
-import           Control.Applicative ((<$>))
 import           Data.Bits           (unsafeShiftL, unsafeShiftR, (.&.), (.|.))
 import           Data.List           (elemIndex)
 import           Data.Maybe          (fromMaybe)
src/Codec/Picture/Gif.hs view
@@ -22,10 +22,8 @@                          ) where
 
 #if !MIN_VERSION_base(4,8,0)
-import Control.Applicative( pure, (<*>) )
+import Control.Applicative( pure, (<*>), (<$>) )
 #endif
-
-import Control.Applicative( (<$>) )
 
 import Control.Monad( replicateM, replicateM_, unless )
 import Control.Monad.ST( runST )
src/Codec/Picture/Gif/LZW.hs view
@@ -1,7 +1,11 @@+{-# LANGUAGE CPP #-}
 module Codec.Picture.Gif.LZW( decodeLzw, decodeLzwTiff ) where
 
-import Data.Word( Word8 )
+#if !MIN_VERSION_base(4,8,0)
 import Control.Applicative( (<$>) )
+#endif
+
+import Data.Word( Word8 )
 import Control.Monad( when, unless )
 
 import Data.Bits( (.&.) )
src/Codec/Picture/Gif/LZWEncoding.hs view
@@ -2,10 +2,10 @@ module Codec.Picture.Gif.LZWEncoding( lzwEncode ) where
 
 #if !MIN_VERSION_base(4,8,0)
+import Control.Applicative( (<$>) )
 import Data.Monoid( mempty )
 #endif
 
-import Control.Applicative( (<$>) )
 import Control.Monad.ST( runST )
 import qualified Data.ByteString.Lazy as L
 import Data.Maybe( fromMaybe )
src/Codec/Picture/HDR.hs view
@@ -11,10 +11,8 @@                         ) where
 
 #if !MIN_VERSION_base(4,8,0)
-import Control.Applicative( pure, (<*>) )
+import Control.Applicative( pure, (<*>), (<$>) )
 #endif
-
-import Control.Applicative( (<$>) )
 
 import Data.Bits( Bits, (.&.), (.|.), unsafeShiftL, unsafeShiftR )
 import Data.Char( ord, chr, isDigit )
src/Codec/Picture/Jpg.hs view
@@ -13,10 +13,10 @@                         ) where
 
 #if !MIN_VERSION_base(4,8,0)
-import Control.Applicative( pure )
+import Control.Applicative( pure, (<$>) )
 #endif
 
-import Control.Applicative( (<|>), (<$>) )
+import Control.Applicative( (<|>) )
 
 import Control.Arrow( (>>>) )
 import Control.Monad( when, forM_ )
src/Codec/Picture/Jpg/Common.hs view
@@ -20,10 +20,9 @@     ) where
 
 #if !MIN_VERSION_base(4,8,0)
-import Control.Applicative( pure )
+import Control.Applicative( pure, (<$>) )
 #endif
 
-import Control.Applicative( (<$>) )
 import Control.Monad( replicateM, when )
 import Control.Monad.ST( ST, runST )
 import Data.Bits( unsafeShiftL, unsafeShiftR, (.&.) )
src/Codec/Picture/Jpg/FastDct.hs view
@@ -1,7 +1,11 @@+{-# LANGUAGE CPP #-}
 {-# LANGUAGE TypeFamilies #-}
 module Codec.Picture.Jpg.FastDct( referenceDct, fastDctLibJpeg ) where
 
+#if !MIN_VERSION_base(4,8,0)
 import Control.Applicative( (<$>) )
+#endif
+
 import Data.Int( Int16, Int32 )
 import Data.Bits( unsafeShiftR, unsafeShiftL )
 import Control.Monad.ST( ST )
src/Codec/Picture/Jpg/Progressive.hs view
@@ -9,10 +9,9 @@     ) where
 
 #if !MIN_VERSION_base(4,8,0)
-import Control.Applicative( pure )
+import Control.Applicative( pure, (<$>) )
 #endif
 
-import Control.Applicative( (<$>) )
 import Control.Monad( when, forM_ )
 import Control.Monad.ST( ST )
 import Control.Monad.Trans( lift )
src/Codec/Picture/Jpg/Types.hs view
@@ -25,10 +25,9 @@ 
 
 #if !MIN_VERSION_base(4,8,0)
-import Control.Applicative( pure, (<*>))
+import Control.Applicative( pure, (<*>), (<$>) )
 #endif
 
-import Control.Applicative( (<$>) )
 import Control.Monad( when, replicateM, forM, forM_, unless )
 import Control.Monad.ST( ST )
 import Data.Bits( (.|.), (.&.), unsafeShiftL, unsafeShiftR )
src/Codec/Picture/Png.hs view
@@ -3,6 +3,7 @@ {-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE CPP #-}
 -- | Module used for loading & writing \'Portable Network Graphics\' (PNG)
 -- files.
 --
@@ -25,7 +26,10 @@ 
                         ) where
 
+#if !MIN_VERSION_base(4,8,0)
 import Control.Applicative( (<$>) )
+#endif
+
 import Control.Monad( forM_, foldM_, when, void )
 import Control.Monad.ST( ST, runST )
 import Data.Binary( Binary( get) )
@@ -420,6 +424,52 @@                         opacity | fromIntegral ipx < maxi = Lb.index transpBuffer $ fromIntegral ipx
                                 | otherwise = 255]
 
+unparse :: PngIHdr -> Maybe PngPalette -> [Lb.ByteString] -> PngImageType
+        -> B.ByteString -> Either [Char] DynamicImage
+unparse ihdr _ t PngGreyscale bytes
+    | bitDepth ihdr == 1 = unparse ihdr (Just paletteRGB1) t PngIndexedColor bytes
+    | bitDepth ihdr == 2 = unparse ihdr (Just paletteRGB2) t PngIndexedColor bytes
+    | bitDepth ihdr == 4 = unparse ihdr (Just paletteRGB4) t PngIndexedColor bytes
+    | otherwise = toImage ihdr ImageY8 ImageY16 $ runST $ deinterlacer ihdr bytes
+
+unparse _ Nothing _ PngIndexedColor  _ = Left "no valid palette found"
+unparse ihdr _ _ PngTrueColour          bytes =
+  toImage ihdr ImageRGB8 ImageRGB16 $ runST $ deinterlacer ihdr bytes
+unparse ihdr _ _ PngGreyscaleWithAlpha  bytes =
+  toImage ihdr ImageYA8 ImageYA16 $ runST $ deinterlacer ihdr bytes
+unparse ihdr _ _ PngTrueColourWithAlpha bytes =
+  toImage ihdr ImageRGBA8 ImageRGBA16 $ runST $ deinterlacer ihdr bytes
+unparse ihdr (Just plte) transparency PngIndexedColor bytes =
+  palette8 ihdr plte transparency $ runST $ deinterlacer ihdr bytes
+
+toImage :: forall a pxWord8 pxWord16
+         . PngIHdr
+        -> (Image pxWord8 -> DynamicImage) -> (Image pxWord16 -> DynamicImage)
+        -> Either (V.Vector (PixelBaseComponent pxWord8))
+                  (V.Vector (PixelBaseComponent pxWord16))
+        -> Either a DynamicImage
+toImage hdr const1 const2 lr = Right $ case lr of
+    Left a -> const1 $ Image w h a
+    Right a -> const2 $ Image w h a
+  where
+    w = fromIntegral $ width hdr
+    h = fromIntegral $ height hdr
+
+palette8 :: PngIHdr -> PngPalette -> [Lb.ByteString] -> Either (V.Vector Word8) t
+         -> Either [Char] DynamicImage
+palette8 hdr palette transparency eimg = case (transparency, eimg) of
+  ([c], Left img) ->
+    Right . ImageRGBA8 . Image w h
+          $ applyPaletteWithTransparency palette c img
+  (_, Left img) ->
+    Right . ImageRGB8 . Image w h $ applyPalette palette img
+  (_, Right _) ->
+    Left "Invalid bit depth for paleted image"
+  where
+    w = fromIntegral $ width hdr
+    h = fromIntegral $ height hdr
+
+
 -- | Transform a raw png image to an image, without modifying the
 -- underlying pixel type. If the image is greyscale and < 8 bits,
 -- a transformation to RGBA8 is performed. This should change
@@ -447,56 +497,19 @@ decodePng :: B.ByteString -> Either String DynamicImage
 decodePng byte = do
     rawImg <- runGetStrict get byte
-    let ihdr@(PngIHdr { width = w, height = h }) = header rawImg
+    let ihdr = header rawImg
         compressedImageData =
               Lb.concat [chunkData chunk | chunk <- chunks rawImg
-                                        , chunkType chunk == iDATSignature]
+                                         , chunkType chunk == iDATSignature]
         zlibHeaderSize = 1 {- compression method/flags code -}
                        + 1 {- Additional flags/check bits -}
                        + 4 {-CRC-}
 
-        palette8 palette [c] (Left img) =
-            Right . ImageRGBA8
-                  . Image (fromIntegral w) (fromIntegral h)
-                  $ applyPaletteWithTransparency palette c img
-
-        palette8 palette _ (Left img) =
-            Right . ImageRGB8
-                  . Image (fromIntegral w) (fromIntegral h)
-                  $ applyPalette palette img
-
-        palette8 _ _ (Right _) = Left "Invalid bit depth for paleted image"
-
-        toImage :: forall a pxWord8 pxWord16
-                 . (Image pxWord8 -> DynamicImage) -> (Image pxWord16 -> DynamicImage)
-                -> Either (V.Vector (PixelBaseComponent pxWord8))
-                          (V.Vector (PixelBaseComponent pxWord16))
-                -> Either a DynamicImage
-        toImage const1 _const2 (Left a) =
-            Right . const1 $ Image (fromIntegral w) (fromIntegral h) a
-        toImage _const1 const2 (Right a) =
-            Right . const2 $ Image (fromIntegral w) (fromIntegral h) a
-
         transparencyColor =
             [ chunkData chunk | chunk <- chunks rawImg
                               , chunkType chunk == tRNSSignature ]
 
-        unparse _ t PngGreyscale bytes
-            | bitDepth ihdr == 1 = unparse (Just paletteRGB1) t PngIndexedColor bytes
-            | bitDepth ihdr == 2 = unparse (Just paletteRGB2) t PngIndexedColor bytes
-            | bitDepth ihdr == 4 = unparse (Just paletteRGB4) t PngIndexedColor bytes
-            | otherwise = toImage ImageY8 ImageY16 $ runST $ deinterlacer ihdr bytes
 
-        unparse Nothing _ PngIndexedColor  _ = Left "no valid palette found"
-        unparse _ _ PngTrueColour          bytes =
-            toImage ImageRGB8 ImageRGB16 $ runST $ deinterlacer ihdr bytes
-        unparse _ _ PngGreyscaleWithAlpha  bytes =
-            toImage ImageYA8 ImageYA16 $ runST $ deinterlacer ihdr bytes
-        unparse _ _ PngTrueColourWithAlpha bytes =
-            toImage ImageRGBA8 ImageRGBA16 $ runST $ deinterlacer ihdr bytes
-        unparse (Just plte) transparency PngIndexedColor bytes =
-            palette8 plte transparency $ runST $ deinterlacer ihdr bytes
-
     if Lb.length compressedImageData <= zlibHeaderSize
        then Left "Invalid data size"
        else let imgData = Z.decompress compressedImageData
@@ -506,5 +519,6 @@                     Just p -> case parsePalette p of
                             Left _ -> Nothing
                             Right plte -> Just plte
-            in unparse palette transparencyColor (colourType ihdr) parseableData
+            in
+            unparse ihdr palette transparencyColor (colourType ihdr) parseableData
 
src/Codec/Picture/Png/Type.hs view
@@ -1,9 +1,14 @@+{-# LANGUAGE CPP #-}
 -- | Low level png module, you should import 'Codec.Picture.Png' instead.
 module Codec.Picture.Png.Type( PngIHdr( .. )
                              , PngFilter( .. )
                              , PngInterlaceMethod( .. )
                              , PngPalette
                              , PngImageType( .. )
+                             , APngAnimationControl( .. )
+                             , APngFrameDisposal( .. )
+                             , APngBlendOp( .. )
+                             , APngFrameControl( .. )
                              , parsePalette 
                              , pngComputeCrc
                              , pLTESignature
@@ -11,6 +16,7 @@                              , iENDSignature
                              , tRNSSignature
                              , gammaSignature
+                             , animationControlSignature
                              -- * Low level types
                              , ChunkSignature
                              , PngRawImage( .. )
@@ -19,7 +25,10 @@                              , PngLowLevel( .. )
                              ) where
 
+#if !MIN_VERSION_base(4,8,0)
 import Control.Applicative( (<$>) )
+#endif
+
 import Control.Monad( when, replicateM )
 import Data.Bits( xor, (.&.), unsafeShiftR )
 import Data.Binary( Binary(..), Get, get )
@@ -35,7 +44,7 @@ import Data.Vector.Unboxed( Vector, fromListN, (!) )
 import qualified Data.Vector.Storable as V
 import Data.List( foldl' )
-import Data.Word( Word32, Word8 )
+import Data.Word( Word32, Word16, Word8 )
 import qualified Data.ByteString.Lazy as L
 import qualified Data.ByteString.Lazy.Char8 as LS
 
@@ -51,16 +60,59 @@ 
 -- | Generic header used in PNG images.
 data PngIHdr = PngIHdr
-    { width             :: Word32       -- ^ Image width in number of pixel
-    , height            :: Word32       -- ^ Image height in number of pixel
-    , bitDepth          :: Word8        -- ^ Number of bit per sample
-    , colourType        :: PngImageType -- ^ Kind of png image (greyscale, true color, indexed...)
-    , compressionMethod :: Word8        -- ^ Compression method used
-    , filterMethod      :: Word8        -- ^ Must be 0
-    , interlaceMethod   :: PngInterlaceMethod   -- ^ If the image is interlaced (for progressive rendering)
+    { width             :: !Word32       -- ^ Image width in number of pixel
+    , height            :: !Word32       -- ^ Image height in number of pixel
+    , bitDepth          :: !Word8        -- ^ Number of bit per sample
+    , colourType        :: !PngImageType -- ^ Kind of png image (greyscale, true color, indexed...)
+    , compressionMethod :: !Word8        -- ^ Compression method used
+    , filterMethod      :: !Word8        -- ^ Must be 0
+    , interlaceMethod   :: !PngInterlaceMethod   -- ^ If the image is interlaced (for progressive rendering)
     }
     deriving Show
 
+data APngAnimationControl = APngAnimationControl
+    { animationFrameCount :: !Word32
+    , animationPlayCount  :: !Word32
+    }
+    deriving Show
+
+-- | Encoded in a Word8
+data APngFrameDisposal
+      -- | No disposal is done on this frame before rendering the
+      -- next; the contents of the output buffer are left as is. 
+      -- Has Value 0
+    = APngDisposeNone
+      -- | The frame's region of the output buffer is to be cleared
+      -- to fully transparent black before rendering the next frame. 
+      -- Has Value 1
+    | APngDisposeBackground
+      -- | the frame's region of the output buffer is to be reverted
+      -- to the previous contents before rendering the next frame.
+      -- Has Value 2
+    | APngDisposePrevious 
+    deriving Show
+
+-- | Encoded in a Word8
+data APngBlendOp
+      -- | Overwrite output buffer. has value '0'
+    = APngBlendSource
+      -- | Alpha blend to the output buffer. Has value '1'
+    | APngBlendOver
+    deriving Show
+
+data APngFrameControl = APngFrameControl
+    { frameSequenceNum      :: !Word32 -- ^ Starting from 0
+    , frameWidth            :: !Word32 -- ^ Width of the following frame
+    , frameHeight           :: !Word32 -- ^ Height of the following frame
+    , frameLeft             :: !Word32 -- X position where to render the frame.
+    , frameTop              :: !Word32 -- Y position where to render the frame.
+    , frameDelayNumerator   :: !Word16
+    , frameDelayDenuminator :: !Word16
+    , frameDisposal         :: !APngFrameDisposal
+    , frameBlending         :: !APngBlendOp
+    }
+    deriving Show
+
 -- | What kind of information is encoded in the IDAT section
 -- of the PngFile
 data PngImageType =
@@ -296,6 +348,9 @@ 
 gammaSignature :: ChunkSignature
 gammaSignature = signature "gAMA"
+
+animationControlSignature :: ChunkSignature
+animationControlSignature = signature "acTL"
 
 instance Binary PngImageType where
     put PngGreyscale = putWord8 0
src/Codec/Picture/Tga.hs view
@@ -16,10 +16,8 @@ 
 #if !MIN_VERSION_base(4,8,0)
 import Data.Monoid( mempty )
-import Control.Applicative( (<*>), pure )
+import Control.Applicative( (<*>), pure, (<$>) )
 #endif
-
-import Control.Applicative( (<$>) )
 
 import Control.Monad.ST( ST, runST )
 import Data.Bits( (.&.)
src/Codec/Picture/Tiff.hs view
@@ -29,10 +29,8 @@ 
 
 #if !MIN_VERSION_base(4,8,0)
-import Control.Applicative( (<*>), pure )
+import Control.Applicative( (<$>), (<*>), pure )
 #endif
-
-import Control.Applicative( (<$>) )
 
 import Control.Monad( when, replicateM, foldM_, unless )
 import Control.Monad.ST( ST, runST )