JuicyPixels 3.2.9 → 3.2.9.1

raw patch · 5 files changed

+89/−40 lines, 5 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• JuicyPixels.cabal +2/−2
• README.md +2/−0
• changelog +5/−0
• src/Codec/Picture/Png.hs +2/−1
• src/Codec/Picture/Png/Export.hs +78/−37

@@ -1,5 +1,5 @@ Name:                JuicyPixels
-Version:             3.2.9
+Version:             3.2.9.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.9
+    Tag:       v3.2.9.1
 
 Flag Mmap
     Description: Enable the file loading via mmap (memory map)

@@ -41,6 +41,8 @@         - 16bits greyscale (non interleaved)
         - 16bits RGB (non interleaved)
         - 16bits RGBA (non interleaved)
+        - 8bits RGB paletted image
+        - 8bits RGBA paletted image
 
     * Metadata (reading/writing)
         * in a tEXT chunk: 'Title', 'Description', 'Author', 'Copyright',

@@ -1,6 +1,11 @@ Change log
 ==========
 
+v3.2.9.1 November 2017
+----------------------
+
+ * Feature: Paletted alpha png saving
+
 v3.2.9 November 2017
 ----------------------
 

@@ -17,7 +17,8 @@ --
 -- The loader has been validated against the pngsuite (http://www.libpng.org/pub/png/pngsuite.html)
 module Codec.Picture.Png( -- * High level functions
-                          PngSavable( .. )
+                          PngSavable( .. ),
+                          PngPaletteSaveable( .. )
 
                         , decodePng
                         , decodePngWithMetadata

@@ -6,11 +6,10 @@ -- | Module implementing a basic png export, no filtering is applyed, but
 -- export at least valid images.
 module Codec.Picture.Png.Export( PngSavable( .. )
+                               , PngPaletteSaveable( .. )
                                , writePng
                                , encodeDynamicPng
                                , writeDynamicPng
-                               , encodePalettedPng
-                               , encodePalettedPngWithMetadata
                                ) where
 #if !MIN_VERSION_base(4,8,0)
 import Data.Monoid( mempty )
@@ -35,6 +34,42 @@ import Codec.Picture.Metadata( Metadatas )
 import Codec.Picture.VectorByteConversion( blitVector, toByteString )
 
+-- | Encode a paletted image into a png if possible.
+class PngPaletteSaveable a where
+  -- | Encode a paletted image as a color indexed 8-bit PNG.
+  -- the palette must have between 1 and 256 values in it.
+  -- Accepts `PixelRGB8` and `PixelRGBA8` as palette pixel type
+  encodePalettedPng :: Image a -> Image Pixel8 -> Either String Lb.ByteString
+  encodePalettedPng = encodePalettedPngWithMetadata mempty
+
+  -- | Equivalent to 'encodePalettedPng' but allow writing of metadatas.
+  -- See `encodePngWithMetadata` for the details of encoded metadatas
+  -- Accepts `PixelRGB8` and `PixelRGBA8` as palette pixel type
+  encodePalettedPngWithMetadata :: Metadatas -> Image a -> Image Pixel8 -> Either String Lb.ByteString
+
+instance PngPaletteSaveable PixelRGB8 where
+  encodePalettedPngWithMetadata metas pal img
+      | w <= 0 || w > 256 || h /= 1 = Left "Invalid palette"
+      | VS.any isTooBig $ imageData img =
+          Left "Image contains indexes absent from the palette"
+      | otherwise = Right $ genericEncodePng (Just pal) Nothing PngIndexedColor metas img
+        where w = imageWidth pal
+              h = imageHeight pal
+              isTooBig v = fromIntegral v >= w
+
+instance PngPaletteSaveable PixelRGBA8 where
+  encodePalettedPngWithMetadata metas pal img
+      | w <= 0 || w > 256 || h /= 1 = Left "Invalid palette"
+      | VS.any isTooBig $ imageData img =
+          Left "Image contains indexes absent from the palette"
+      | otherwise = Right $ genericEncodePng (Just opaquePalette) (Just alphaPal) PngIndexedColor metas img
+    where
+      w = imageWidth pal
+      h = imageHeight pal
+      opaquePalette = dropAlphaLayer pal
+      alphaPal = imageData $ extractComponent PlaneAlpha pal
+      isTooBig v = fromIntegral v >= w
+
 -- | Encode an image into a png if possible.
 class PngSavable a where
     -- | Transform an image into a png encoded bytestring, ready
@@ -126,41 +161,63 @@   , chunkCRC    = pngComputeCrc [pLTESignature, binaryData]
   , chunkData   = binaryData
   }
-   where binaryData = Lb.fromChunks [toByteString $ imageData pal]
+  where binaryData = Lb.fromChunks [toByteString $ imageData pal]
 
+preparePaletteAlpha :: VS.Vector Pixel8 -> PngRawChunk
+preparePaletteAlpha alphaPal = PngRawChunk
+  { chunkLength = fromIntegral $ VS.length alphaPal
+  , chunkType   = tRNSSignature
+  , chunkCRC    = pngComputeCrc [tRNSSignature, binaryData]
+  , chunkData   = binaryData
+  }
+  where binaryData = Lb.fromChunks [toByteString alphaPal]
+
+type PaletteAlpha = VS.Vector Pixel8
+
 genericEncodePng :: forall px. (Pixel px, PixelBaseComponent px ~ Word8)
-                 => Maybe Palette -> PngImageType -> Metadatas -> Image px
+                 => Maybe Palette
+                 -> Maybe PaletteAlpha
+                 -> PngImageType -> Metadatas -> Image px
                  -> Lb.ByteString
-genericEncodePng palette imgKind metas
+genericEncodePng palette palAlpha imgKind metas
                  image@(Image { imageWidth = w, imageHeight = h, imageData = arr }) =
   encode PngRawImage { header = hdr
                      , chunks = encodeMetadatas metas
-                              <> prependPalette palette
-                                    [ prepareIDatChunk imgEncodedData
-                                    , endChunk]}
-    where hdr = preparePngHeader image imgKind 8
-          zero = B.singleton 0
-          compCount = componentCount (undefined :: px)
+                              <> paletteChunk
+                              <> transpChunk
+                              <> [ prepareIDatChunk imgEncodedData
+                                 , endChunk
+                                 ]}
+  where
+    hdr = preparePngHeader image imgKind 8
+    zero = B.singleton 0
+    compCount = componentCount (undefined :: px)
 
