JuicyPixels 2.0.1 → 2.0.2
raw patch · 4 files changed
+147/−90 lines, 4 filesdep ~primitivedep ~vectorPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: primitive, vector
API changes (from Hackage documentation)
+ Codec.Picture.Gif: instance Serialize GraphicControlExtension
Files
- Codec/Picture/Gif.hs +125/−26
- Codec/Picture/Gif/LZW.hs +12/−6
- JuicyPixels.cabal +10/−4
- README.md +0/−54
Codec/Picture/Gif.hs view
@@ -23,7 +23,7 @@ , getBytes , lookAhead {-, decode-} - {-, remaining-} + , remaining {-, Put-} {-, putWord8-} @@ -137,10 +137,12 @@ extensionIntroducer = 0x21 gifTrailer = 0x3B -{-commentLabel, graphicControlLabel, graphicControlLabel,-} - {-applicationLabel :: Word8-} +graphicControlLabel :: Word8 +graphicControlLabel = 0xF9 + +--commentLabel, graphicControlLabel, applicationLabel +-- {-commentLabel = 0xFE-} -{-graphicControlLabel = 0xF9-} {-plainTextLabel = 0x01-} {-applicationLabel = 0xFF-} @@ -149,6 +151,31 @@ where aux 0 = pure [] aux size = (:) <$> getBytes (fromIntegral size) <*> (getWord8 >>= aux) +data GraphicControlExtension = GraphicControlExtension + { gceDisposalMethod :: !Word8 -- ^ Stored on 3 bits + , gceUserInputFlag :: !Bool + , gceTransparentFlag :: !Bool + , gceDelay :: !Word16 + , gceTransparentColorIndex :: !Word8 + } + +instance Serialize GraphicControlExtension where + put _ = undefined + get = do + _extensionLabel <- getWord8 + _size <- getWord8 + packedFields <- getWord8 + delay <- getWord16le + idx <- getWord8 + _blockTerminator <- getWord8 + return GraphicControlExtension + { gceDisposalMethod = (packedFields `shiftR` 2) .&. 0x07 + , gceUserInputFlag = packedFields `testBit` 1 + , gceTransparentFlag = packedFields `testBit` 0 + , gceDelay = delay + , gceTransparentColorIndex = idx + } + data GifImage = GifImage { imgDescriptor :: !ImageDescriptor , imgLocalPalette :: !(Maybe Palette) @@ -160,22 +187,32 @@ put _ = undefined get = do desc <- get - let paletteSize = gDescLocalColorTableSize desc - palette <- if paletteSize > 0 - then Just <$> getPalette paletteSize + let hasLocalColorTable = gDescHasLocalMap desc + palette <- if hasLocalColorTable + then Just <$> getPalette (gDescLocalColorTableSize desc) else pure Nothing GifImage desc palette <$> getWord8 <*> parseDataBlocks -parseGifBlocks :: Get [GifImage] +data Block = BlockImage GifImage + | BlockGraphicControl GraphicControlExtension + +parseGifBlocks :: Get [Block] parseGifBlocks = lookAhead getWord8 >>= blockParse where blockParse v | v == gifTrailer = getWord8 >> pure [] - | v == imageSeparator = (:) <$> get <*> parseGifBlocks - | v == extensionIntroducer = - getWord8 >> getWord8 >> parseDataBlocks >> parseGifBlocks - blockParse v = fail ("Unrecognize gif block " ++ show v) + | v == imageSeparator = (:) <$> (BlockImage <$> get) <*> parseGifBlocks + | v == extensionIntroducer = do + _ <- getWord8 + extensionCode <- lookAhead getWord8 + if extensionCode /= graphicControlLabel + then getWord8 >> parseDataBlocks >> parseGifBlocks + else (:) <$> (BlockGraphicControl <$> get) <*> parseGifBlocks + blockParse v = do + remain <- remaining + fail ("Unrecognized gif block " ++ show v ++ " remaining: " ++ show remain) + instance Serialize ImageDescriptor where put _ = undefined get = do @@ -229,29 +266,36 @@ } data GifFile = GifFile - { gifHeader :: !GifHeader - , gifImages :: [GifImage] + { gifHeader :: !GifHeader + , gifImages :: [(Maybe GraphicControlExtension, GifImage)] } +associateDescr :: [Block] -> [(Maybe GraphicControlExtension, GifImage)] +associateDescr [] = [] +associateDescr [BlockGraphicControl _] = [] +associateDescr (BlockGraphicControl _ : rest@(BlockGraphicControl _ : _)) = associateDescr rest +associateDescr (BlockImage img:xs) = (Nothing, img) : associateDescr xs +associateDescr (BlockGraphicControl ctrl : BlockImage img : xs) = + (Just ctrl, img) : associateDescr xs + instance Serialize GifFile where put _ = undefined get = do hdr <- get - images <- parseGifBlocks - + blocks <- parseGifBlocks return GifFile { gifHeader = hdr - , gifImages = images } + , gifImages = associateDescr blocks } substituteColors :: Palette -> Image Pixel8 -> Image PixelRGB8 substituteColors palette = pixelMap swaper where swaper n = palette V.! (fromIntegral n) -decodeImage :: Palette -> GifImage -> Image PixelRGB8 -decodeImage globalPalette img = runST $ runBoolReader $ do +decodeImage :: GifImage -> Image Pixel8 +decodeImage img = runST $ runBoolReader $ do outputVector <- lift . M.new $ width * height decodeLzw (imgData img) 12 lzwRoot outputVector frozenData <- lift $ V.unsafeFreeze outputVector - return $ substituteColors palette Image + return . deinterlaceGif $ Image { imageWidth = width , imageHeight = height , imageData = frozenData @@ -259,19 +303,74 @@ where lzwRoot = fromIntegral $ imgLzwRootSize img width = fromIntegral $ gDescImageWidth descriptor height = fromIntegral $ gDescImageHeight descriptor + isInterlaced = gDescIsInterlaced descriptor descriptor = imgDescriptor img - palette = case imgLocalPalette img of - Nothing -> globalPalette - Just p -> p + deinterlaceGif | not isInterlaced = id + | otherwise = deinterlaceGifImage + +deinterlaceGifImage :: Image Pixel8 -> Image Pixel8 +deinterlaceGifImage img@(Image { imageWidth = w, imageHeight = h }) = generateImage generator w h + where lineIndices = gifInterlacingIndices h + generator x y = pixelAt img x y' + where y' = lineIndices V.! y + +gifInterlacingIndices :: Int -> V.Vector Int +gifInterlacingIndices height = V.accum (\_ v -> v) (V.replicate height 0) indices + where indices = flip zip [0..] $ + concat [ [0, 8 .. height - 1] + , [4, 4 + 8 .. height - 1] + , [2, 2 + 4 .. height - 1] + , [1, 1 + 2 .. height - 1] + ] + +paletteOf :: Palette -> GifImage -> Palette +paletteOf global GifImage { imgLocalPalette = Nothing } = global +paletteOf _ GifImage { imgLocalPalette = Just p } = p + decodeAllGifImages :: GifFile -> [Image PixelRGB8] -decodeAllGifImages GifFile { gifHeader = GifHeader { gifGlobalMap = palette} - , gifImages = lst } = map (decodeImage palette) lst +decodeAllGifImages GifFile { gifImages = [] } = [] +decodeAllGifImages GifFile { gifHeader = GifHeader { gifGlobalMap = palette + , gifScreenDescriptor = wholeDescriptor + } + , gifImages = (_, firstImage) : rest } = map paletteApplyer $ + scanl generator (paletteOf palette firstImage, decodeImage firstImage) rest + where globalWidth = fromIntegral $ screenWidth wholeDescriptor + globalHeight = fromIntegral $ screenHeight wholeDescriptor + {-background = backgroundIndex wholeDescriptor-} + + paletteApplyer (pal, img) = substituteColors pal img + + generator (_, img1) (controlExt, img2@(GifImage { imgDescriptor = descriptor })) = + (paletteOf palette img2, generateImage pixeler globalWidth globalHeight) + where localWidth = fromIntegral $ gDescImageWidth descriptor + localHeight = fromIntegral $ gDescImageHeight descriptor + + left = fromIntegral $ gDescPixelsFromLeft descriptor + top = fromIntegral $ gDescPixelsFromTop descriptor + + isPixelInLocalImage x y = + x >= left && x < left + localWidth && y >= top && y < top + localHeight + + decoded = decodeImage img2 + + transparent :: Int + transparent = case controlExt of + Nothing -> 300 + Just ext -> if gceTransparentFlag ext + then fromIntegral $ gceTransparentColorIndex ext + else 300 + + pixeler x y + | isPixelInLocalImage x y && fromIntegral val /= transparent = val + where val = pixelAt decoded (x - left) (y - top) + pixeler x y = pixelAt img1 x y + decodeFirstGifImage :: GifFile -> Either String (Image PixelRGB8) decodeFirstGifImage GifFile { gifHeader = GifHeader { gifGlobalMap = palette} - , gifImages = (gif:_) } = Right $ decodeImage palette gif + , gifImages = ((_, gif):_) } = Right . substituteColors palette $ decodeImage gif decodeFirstGifImage _ = Left "No image in gif file" -- | Transform a raw gif image to an image, witout
Codec/Picture/Gif/LZW.hs view
@@ -28,7 +28,7 @@ {-# INLINE (.<-.) #-} (.<-.) :: (PrimMonad m, Storable a) => M.STVector (PrimState m) a -> Int -> a -> m () -(.<-.) = M.unsafeWrite -- M.write +(.<-.) = M.unsafeWrite -- M.write {-# INLINE (..<-..) #-} (..<-..) :: (MonadTrans t, PrimMonad m, Storable a) @@ -69,7 +69,9 @@ lzwSizeTable <- lift $ M.new tableEntryCount lift $ lzwSizeTable `M.set` 1 - let loop outWriteIdx writeIdx dicWriteIdx codeSize code + let maxWrite = M.length outVec + loop outWriteIdx writeIdx dicWriteIdx codeSize code + | outWriteIdx >= maxWrite = return () | code == endOfInfo = return () | code == clearCode = getNextCode startCodeSize >>= @@ -83,12 +85,16 @@ when (outWriteIdx /= 0) $ do firstVal <- lzwData ..!!!.. dataOffset (lzwData ..<-.. (dicWriteIdx - 1)) firstVal - - duplicateData lzwData outVec dataOffset dataSize outWriteIdx - duplicateData lzwData lzwData dataOffset dataSize dicWriteIdx - + + when (dicWriteIdx + dataSize <= maxDataSize) $ + duplicateData lzwData lzwData dataOffset dataSize dicWriteIdx + + (lzwSizeTable ..<-.. writeIdx) $ dataSize + 1 (lzwOffsetTable ..<-.. writeIdx) dicWriteIdx + + when (outWriteIdx + dataSize <= maxWrite) $ + duplicateData lzwData outVec dataOffset dataSize outWriteIdx getNextCode codeSize >>= loop (outWriteIdx + dataSize)
JuicyPixels.cabal view
@@ -1,10 +1,16 @@ Name: JuicyPixels -Version: 2.0.1 +Version: 2.0.2 Synopsis: Picture loading/serialization (in png, jpeg, bitmap and gif) Description: This library can load and store images in PNG/Bitmap and Jpeg, and read Gif images. . + Version 2.0.2 changelog: + . + * Decoding of interleaved gif image, and delta coded gif animation. + . + * Bumping dependencies. + . Version 2.0.1 changelog: . * Documentation enhancements. @@ -47,7 +53,7 @@ Source-Repository this Type: git Location: git://github.com/Twinside/Juicy.Pixels.git - Tag: v2.0.1 + Tag: v2.0.2 Library Default-Language: Haskell2010 @@ -66,8 +72,8 @@ cereal >= 0.3.3.0 && < 0.4, zlib >= 0.5.3.1 && < 0.6, transformers >= 0.2.2 && < 0.4, - vector >= 0.9 && < 1.0, - primitive >= 0.4 && < 0.5, + vector >= 0.10 && < 0.11, + primitive >= 0.5 && < 0.6, deepseq >= 1.1 && < 1.4 -- Modules not exported by this package.
− README.md
@@ -1,54 +0,0 @@-Juicy.Pixels -============ - -This library provide saving & loading of different picture formats for the -Haskell language. The aim of the library is to be as lightweight as possible, -you ask it to load an image, and it'l dump you a big Vector full of juicy -pixels. Or squared pixels, or whatever, as long as they're unboxed. - -Documentation -------------- -The library documentation can be accessed on [Hackage](http://hackage.haskell.org/package/JuicyPixels) - -REPA ----- -For the user of -[REPA](http://www.haskell.org/haskellwiki/Numeric_Haskell:_A_Repa_Tutorial), -check-out JuicyPixels-repa on -[GitHub](https://github.com/TomMD/JuicyPixels-repa) or -[Hackage](http://hackage.haskell.org/package/JuicyPixels-repa) - -Status ------- - - - PNG (.png) - * Reading - - 1,2,4,8 bits loading, Grayscale, 24bits, 24 bits with alpha, - interleaved & filtered (fully compliant with the standard, - tested against png suite). - - * Writing - - 8bits RGB (non interleaved) - - 8bits RGBA (non interleaved) - - 8bits greyscale (non interleaved) - - - Bitmap (.bmp) (mainly used as a debug output format) - * Reading - - 24bits (RGB) images - - * Writing - - 32bits (RGBA) per pixel images - - 24bits (RGB) per pixel images - - 8 bits greyscale (with palette) - - - Jpeg (.jpg, .jpeg) - * Reading non-interlaced baseline DCT image, seems to be OK - * Writing - - - Gif (.gif) - * Reading non-interlaced normal & animated Gif image - -_I love juicy pixels_ - -You can make [donations on this page](http://twinside.github.com/Juicy.Pixels/). -