JuicyPixels 3.3.3.1 → 3.3.4

raw patch · 5 files changed

+116/−24 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• JuicyPixels.cabal +1/−1
• changelog +7/−0
• src/Codec/Picture.hs +45/−0
• src/Codec/Picture/Png/Internal/Metadata.hs +36/−7
• src/Codec/Picture/Types.hs +27/−16

@@ -1,5 +1,5 @@ Name:                JuicyPixels
-Version:             3.3.3.1
+Version:             3.3.4
 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==>>

@@ -1,6 +1,13 @@ Change log
 ==========
 
+v3.3.4 September 2019
+---------------------
+
+ * support reading compressed zTXt metadata from PNG files (claudeha)
+ * Add helper functions to convert a DynamicImage to RGB16 (uglyoldbob)
+ * Fix RGB to CMYK conversion (lehins)
+
 v3.3.3.1 June 2019
 ------------------
 

@@ -32,6 +32,7 @@ 
                       -- * RGB helper functions
                      , convertRGB8
+                     , convertRGB16
                      , convertRGBA8
 
                      -- * Lens compatibility
@@ -295,6 +296,13 @@ decimateWord16 (Image w h da) =
   Image w h $ VS.map (\v -> fromIntegral $ v `unsafeShiftR` 8) da
 