-          prependPalette Nothing l = l
-          prependPalette (Just p) l = preparePalette p : l
+    paletteChunk = case palette of
+      Nothing -> []
+      Just p -> [preparePalette p]
 
-          lineSize = compCount * w
-          encodeLine line = blitVector arr (line * lineSize) lineSize
-          imgEncodedData = Z.compress . Lb.fromChunks
-                        $ concat [[zero, encodeLine line] | line <- [0 .. h - 1]]
+    transpChunk = case palAlpha of
+      Nothing -> []
+      Just p -> [preparePaletteAlpha p]
 
+    lineSize = compCount * w
+    encodeLine line = blitVector arr (line * lineSize) lineSize
+    imgEncodedData = Z.compress
+        . Lb.fromChunks
+        $ concat [[zero, encodeLine line] | line <- [0 .. h - 1]]
+
 instance PngSavable PixelRGBA8 where
-  encodePngWithMetadata = genericEncodePng Nothing PngTrueColourWithAlpha
+  encodePngWithMetadata = genericEncodePng Nothing Nothing PngTrueColourWithAlpha
 
 instance PngSavable PixelRGB8 where
-  encodePngWithMetadata = genericEncodePng Nothing PngTrueColour
+  encodePngWithMetadata = genericEncodePng Nothing Nothing PngTrueColour
 
 instance PngSavable Pixel8 where
-  encodePngWithMetadata = genericEncodePng Nothing PngGreyscale
+  encodePngWithMetadata = genericEncodePng Nothing Nothing PngGreyscale
 
 instance PngSavable PixelYA8 where
-  encodePngWithMetadata = genericEncodePng Nothing PngGreyscaleWithAlpha
+  encodePngWithMetadata = genericEncodePng Nothing Nothing PngGreyscaleWithAlpha
 
 instance PngSavable PixelYA16 where
   encodePngWithMetadata = genericEncode16BitsPng PngGreyscaleWithAlpha
@@ -180,22 +237,6 @@ writeDynamicPng path img = case encodeDynamicPng img of
         Left err -> return $ Left err
         Right b  -> Lb.writeFile path b >> return (Right True)
-
--- | Encode a paletted image as a color indexed 8-bit PNG.
--- the palette must have between 1 and 256 values in it.
-encodePalettedPng :: Palette -> Image Pixel8 -> Either String Lb.ByteString
-encodePalettedPng = encodePalettedPngWithMetadata mempty
-
--- | Equivalent to 'encodePalettedPng' but allow writing of metadatas.
-encodePalettedPngWithMetadata :: Metadatas -> Palette -> Image Pixel8 -> Either String Lb.ByteString
-encodePalettedPngWithMetadata metas pal img
-    | w <= 0 || w > 256 || h /= 1 = Left "Invalid palette"
-    | VS.any isTooBig $ imageData img =
-        Left "Image contains indexes absent from the palette"
-    | otherwise = Right $ genericEncodePng (Just pal) PngIndexedColor metas img
-      where w = imageWidth pal
-            h = imageHeight pal
-            isTooBig v = fromIntegral v >= w
 
 -- | Encode a dynamic image in PNG if possible, supported images are:
 --