+decimateWord3216 :: ( Pixel px1, Pixel px2
+                  , PixelBaseComponent px1 ~ Pixel32
+                  , PixelBaseComponent px2 ~ Pixel16
+                  ) => Image px1 -> Image px2
+decimateWord3216 (Image w h da) =
+  Image w h $ VS.map (\v -> fromIntegral $ v `unsafeShiftR` 16) da
+  
 decimateWord32 :: ( Pixel px1, Pixel px2
                   , PixelBaseComponent px1 ~ Pixel32
                   , PixelBaseComponent px2 ~ Pixel8
@@ -309,9 +317,19 @@ decimateFloat (Image w h da) =
   Image w h $ VS.map (floor . (255*) . max 0 . min 1) da
 
+decimateFloat16 :: ( Pixel px1, Pixel px2
+                 , PixelBaseComponent px1 ~ PixelF
+                 , PixelBaseComponent px2 ~ Pixel16
+                 ) => Image px1 -> Image px2
+decimateFloat16 (Image w h da) =
+  Image w h $ VS.map (floor . (65535*) . max 0 . min 1) da
+
 instance Decimable Pixel16 Pixel8 where
    decimateBitDepth = decimateWord16
 
+instance Decimable Pixel32 Pixel16 where
+   decimateBitDepth = decimateWord3216
+
 instance Decimable Pixel32 Pixel8 where
    decimateBitDepth = decimateWord32
 
@@ -330,9 +348,15 @@ instance Decimable PixelF Pixel8 where
    decimateBitDepth = decimateFloat
 
+instance Decimable PixelF Pixel16 where
+   decimateBitDepth = decimateFloat16
+
 instance Decimable PixelRGBF PixelRGB8 where
    decimateBitDepth = decimateFloat
 
+instance Decimable PixelRGBF PixelRGB16 where
+   decimateBitDepth = decimateFloat16
+
 -- | Convert by any means possible a dynamic image to an image
 -- in RGBA. The process can lose precision while converting from
 -- 16bits pixels or Floating point pixels.
@@ -374,6 +398,27 @@   ImageYCbCr8 img -> convertImage img
   ImageCMYK8  img -> convertImage img
   ImageCMYK16 img -> convertImage (decimateBitDepth img :: Image PixelCMYK8)
+  
+-- | Convert by any means possible a dynamic image to an image
+-- in RGB. The process can lose precision while converting from
+-- 32bits pixels or Floating point pixels. Any alpha layer will
+-- be dropped
+convertRGB16 :: DynamicImage -> Image PixelRGB16
+convertRGB16 dynImage = case dynImage of
+  ImageY8     img -> promoteImage img
+  ImageY16    img -> promoteImage img
+  ImageY32    img -> promoteImage (decimateBitDepth img :: Image Pixel16)
+  ImageYF     img -> promoteImage (decimateBitDepth img :: Image Pixel16)
+  ImageYA8    img -> promoteImage img
+  ImageYA16   img -> promoteImage img
+  ImageRGB8   img -> promoteImage img
+  ImageRGB16  img -> img
+  ImageRGBF   img -> decimateBitDepth img :: Image PixelRGB16
+  ImageRGBA8  img -> dropAlphaLayer (promoteImage img :: Image PixelRGBA16)
+  ImageRGBA16 img -> dropAlphaLayer img
+  ImageYCbCr8 img -> promoteImage (convertImage img :: Image PixelRGB8)
+  ImageCMYK8  img -> promoteImage (convertImage img :: Image PixelRGB8)
+  ImageCMYK16 img -> convertImage img
 
 -- | Equivalent to 'decodeImage', but also provide potential metadatas
 -- present in the given file and the palettes if the format provides them.

@@ -13,13 +13,15 @@ 
 import Data.Maybe( fromMaybe )
 import Data.Binary( Binary( get, put ), encode )
-import Data.Binary.Get( getLazyByteStringNul )
+import Data.Binary.Get( getLazyByteStringNul, getWord8 )
 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 qualified Codec.Compression.Zlib as Z
+
 import Codec.Picture.InternalHelper
 import qualified Codec.Picture.Metadata as Met
 import Codec.Picture.Metadata ( Metadatas
@@ -68,8 +70,26 @@     putWord8 0
     putLazyByteString pdata
 
-textToMetadata :: PngText -> Metadatas
-textToMetadata ptext = case pngKeyword ptext of
+data PngZText = PngZText
+  { pngZKeyword :: !L.ByteString
+  , pngZData    :: !L.ByteString
+  }
+  deriving Show
+
+instance Binary PngZText where
+  get = PngZText <$> getLazyByteStringNul <* getCompressionType <*> (Z.decompress <$> getRemainingLazyBytes)
+    where
+      getCompressionType = do
+        0 <- getWord8
+        return ()
+  put (PngZText kw pdata) = do
+    putLazyByteString kw
+    putWord8 0
+    putWord8 0 -- compression type
+    putLazyByteString (Z.compress pdata)
+
+aToMetadata :: (a -> L.ByteString) -> (a -> L.ByteString) -> a -> Metadatas
+aToMetadata pkeyword pdata ptext = case pkeyword ptext of
   "Title" -> strValue Met.Title
   "Author" -> strValue Met.Author
   "Description" -> strValue Met.Description
@@ -83,18 +103,27 @@   other -> 
     Met.singleton
       (Met.Unknown $ L.unpack other)
-      (Met.String . L.unpack $ pngData ptext)
+      (Met.String . L.unpack $ pdata ptext)
   where
-    strValue k = Met.singleton k . L.unpack $ pngData ptext
+    strValue k = Met.singleton k . L.unpack $ pdata ptext
 
+textToMetadata :: PngText -> Metadatas
+textToMetadata = aToMetadata pngKeyword pngData
+
+ztxtToMetadata :: PngZText -> Metadatas
+ztxtToMetadata = aToMetadata pngZKeyword pngZData
+
 getTexts :: [L.ByteString] -> Metadatas
-getTexts = foldMap (eitherFoldMap textToMetadata . runGet get) where
- 
+getTexts = foldMap (eitherFoldMap textToMetadata . runGet get)
 
+getZTexts :: [L.ByteString] -> Metadatas
+getZTexts = foldMap (eitherFoldMap ztxtToMetadata . runGet get)
+
 extractMetadatas :: PngRawImage -> Metadatas
 extractMetadatas img = getDpis (chunksOf pHYsSignature)
                     <> getGamma (chunksOf gammaSignature)
                     <> getTexts (chunksOf tEXtSignature)
+                    <> getZTexts (chunksOf zTXtSignature)
   where
     chunksOf = chunksWithSig img
 

@@ -1248,6 +1248,10 @@     {-# INLINE promotePixel #-}
     promotePixel c = PixelRGB8 c c c
 
+instance ColorConvertible Pixel8 PixelRGB16 where
+    {-# INLINE promotePixel #-}
+    promotePixel c = PixelRGB16 (fromIntegral c * 257) (fromIntegral c * 257) (fromIntegral c * 257)
+
 instance ColorConvertible Pixel8 PixelRGBA8 where
     {-# INLINE promotePixel #-}
     promotePixel c = PixelRGBA8 c c c 255
@@ -1424,6 +1428,10 @@     {-# INLINE promotePixel #-}
     promotePixel (PixelYA8 y _) = PixelRGB8 y y y
 
+instance ColorConvertible PixelYA8 PixelRGB16 where
+    {-# INLINE promotePixel #-}
+    promotePixel (PixelYA8 y _) = PixelRGB16 (fromIntegral y * 257) (fromIntegral y * 257) (fromIntegral y * 257)
+
 instance ColorConvertible PixelYA8 PixelRGBA8 where
     {-# INLINE promotePixel #-}
     promotePixel (PixelYA8 y a) = PixelRGBA8 y y y a
@@ -1494,6 +1502,10 @@     unsafeWritePixel v idx (PixelYA16 y a) =
         M.unsafeWrite v idx y >> M.unsafeWrite v (idx + 1) a
 
+instance ColorConvertible PixelYA16 PixelRGB16 where
+    {-# INLINE promotePixel #-}
+    promotePixel (PixelYA16 y _) = PixelRGB16 y y y
+
 instance ColorConvertible PixelYA16 PixelRGBA16 where
     {-# INLINE promotePixel #-}
     promotePixel (PixelYA16 y a) = PixelRGBA16 y y y a
@@ -2244,26 +2256,25 @@                                  -> (Word8, Word8, Word8) -> b #-}
 {-# SPECIALIZE integralRGBToCMYK :: (Word16 -> Word16 -> Word16 -> Word16 -> b)
                                  -> (Word16, Word16, Word16) -> b #-}
+-- | Convert RGB8 or RGB16 to CMYK8 and CMYK16 respectfully.
+--
+-- /Note/ - 32bit precision is not supported. Make sure to adjust implementation if ever
+-- used with Word32.
 integralRGBToCMYK :: (Bounded a, Integral a)
                   => (a -> a -> a -> a -> b)    -- ^ Pixel building function
                   -> (a, a, a)                  -- ^ RGB sample
                   -> b                          -- ^ Resulting sample
-integralRGBToCMYK build (r, g, b) =
-  build (clamp c) (clamp m) (clamp y) (fromIntegral kInt)
-    where maxi = maxBound
-
-          ir = fromIntegral $ maxi - r :: Int
-          ig = fromIntegral $ maxi - g
-          ib = fromIntegral $ maxi - b
-
-          kInt = minimum [ir, ig, ib]
-          ik = fromIntegral maxi - kInt
-
-          c = (ir - kInt) `div` ik
-          m = (ig - kInt) `div` ik
-          y = (ib - kInt) `div` ik
-
-          clamp = fromIntegral . max 0
+integralRGBToCMYK build (r, g, b)
+  | kMax == 0 = build 0 0 0 maxVal -- prevent division by zero
+  | otherwise = build (fromIntegral c) (fromIntegral m) (fromIntegral y) k
+    where maxVal = maxBound
+          max32 = fromIntegral maxVal :: Word32
+          kMax32 = fromIntegral kMax :: Word32
+          kMax = max r (max g b)
+          k = maxVal - kMax
+          c = max32 * (kMax32 - fromIntegral r) `div` kMax32
+          m = max32 * (kMax32 - fromIntegral g) `div` kMax32
+          y = max32 * (kMax32 - fromIntegral b) `div` kMax32
 
 instance ColorSpaceConvertible PixelRGB8 PixelCMYK8 where
   convertPixel (PixelRGB8 r g b) = integralRGBToCMYK PixelCMYK8 (r, g, b)