packages feed

JuicyPixels 1.3 → 2.0

raw patch · 10 files changed

+598/−509 lines, 10 filesdep ~zlibPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: zlib

API changes (from Hackage documentation)

+ Codec.Picture: decodeGif :: ByteString -> Either String DynamicImage
+ Codec.Picture: decodeGifImages :: ByteString -> Either String [Image PixelRGB8]
+ Codec.Picture: readGif :: FilePath -> IO (Either String DynamicImage)
+ Codec.Picture: readGifImages :: FilePath -> IO (Either String [Image PixelRGB8])
+ Codec.Picture.Gif: decodeGif :: ByteString -> Either String DynamicImage
+ Codec.Picture.Gif: decodeGifImages :: ByteString -> Either String [Image PixelRGB8]
+ Codec.Picture.Gif: instance Serialize GifFile
+ Codec.Picture.Gif: instance Serialize GifHeader
+ Codec.Picture.Gif: instance Serialize GifImage
+ Codec.Picture.Gif: instance Serialize GifVersion
+ Codec.Picture.Gif: instance Serialize ImageDescriptor
+ Codec.Picture.Gif: instance Serialize LogicalScreenDescriptor
+ Codec.Picture.Types: PlaneAlpha :: PlaneAlpha
+ Codec.Picture.Types: PlaneBlue :: PlaneBlue
+ Codec.Picture.Types: PlaneCb :: PlaneCb
+ Codec.Picture.Types: PlaneCr :: PlaneCr
+ Codec.Picture.Types: PlaneGreen :: PlaneGreen
+ Codec.Picture.Types: PlaneLuma :: PlaneLuma
+ Codec.Picture.Types: PlaneRed :: PlaneRed
+ Codec.Picture.Types: class ColorPlane pixel planeToken
+ Codec.Picture.Types: data PlaneAlpha
+ Codec.Picture.Types: data PlaneBlue
+ Codec.Picture.Types: data PlaneCb
+ Codec.Picture.Types: data PlaneCr
+ Codec.Picture.Types: data PlaneGreen
+ Codec.Picture.Types: data PlaneLuma
+ Codec.Picture.Types: data PlaneRed
+ Codec.Picture.Types: instance ColorPlane PixelRGB8 PlaneBlue
+ Codec.Picture.Types: instance ColorPlane PixelRGB8 PlaneGreen
+ Codec.Picture.Types: instance ColorPlane PixelRGB8 PlaneRed
+ Codec.Picture.Types: instance ColorPlane PixelRGBA8 PlaneAlpha
+ Codec.Picture.Types: instance ColorPlane PixelRGBA8 PlaneBlue
+ Codec.Picture.Types: instance ColorPlane PixelRGBA8 PlaneGreen
+ Codec.Picture.Types: instance ColorPlane PixelRGBA8 PlaneRed
+ Codec.Picture.Types: instance ColorPlane PixelYA8 PlaneAlpha
+ Codec.Picture.Types: instance ColorPlane PixelYA8 PlaneLuma
+ Codec.Picture.Types: instance ColorPlane PixelYCbCr8 PlaneCb
+ Codec.Picture.Types: instance ColorPlane PixelYCbCr8 PlaneCr
+ Codec.Picture.Types: instance ColorPlane PixelYCbCr8 PlaneLuma
+ Codec.Picture.Types: unsafeExtractComponent :: Pixel a => Int -> Image a -> Image Pixel8
- Codec.Picture.Types: extractComponent :: Pixel a => Int -> Image a -> Image Pixel8
+ Codec.Picture.Types: extractComponent :: (Pixel px, ColorPlane px plane) => plane -> Image px -> Image Pixel8

Files

Codec/Picture.hs view
@@ -33,6 +33,12 @@                      , encodeDynamicBitmap 
                      , writeDynamicBitmap 
 
+                     -- ** Gif handling
+                     , readGif
+                     , readGifImages
+                     , decodeGif
+                     , decodeGifImages
+
                      -- ** Jpeg handling
                      , readJpeg
                      , decodeJpeg 
@@ -69,6 +75,7 @@ import Codec.Picture.Jpg( decodeJpeg, encodeJpeg, encodeJpegAtQuality )
 import Codec.Picture.Png( PngSavable( .. ), decodePng, writePng
                         , encodeDynamicPng , writeDynamicPng )
+import Codec.Picture.Gif( decodeGif, decodeGifImages )
 import Codec.Picture.Saving
 import Codec.Picture.Types
 import System.IO ( withFile, IOMode(ReadMode) )
@@ -107,12 +114,22 @@ decodeImage :: B.ByteString -> Either String DynamicImage
 decodeImage str = eitherLoad str [("Jpeg", decodeJpeg)
                                  ,("PNG", decodePng)
+                                 ,("GIF", decodeGif)
                                  ,("Bitmap", decodeBitmap)
                                  ]
     
 -- | Helper function trying to load a png file from a file on disk.
 readPng :: FilePath -> IO (Either String DynamicImage)
 readPng = withImageDecoder decodePng 
+
+-- | Helper function trying to load a gif file from a file on disk.
+readGif :: FilePath -> IO (Either String DynamicImage)
+readGif = withImageDecoder decodeGif
+
+-- | Helper function trying to load all the images of an animated
+-- gif file.
+readGifImages :: FilePath -> IO (Either String [Image PixelRGB8])
+readGifImages = withImageDecoder decodeGifImages
 
 -- | Try to load a jpeg file and decompress. The colorspace is still
 -- YCbCr if you want to perform computation on the luma part. You can
Codec/Picture/BitWriter.hs view
@@ -4,16 +4,17 @@ module Codec.Picture.BitWriter( BoolWriter
                               , BoolReader
                               , writeBits
-                              , byteAlign
-                              , getNextBit
+                              , byteAlignJpg
+                              , getNextBits
+                              , getNextBitJpg
                               , setDecodedString
+                              , setDecodedStringJpg
                               , runBoolWriter
+                              , runBoolReader
                               ) where
 
 import Control.Monad( when )
-import Control.Monad.ST( ST
-                       -- , runST
-                       )
+import Control.Monad.ST( ST )
 import qualified Control.Monad.Trans.State.Strict as S
 import Control.Monad.Trans.Class( MonadTrans( .. ) )
 import Data.Word( Word8, Word32 )
@@ -39,32 +40,61 @@ -- | Type used to read bits
 type BoolReader s a = S.StateT BoolState (ST s) a
 
+runBoolReader :: BoolReader s a -> ST s a
+runBoolReader action = S.evalStateT action (0, 0, B.empty)
+
+-- | Bitify a list of things to decode.
+setDecodedString :: B.ByteString -> BoolReader s ()
+setDecodedString str = case B.uncons str of
+     Nothing        -> S.put (      0, 0, B.empty)
+     Just (v, rest) -> S.put (       0, v,    rest)
+
 -- | Drop all bit until the bit of indice 0, usefull to parse restart
 -- marker, as they are byte aligned, but Huffman might not.
-byteAlign :: BoolReader s ()
-byteAlign = do
+byteAlignJpg :: BoolReader s ()
+byteAlignJpg = do
   (idx, _, chain) <- S.get
-  when (idx /= 7) (setDecodedString chain)
+  when (idx /= 7) (setDecodedStringJpg chain)
 
--- | Return the next bit in the input stream.
+{-# INLINE getNextBitJpg #-}
+getNextBitJpg :: BoolReader s Bool
+getNextBitJpg = do
+    (idx, v, chain) <- S.get
+    let val = (v .&. (1 `shiftL` idx)) /= 0
+    if idx == 0
+      then setDecodedStringJpg chain
+      else S.put (idx - 1, v, chain)
+    return val
+
+{-# INLINE getNextBits #-}
+getNextBits :: Int -> BoolReader s Word32
+getNextBits count = aux 0 count
+  where aux acc 0 = return acc
+        aux acc n = do
+            bit <- getNextBit
+            let nextVal | bit = acc .|. (1 .<<. (count - n))
+                        | otherwise = acc
+            aux nextVal (n - 1)
+
 {-# INLINE getNextBit #-}
 getNextBit :: BoolReader s Bool
 getNextBit = do
     (idx, v, chain) <- S.get
     let val = (v .&. (1 `shiftL` idx)) /= 0
-    if idx == 0
+    if idx == 7
       then setDecodedString chain
-      else S.put (idx - 1, v, chain)
+      else S.put (idx + 1, v, chain)
     return val
 
--- | Bitify a list of things to decode.
-setDecodedString :: B.ByteString -> BoolReader s ()
-setDecodedString str = case B.uncons str of
+-- | Bitify a list of things to decode. Handle Jpeg escape
+-- code (0xFF 0x00), thus should be only used in JPEG decoding.
+setDecodedStringJpg :: B.ByteString -> BoolReader s ()
+setDecodedStringJpg str = case B.uncons str of
      Nothing        -> S.put (maxBound, 0, B.empty)
      Just (0xFF, rest) -> case B.uncons rest of
             Nothing                  -> S.put (maxBound, 0, B.empty)
             Just (0x00, afterMarker) -> S.put (7, 0xFF, afterMarker)
-            Just (_   , afterMarker) -> setDecodedString afterMarker
+            Just (_   , afterMarker) -> setDecodedStringJpg afterMarker
      Just (v, rest) -> S.put (       7, v,    rest)
 
 --------------------------------------------------
Codec/Picture/Gif.hs view
@@ -1,191 +1,290 @@-module Codec.Picture.Gif ( ) where--import Data.Vector (Vector)-import qualified Data.Vector as V-import Data.Word-import Data.Maybe( fromMaybe )-import Data.List-import Control.Applicative( (<$>), pure )-import Control.Monad( replicateM )-import Data.Bits( (.&.), shiftR, testBit )-import Data.Word( Word8 )-{-import LZW-}-import qualified Data.ByteString as B-import qualified Data.Vector     as V-import Data.Maybe( fromMaybe )--import Data.Serialize( Serialize(..), Get, Put-                     , getWord8, putWord8-                     , getWord16be, putWord16be-                     , remaining, lookAhead, skip-                     , getBytes, decode-                     , encode, putByteString -                     )--import Codec.Picture.Types--data GifVersion = GIF87a | GIF89a-  deriving (Show, Eq)---- | Section 18 of spec-gif89a-data ScreenDescriptor = ScreenDescriptor-  { -- | Stored on 16 bits-    screenWidth           :: !Word16-    -- | Stored on 16 bits-  , screenHeight          :: !Word16-    -- | Stored on 8 bits-  , backgroundIndex       :: !Word8--  -- | Stored on 1 bit-  , hasGlobalMap          :: !Bool-  -- | Stored on 3 bits-  , colorResolution       :: !Word8-  -- | Stored on 1 bit-  , isColorTableSorted    :: !Bool-  -- | Stored on 3 bits-  , colorTableSize        :: !Word8-  }-  deriving (Show, Eq)---- | Section 20 of spec-gif89a-data GifImageDescriptor = GifImageDescriptor-  { gDescPixelsFromLeft         :: !Int-  , gDescPixelsFromTop          :: !Int-  , gDescImageWidth             :: !Int-  , gDescImageHeight            :: !Int-  , gDescHasLocalMap            :: !Bool-  , gDescIsInterlaced           :: !Bool-  , gDescIsImgDescriptorSorted  :: !Bool-  , gDescLocalColorTableSize    :: !Int-  }-  deriving (Show, Eq)--type Palette = V.Vector PixelRGB8--type GifImageData = (GifImageDescriptor, Maybe Palette, Raster)---- Stelt 1 pixel waarde voor door een index en de bijbehorende colormap-type GifPixel = (Int, Palette)--type Raster = V.Vector (V.Vector GifPixel)--data GifImage = GifImage-  { gifVersion          :: !GifVersion-  , gifScreenDescriptor :: !ScreenDescriptor-  , gifGlobalMap        :: !Palette-  , images              :: [GifImageData]-  }-  deriving (Eq, Show)--gif87aSignature, gif89aSignature :: B.ByteString-gif87aSignature = B.pack "GIF87a" -gif89aSignature = B.pack "GIF89a"--instance Serialize GifVersion where-    put GIF87a = put gif87aSignature-    put GIF89a = put gif89aSignature --    get = do-        sig <- getBytes (B.length gif87aSignature)-        case (sig == gif87aSignature, sig == gif89aSignature) of-            (True, _)  -> pure GIF87a-            (_ , True) -> pure GIF89a-            _          -> fail "Invalid Gif signature"-        --- Add 2 bytes together-lsbAdd :: Integral a => a -> a -> Int-lsbAdd l r = (fromIntegral l) * 0x100 + (fromIntegral r)--(<++>) = lsbAdd--instance Serialize ScreenDescriptor where-    put _ = undefined-    get = do-        w <- getWord16be-        h <- getWord16be-        packedField  <- getWord8-        backgroundColorIndex  <- getWord8-        aspectRatio  <- getWord8-        return ScreenDescriptor-            { screenWidth           = w-            , screenHeight          = h-            , hasGlobalMap          = packedField `testBit` 7-            , colorResolution       = (packedField `shiftR` 5) .&. 0x7 + 1-            , isColorTableSorted    = packedField `testBit` 3-            , colorTableSize        = (packedField .&. 0x7) + 1-            , backgroundIndex       = backgroundColorIndex-            }--colorMap :: Int -> Get Palette-colorMap bits = fmap V.fromList $ replicateM (2 ^ bits) get--imageSeperator, gifTerminator :: Word8-imageSeperator = 0x2c-gifTerminator  = 0x3b---instance Serialize GifImageDescriptor where-    put _ = undefined-    get = do-        imgSeparator <- getWord8-        imgLeftPos <- getWord16be-        imgTopPos  <- getWord16be-        imgWidth   <- getWord16be-        imgHeight  <- getWord16be-        packedFields <- getWord8-        return GifImageDescriptor-            { gDescPixelsFromLeft = imgLeftPos-            , gDescPixelsFromTop  = imgTopPos-            , gDescImageWidth     = imgWidth-            , gDescImageHeight    = imgHeight-            , gDescHasLocalMap    = packedFields `testBit` 7-            , gDescIsInterlaced     = packedFields `testBit` 6-            , gDescIsImgDescriptorSorted = packedFields `testBit` 5-            , gDescLocalColorTableSize = packedFields .&. 0x7 + 1-            }---- Takes the global color map as an argument-imageParser :: Palette -> Parser Image-imageParser globalMap = do-  descriptor <- imageDescriptor-  localMap   <- if hasLocalMap descriptor-                then Just <$> colorMap (localColorTableSize descriptor)-                else return $ Nothing--  -- the map the raster should use-  let useMap = fromMaybe globalMap localMap-  codeSize   <- fromIntegral <$> anyWord8-  rasterData <- B.concat <$> imageRasterBlock `A.manyTill` zeroImageRaster-  return (descriptor, localMap, parseRaster descriptor (lzwDecode codeSize rasterData) useMap)---imageRasterBlock :: Parser ByteString-imageRasterBlock = do-  byteCount  <- anyWord8-  rasterData <- A.take (fromIntegral byteCount)-  return rasterData--parseRaster :: GifImageDescriptor -> [Int] -> Palette -> Raster-parseRaster ds list cm-  | interlaced ds = undefined-  | otherwise     =-        V.fromList $ map V.fromList $ groupEach (imageWidth ds) $ map (\x -> (x, cm)) list-      where-        groupEach _ [] = []-        groupEach a l  = let (left, right) = splitAt a l-                         in  [left] ++ groupEach a right--gifParser = do-  signature  <- gifSignature-  descriptor <- screenDescriptor-  globalCM   <- colorMap $ screenBitsPerPixel descriptor-  _          <- anyWord8 `A.manyTill` imageSeperator-  images     <- imageParser globalCM `A.sepBy` imageSeperator-  _          <- gifTerminator-  return GifImage-    { gifVersion = signature-    , gifScreenDescriptor = descriptor-    , gifGlobalMap = globalCM-    , images = images-    }-+-- | Module implementing GIF decoding.
+module Codec.Picture.Gif ( decodeGif
+                         , decodeGifImages
+                         ) where
+
+import Control.Applicative( pure, (<$>), (<*>) )
+import Control.Monad( replicateM )
+import Control.Monad.ST( runST )
+import Control.Monad.Trans.Class( lift )
+
+import Data.Bits( (.&.), shiftR, testBit )
+import Data.Word( Word8, Word16 )
+
+import qualified Data.ByteString as B
+import qualified Data.Vector.Storable as V
+import qualified Data.Vector.Storable.Mutable as M
+
+import Data.Serialize( Serialize(..)
+                     , Get
+                     , decode
+                     , getWord8
+                     , getWord16le
+                     , getBytes
+                     , lookAhead
+                     {-, decode-}
+                     {-, remaining-}
+
+                     {-, Put-}
+                     {-, putWord8-}
+                     {-, putWord16be-}
+                     {-, encode-}
+                     {-, putByteString -}
+                     )
+
+import Codec.Picture.Types
+import Codec.Picture.Gif.LZW
+import Codec.Picture.BitWriter
+
+{-
+   <GIF Data Stream> ::=     Header <Logical Screen> <Data>* Trailer
+
+   <Logical Screen> ::=      Logical Screen Descriptor [Global Color Table]
+
+   <Data> ::=                <Graphic Block>  |
+                             <Special-Purpose Block>
+
+   <Graphic Block> ::=       [Graphic Control Extension] <Graphic-Rendering Block>
+
+   <Graphic-Rendering Block> ::=  <Table-Based Image>  |
+                                  Plain Text Extension
+
+   <Table-Based Image> ::=   Image Descriptor [Local Color Table] Image Data
+
+   <Special-Purpose Block> ::=    Application Extension  |
+                                  Comment Extension
+ -}
+
+--------------------------------------------------
+----            GifVersion
+--------------------------------------------------
+data GifVersion = GIF87a | GIF89a
+
+gif87aSignature, gif89aSignature :: B.ByteString
+gif87aSignature = B.pack $ map (fromIntegral . fromEnum) "GIF87a"
+gif89aSignature = B.pack $ map (fromIntegral . fromEnum) "GIF89a"
+
+instance Serialize GifVersion where
+    put GIF87a = put gif87aSignature
+    put GIF89a = put gif89aSignature
+
+    get = do
+        sig <- getBytes (B.length gif87aSignature)
+        case (sig == gif87aSignature, sig == gif89aSignature) of
+            (True, _)  -> pure GIF87a
+            (_ , True) -> pure GIF89a
+            _          -> fail "Invalid Gif signature"
+
+
+--------------------------------------------------
+----         LogicalScreenDescriptor
+--------------------------------------------------
+-- | Section 18 of spec-gif89a
+data LogicalScreenDescriptor = LogicalScreenDescriptor
+  { -- | Stored on 16 bits
+    screenWidth           :: !Word16
+    -- | Stored on 16 bits
+  , screenHeight          :: !Word16
+    -- | Stored on 8 bits
+  , backgroundIndex       :: !Word8
+
+  -- | Stored on 1 bit
+  , hasGlobalMap          :: !Bool
+  -- | Stored on 3 bits
+  , colorResolution       :: !Word8
+  -- | Stored on 1 bit
+  , isColorTableSorted    :: !Bool
+  -- | Stored on 3 bits
+  , colorTableSize        :: !Word8
+  }
+
+instance Serialize LogicalScreenDescriptor where
+    put _ = undefined
+    get = do
+        w <- getWord16le
+        h <- getWord16le
+        packedField  <- getWord8
+        backgroundColorIndex  <- getWord8
+        _aspectRatio  <- getWord8
+        return LogicalScreenDescriptor
+            { screenWidth           = w
+            , screenHeight          = h
+            , hasGlobalMap          = packedField `testBit` 7
+            , colorResolution       = (packedField `shiftR` 5) .&. 0x7 + 1
+            , isColorTableSorted    = packedField `testBit` 3
+            , colorTableSize        = (packedField .&. 0x7) + 1
+            , backgroundIndex       = backgroundColorIndex
+            }
+
+
+--------------------------------------------------
+----            ImageDescriptor
+--------------------------------------------------
+-- | Section 20 of spec-gif89a
+data ImageDescriptor = ImageDescriptor
+  { gDescPixelsFromLeft         :: !Word16
+  , gDescPixelsFromTop          :: !Word16
+  , gDescImageWidth             :: !Word16
+  , gDescImageHeight            :: !Word16
+  , gDescHasLocalMap            :: !Bool
+  , gDescIsInterlaced           :: !Bool
+  , gDescIsImgDescriptorSorted  :: !Bool
+  , gDescLocalColorTableSize    :: !Word8
+  }
+
+imageSeparator, extensionIntroducer, gifTrailer :: Word8
+imageSeparator      = 0x2C
+extensionIntroducer = 0x21
+gifTrailer          = 0x3B
+
+{-commentLabel, graphicControlLabel, graphicControlLabel,-}
+              {-applicationLabel :: Word8-}
+{-commentLabel        = 0xFE-}
+{-graphicControlLabel = 0xF9-}
+{-plainTextLabel      = 0x01-}
+{-applicationLabel    = 0xFF-}
+
+parseDataBlocks :: Get B.ByteString
+parseDataBlocks = B.concat <$> (getWord8 >>= aux)
+ where aux    0 = pure []
+       aux size = (:) <$> getBytes (fromIntegral size) <*> (getWord8 >>= aux)
+
+data GifImage = GifImage
+    { imgDescriptor   :: !ImageDescriptor
+    , imgLocalPalette :: !(Maybe Palette)
+    , imgLzwRootSize  :: !Word8
+    , imgData         :: B.ByteString
+    }
+
+instance Serialize GifImage where
+    put _ = undefined
+    get = do
+        desc <- get
+        let paletteSize = gDescLocalColorTableSize desc
+        palette <- if paletteSize > 0
+           then Just <$> getPalette paletteSize
+           else pure Nothing
+
+        GifImage desc palette <$> getWord8 <*> parseDataBlocks
+
+parseGifBlocks :: Get [GifImage]
+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)
+
+instance Serialize ImageDescriptor where
+    put _ = undefined
+    get = do
+        _imageSeparator <- getWord8
+        imgLeftPos <- getWord16le
+        imgTopPos  <- getWord16le
+        imgWidth   <- getWord16le
+        imgHeight  <- getWord16le
+        packedFields <- getWord8
+        let tableSize = packedFields .&. 0x7
+        return ImageDescriptor
+            { gDescPixelsFromLeft = imgLeftPos
+            , gDescPixelsFromTop  = imgTopPos
+            , gDescImageWidth     = imgWidth
+            , gDescImageHeight    = imgHeight
+            , gDescHasLocalMap    = packedFields `testBit` 7
+            , gDescIsInterlaced     = packedFields `testBit` 6
+            , gDescIsImgDescriptorSorted = packedFields `testBit` 5
+            , gDescLocalColorTableSize = if tableSize > 0 then tableSize + 1 else 0
+            }
+
+
+--------------------------------------------------
+----            Palette
+--------------------------------------------------
+type Palette = V.Vector PixelRGB8
+
+getPalette :: Word8 -> Get Palette
+getPalette bitDepth = replicateM size get >>= return . V.fromList
+  where size = 2 ^ (fromIntegral bitDepth :: Int)
+
+--------------------------------------------------
+----            GifImage
+--------------------------------------------------
+data GifHeader = GifHeader
+  { gifVersion          :: GifVersion
+  , gifScreenDescriptor :: LogicalScreenDescriptor
+  , gifGlobalMap        :: !Palette
+  }
+
+instance Serialize GifHeader where
+    put _ = undefined
+    get = do
+        version    <- get
+        screenDesc <- get
+        palette    <- getPalette $ colorTableSize screenDesc
+        return GifHeader
+            { gifVersion = version
+            , gifScreenDescriptor = screenDesc
+            , gifGlobalMap = palette
+            }
+
+data GifFile = GifFile
+    { gifHeader :: !GifHeader
+    , gifImages :: [GifImage]
+    }
+
+instance Serialize GifFile where
+    put _ = undefined
+    get = do
+        hdr <- get
+        images <- parseGifBlocks
+
+        return GifFile { gifHeader = hdr
+                       , gifImages = images }
+
+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
+    outputVector <- lift . M.new $ width * height
+    decodeLzw (imgData img) 12 lzwRoot outputVector
+    frozenData <- lift $ V.unsafeFreeze outputVector
+    return $ substituteColors palette Image
+      { imageWidth = width
+      , imageHeight = height
+      , imageData = frozenData
+      }
+  where lzwRoot = fromIntegral $ imgLzwRootSize img
+        width = fromIntegral $ gDescImageWidth descriptor
+        height = fromIntegral $ gDescImageHeight descriptor
+        descriptor = imgDescriptor img
+        palette = case imgLocalPalette img of
+            Nothing -> globalPalette
+            Just p  -> p
+
+decodeAllGifImages :: GifFile -> [Image PixelRGB8]
+decodeAllGifImages GifFile { gifHeader = GifHeader { gifGlobalMap = palette}
+                        , gifImages = lst } = map (decodeImage palette) lst
+
+decodeFirstGifImage :: GifFile -> Either String (Image PixelRGB8)
+decodeFirstGifImage
+        GifFile { gifHeader = GifHeader { gifGlobalMap = palette}
+                , gifImages = (gif:_) } = Right $ decodeImage palette gif
+decodeFirstGifImage _ = Left "No image in gif file"
+
+-- | Transform a raw gif image to an image, witout
+-- modifying the pixels.
+-- This function can output the following pixel types :
+--
+--  * PixelRGB8
+--
+decodeGif :: B.ByteString -> Either String DynamicImage
+decodeGif img = ImageRGB8 <$> (decode img >>= decodeFirstGifImage)
+
+-- | Transform a raw gif to a list of images, representing
+-- all the images of an animation.
+decodeGifImages :: B.ByteString -> Either String [Image PixelRGB8]
+decodeGifImages img = decodeAllGifImages <$> decode img
+
Codec/Picture/Gif/LZW.hs view
@@ -1,178 +1,120 @@-{-# LANGUAGE OverloadedStrings #-}-module LZW where-import Control.Monad (liftM)-import Data.Binary.Strict.BitGet-import Data.Bits-import Data.Map ((!), insert, lookup, fromList, Map, member)-import Data.Word-import Prelude hiding (lookup)-import qualified Data.ByteString as B-import Control.Monad.State-import Control.Applicative-import Data.Maybe--data DecodeState = DecodeState-     { stringTable     :: Map Int [Int]-     , compressionSize :: Int-     , oldCode         :: [Int]-     , currentIndex    :: Int-     } deriving (Show)--type Decoder a = StateT DecodeState BitGet a--runDecoder :: B.ByteString   -- ^ Input BS-           -> DecodeState     -- ^ Initial state-           -> Decoder a       -- ^ Our decoder-           -> a               -- ^ Result-runDecoder bs initial decoder =-    let x = evalStateT decoder initial -- x = BitGet a-    in case runBitGet (reverseBytes bs) x of-        Left err -> error err-        Right x  -> x--getNextCode :: Decoder Int-getNextCode = do-  cs <- getCompressionSize-  bs <- lift $ getLeftByteString cs-  return $ (fromIntegral . toWord) bs--getStringTable :: Decoder (Map Int [Int])-getStringTable = gets stringTable--getCompressionSize :: Decoder Int-getCompressionSize = gets compressionSize--getOldCode :: Decoder [Int]-getOldCode = gets oldCode--getCurrentIndex :: Decoder Int-getCurrentIndex = gets currentIndex--lzwDecode rootSize string =-  let initial = DecodeState-                { stringTable = fromList $ map (\x -> (x, [x])) [0 .. (2 ^ rootSize - 1)]-                , currentIndex = 2 ^ rootSize + 1-                , compressionSize = rootSize + 1-                , oldCode = []-                }-  in runDecoder string initial (decodeS initial)---decodeS :: DecodeState -> Decoder [Int]-decodeS initial = decode-  where-    decode = do-      code <- getNextCode-      evalCode code--    clearCode = 2 ^ (compressionSize initial - 1)-    endOfInfo = clearCode + 1--    reset = put initial--    lookupCode code = do-      res <- lookup code `liftM` getStringTable-      prev <- getOldCode-      add $ prev ++ [head $ fromMaybe prev res]-      return $ fromMaybe (prev ++ [head prev]) res--    adjustDS r = modify func-      where-        func ds = ds { currentIndex = (currentIndex ds) + 1-                     , compressionSize = comp ds-                     , oldCode = r-                     }-        comp ds = min 12 $ if (currentIndex ds) == (2 ^ compressionSize ds) - 1-                           then compressionSize ds + 1 else compressionSize ds--    add x = modify (\ds -> ds { stringTable = insert (currentIndex ds) x (stringTable ds)})--    evalCode code-      | code == clearCode = reset >> decodeS initial-      | code == endOfInfo = return []-      | otherwise = do-          r <- lookupCode code-          adjustDS r-          (r ++) `liftM` decode--lzwEncode rootSize arr =-    B.pack . mapAdd $ encode rootSize arr-  where-    mapAdd :: [(Int, Int)] -> [Word8]-    mapAdd [] = []-    mapAdd [(c,w)]-      | c <= 8 = [(fromIntegral w)]-      | otherwise = (fromIntegral w) : mapAdd [(c-8, w `shiftR` 8)]-    mapAdd (x@(b, w):y:xs)-      | b == 8 = (fromIntegral w) : (mapAdd (y:xs))-      | otherwise = mapAdd $ (add x y) ++ xs---- Adds 2 numbers together based on how many bits we're allowed to take--- this works by returning an array the numbers it produces------ Possibilites:---   * All bits of the second number are consumed -> discard second number from result---   * The bits of the produced number are > 8 -> we have a valid Word8 we can return (set bits == 8)---   * The bits of the left input number > 8   -> take 8 bits (this is a valid Word8)---                                             -> remaining bits are added as a next input---                                             -> original left input is just added again-add :: (Int,Int) -> (Int, Int) -> [(Int, Int)]-add (c1, v1) (c2, v2) =-    if c1 > 8 then-      [(8, v1), (c1 - 8, v1 `shiftR` 8), (c2, v2)]-    else-      let leftShifted = v2 `shiftL` c1                      -- the right input shifted the correct amount-          combined    = v1 .|. leftShifted                  -- the 2 numbers added together-          next        = v2 `shiftR` (c2 - bitsLeft)         -- next input (deduced from right input)-          bitsLeft    = c2 - (8 - c1)                       -- remaining bits in the next input-          bits        = if c1 + c2 > 8 then 8 else c1 + c2  -- set to 8 so mapAdd knows it can output a Word8-      in  if bitsLeft <= 0 then [(bits, combined)]          -- discard right input when there are no remaining bits-          else [(bits, combined),(bitsLeft, next)]---- Convert the given array with given rootSize to a array where each element--- is of the following form (bits to take, actual element)-encode :: Int -> [Int] -> [(Int,Int)]-encode rootSize arr =-    (compressionSize, clearCode) : encode' arr startStringTable compressionSize [] startingPoint-  where-    startStringTable = fromList $ map (\x -> ([x], x)) [0 .. (2 ^ rootSize + 1)] :: Map [Int] Int-    compressionSize  = rootSize + 1 :: Int-    clearCode        = 2 ^ rootSize :: Int-    endOfInfo        = clearCode + 1-    startingPoint    = endOfInfo + 1--    -- Don't forget to output our last code and the endOfInfo-    encode' [] strTable c last i  = [(c, strTable ! last), (newC, endOfInfo)]-      where-        newC = min 12 $ if i == (2 ^ c)-                        then c + 1 else c-    encode' (x:xs) strTable compSize last currentIndex =-      let string = (last ++ [x])-      in  if string `member` strTable then-            encode' xs strTable compSize string currentIndex-          else-            let newStrTable = insert string currentIndex strTable-                newCompSize = if currentIndex == (2 ^ compSize)-                              then compSize + 1 else compSize-            in  (compSize, strTable ! last) :-                if newCompSize == 13-                then (12, clearCode) : encode' (x:xs) startStringTable compressionSize [] startingPoint-                else encode' xs newStrTable newCompSize [x] (currentIndex + 1)----- source: http://graphics.stanford.edu/~seander/bithacks.html-reverseBytes :: B.ByteString -> B.ByteString-reverseBytes = B.map (\b ->-  fromIntegral $ (`shiftR` 32)-               $ (* 0x0101010101)-               $ (.&. 0x0884422110)-               $ (* 0x80200802) (fromIntegral b :: Word64))--toWord :: B.ByteString -> Word16-toWord s =-  case B.unpack $ reverseBytes s of-    [small] -> fromIntegral small-    [l,r]   -> r <+> l-    _       -> error "more than 2 bytes should never happen"--(<+>) l r = (fromIntegral l) `shiftL` 8 .|. (fromIntegral r)+module Codec.Picture.Gif.LZW( decodeLzw, lzw ) where
+
+import Data.Word( Word8 )
+import Control.Applicative( (<$>) )
+import Control.Monad( when )
+
+{-import Control.Monad.ST( ST )-}
+import Control.Monad.Trans.Class( MonadTrans, lift )
+import Control.Monad.Primitive ( PrimState, PrimMonad )
+
+import Foreign.Storable ( Storable )
+
+import qualified Data.ByteString as B
+import qualified Data.Vector.Storable.Mutable as M
+
+import Codec.Picture.BitWriter
+
+{-# INLINE (.!!!.) #-}
+(.!!!.) :: (PrimMonad m, Storable a)
+        => M.STVector (PrimState m) a -> Int -> m a
+(.!!!.) = M.read
+          -- M.unsafeRead
+
+{-# INLINE (..!!!..) #-}
+(..!!!..) :: (MonadTrans t, PrimMonad m, Storable a)
+        => M.STVector (PrimState m) a -> Int -> t m a
+(..!!!..) v idx = lift $ v .!!!. idx
+
+{-# INLINE (.<-.) #-}
+(.<-.) :: (PrimMonad m, Storable a)
+       => M.STVector (PrimState m) a -> Int -> a -> m ()
+(.<-.) = M.write 
+         -- M.unsafeWrite
+
+{-# INLINE (..<-..) #-}
+(..<-..) :: (MonadTrans t, PrimMonad m, Storable a)
+         => M.STVector (PrimState m) a -> Int -> a -> t m ()
+(..<-..) v idx = lift . (v .<-. idx)
+
+
+duplicateData :: (MonadTrans t, PrimMonad m, Storable a)
+              => M.STVector (PrimState m) a -> M.STVector (PrimState m) a
+              -> Int -> Int -> Int -> t m ()
+duplicateData src dest sourceIndex size destIndex = lift $ aux sourceIndex destIndex
+  where endIndex = sourceIndex + size
+        aux i _ | i == endIndex  = return ()
+        aux i j = do
+          src .!!!. i >>= (dest .<-. j)
+          aux (i + 1) (j + 1)
+
+rangeSetter :: (PrimMonad m, Storable a, Num a)
+            => Int -> M.STVector (PrimState m) a
+            -> m (M.STVector (PrimState m) a)
+rangeSetter count vec = aux 0
+  where aux n | n == count = return vec
+        aux n = (vec .<-. n) (fromIntegral n) >> aux (n + 1)
+
+decodeLzw :: B.ByteString -> Int -> Int -> M.STVector s Word8
+          -> BoolReader s ()
+decodeLzw str maxBitKey initialKey outVec = do
+    setDecodedString str
+    lzw maxBitKey initialKey outVec
+
+-- | Gif image constraint from spec-gif89a, code size max : 12 bits.
+lzw :: Int -> Int -> M.STVector s Word8
+    -> BoolReader s ()
+lzw nMaxBitKeySize initialKeySize outVec = do
+    -- Allocate buffer of maximum size.
+    lzwData <- lift (M.new maxDataSize) >>= resetArray
+    lzwOffsetTable <- lift (M.new tableEntryCount) >>= resetArray
+    lzwSizeTable <- lift $ M.new tableEntryCount
+    lift $ lzwSizeTable `M.set` 1
+
+    let loop outWriteIdx writeIdx dicWriteIdx codeSize code
+          | code == endOfInfo = return ()
+          | code == clearCode =
+              getNextCode startCodeSize >>=
+                loop outWriteIdx firstFreeIndex firstFreeIndex startCodeSize
+
+          | otherwise = do
+              dataOffset <- lzwOffsetTable ..!!!.. code
+              dataSize <- lzwSizeTable  ..!!!.. code
+
+              when (outWriteIdx /= 0) $ do
+                 firstVal <- lzwData ..!!!.. dataOffset
+                 (lzwData ..<-.. (dicWriteIdx - 1)) firstVal
+
+              duplicateData lzwData outVec dataOffset dataSize outWriteIdx
+              duplicateData lzwData lzwData dataOffset dataSize dicWriteIdx
+
+              (lzwSizeTable ..<-.. writeIdx) $ dataSize + 1
+              (lzwOffsetTable ..<-.. writeIdx) dicWriteIdx
+
+              getNextCode codeSize >>=
+                loop (outWriteIdx + dataSize)
+                     (writeIdx + 1)
+                     (dicWriteIdx + dataSize + 1) (updateCodeSize codeSize $ writeIdx + 1)
+
+    getNextCode startCodeSize >>=
+        loop 0 firstFreeIndex firstFreeIndex startCodeSize
+
+  where tableEntryCount =  2 ^ min 12 nMaxBitKeySize
+        maxDataSize = tableEntryCount `div` 2 * (1 + tableEntryCount)
+
+        initialElementCount = 2 ^ initialKeySize :: Int
+        clearCode = initialElementCount
+        endOfInfo = clearCode + 1
+        startCodeSize = initialKeySize + 1
+
+        firstFreeIndex = endOfInfo + 1
+
+        resetArray a = lift $ rangeSetter initialElementCount a
+
+        updateCodeSize codeSize writeIdx
+            | writeIdx == 2 ^ codeSize = min 12 $ codeSize + 1
+            | otherwise = codeSize
+
+        getNextCode s = fromIntegral <$> getNextBits s
+
+
− Codec/Picture/Gif/Writer.hs
@@ -1,99 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Writer where-import GifImage-import LZW-import Data.Bits-import Control.Monad (liftM)-import qualified Data.ByteString as B-import qualified Data.Vector as V-import Data.ByteString.Char8 hiding (head, concat, map)-import Data.Binary.BitPut-import Data.ByteString.Lazy (toChunks)--putWord8 :: Int -> BitPut-putWord8 = putNBits 8--putDescriptor :: ScreenDescriptor -> BitPut-putDescriptor ds = do-  putWord8 (screenWidth ds)-  putWord8 (screenWidth ds `shiftR` 8)-  putWord8 (screenHeight ds)-  putWord8 (screenHeight ds `shiftR` 8)-  putBit   $ hasGlobalMap ds-  putNBits 3 (bitsOfColorResolution ds - 1)-  putBit   False-  putNBits 3 (screenBitsPerPixel ds - 1)-  putWord8 (backgroundIndex ds)-  putWord8 0--putGlobalMap :: ColorMap -> BitPut-putGlobalMap cm = do-    sequence_ $ putColor `liftM` V.toList cm-  where-    putColor (r,g,b) = do-      putWord8 $ fromIntegral r-      putWord8 $ fromIntegral g-      putWord8 $ fromIntegral b---putImage :: ScreenDescriptor -> Image -> BitPut-putImage _ (descriptor, Just map, raster) = do-  putImageDescriptor $ descriptor-  putGlobalMap $ map-  putRasterData raster $ bitsPerPixel descriptor-putImage ds (descriptor, Nothing, raster) = do-  putImageDescriptor $ descriptor-  putRasterData raster $ screenBitsPerPixel ds--putImageDescriptor :: ImageDescriptor -> BitPut-putImageDescriptor ds = do-  putWord8 0x2c-  putWord8 $ pixelsFromLeft ds-  putWord8 $ pixelsFromLeft ds `shiftR` 8-  putWord8 $ pixelsFromTop ds-  putWord8 $ pixelsFromTop ds `shiftR` 8-  putWord8 $ imageWidth ds-  putWord8 $ imageWidth ds `shiftR` 8-  putWord8 $ imageHeight ds-  putWord8 $ imageHeight ds `shiftR` 8-  putBit   $ hasLocalMap ds-  putBit   $ interlaced ds-  putNBits 3 (0 :: Int)-  putNBits 3 (bitsPerPixel ds - 1)---putRasterData :: Raster -> Int -> BitPut-putRasterData raster rootSize = do-    let intList = map fst $ concat .V.toList $ V.map V.toList $ raster :: [Int]-    let lzw = lzwEncode rootSize intList :: ByteString-    putWord8 rootSize-    putBlocks lzw-  where-    putBlocks :: ByteString -> BitPut-    putBlocks arr-      | B.null arr = putWord8 0-      | otherwise =-          let bytes  = B.take 255 arr-              actual = B.length bytes-          in do-            putWord8 actual-            putByteString bytes-            putBlocks (B.drop actual arr)--putGifTerminator :: BitPut-putGifTerminator = do-  putWord8 0x3b--gifWriter :: GifImage -> BitPut-gifWriter image = do-  putByteString "GIF87a"-  putDescriptor $ gifScreenDescriptor image-  putGlobalMap  $ gifGlobalMap image-  putImage (gifScreenDescriptor image) `mapM_` images image-  putGifTerminator--runGifWriter :: GifImage -> ByteString-runGifWriter image =-  B.concat . toChunks $ runBitPut (gifWriter image)-
Codec/Picture/Jpg.hs view
@@ -215,12 +215,12 @@ -- | Decode a list of huffman values, not optimized for speed, but it
 -- should work.
 huffmanDecode :: HuffmanTree -> BoolReader s Word8
-huffmanDecode originalTree = getNextBit >>= huffDecode originalTree
+huffmanDecode originalTree = getNextBitJpg >>= huffDecode originalTree
   where huffDecode Empty                   _ = return 0
         huffDecode (Branch (Leaf v) _) False = return v
-        huffDecode (Branch l       _ ) False = getNextBit >>= huffDecode l
+        huffDecode (Branch l       _ ) False = getNextBitJpg >>= huffDecode l
         huffDecode (Branch _ (Leaf v)) True  = return v
-        huffDecode (Branch _       r ) True  = getNextBit >>= huffDecode r
+        huffDecode (Branch _       r ) True  = getNextBitJpg >>= huffDecode r
         huffDecode (Leaf v) _ = return v
 
 --------------------------------------------------
@@ -565,7 +565,7 @@ 
 -- | Unpack an int of the given size encoded from MSB to LSB.
 unpackInt :: Int32 -> BoolReader s Int32
-unpackInt bitCount = packInt <$> replicateM (fromIntegral bitCount) getNextBit
+unpackInt bitCount = packInt <$> replicateM (fromIntegral bitCount) getNextBitJpg
 
 powerOf :: Int32 -> Word32
 powerOf 0 = 0
@@ -580,7 +580,7 @@ 
 decodeInt :: Int32 -> BoolReader s Int32
 decodeInt ssss = do
-    signBit <- getNextBit
+    signBit <- getNextBitJpg
     let dataRange = 1 `shiftL` fromIntegral (ssss - 1)
         leftBitCount = ssss - 1
     -- First following bits store the sign of the coefficient, and counted in
@@ -687,10 +687,10 @@ 
 decodeRestartInterval :: BoolReader s Int32
 decodeRestartInterval = return (-1) {-  do
-  bits <- replicateM 8 getNextBit
+  bits <- replicateM 8 getNextBitJpg
   if bits == replicate 8 True
      then do
-         marker <- replicateM 8 getNextBit
+         marker <- replicateM 8 getNextBitJpg
          return $ packInt marker
      else return (-1)
         -}
@@ -713,7 +713,7 @@         when (resetCounter == 0)
              (do forM_ [0.. compCount - 1] $
                      \c -> lift $ (dcArray .<-. c) 0
-                 byteAlign
+                 byteAlignJpg
                  _restartCode <- decodeRestartInterval
                  -- if 0xD0 <= restartCode && restartCode <= 0xD7
                  return ())
@@ -851,7 +851,7 @@             pixelData = runST $ VS.unsafeFreeze =<< S.evalStateT (do
                 resultImage <- lift $ M.replicate imageSize 0
                 let wrapped = MutableImage imgWidth imgHeight resultImage
-                setDecodedString imgData
+                setDecodedStringJpg imgData
                 decodeImage compCount (buildJpegImageDecoder img) wrapped
                 return resultImage) (-1, 0, B.empty)
 
Codec/Picture/Types.hs view
@@ -27,11 +27,24 @@ 
                             -- * Helper functions
                           , canConvertTo
-                          , extractComponent
                           , pixelMap
                           , dropAlphaLayer
                           , generateImage
                           , generateFoldImage
+
+                            -- * Color plane extraction
+                          , ColorPlane ( )
+
+                          , PlaneRed( .. )
+                          , PlaneGreen( .. )
+                          , PlaneBlue( .. )
+                          , PlaneAlpha( .. )
+                          , PlaneLuma( .. )
+                          , PlaneCr( .. )
+                          , PlaneCb( .. )
+
+                          , extractComponent
+                          , unsafeExtractComponent
                           ) where
 
 import Control.Monad( forM_, foldM )
@@ -66,15 +79,93 @@ (!!!) :: (Storable e) => V.Vector e -> Int -> e
 (!!!) = V.unsafeIndex
 
+-- | Class used to describle plane present in the pixel
+-- type. If a pixel has a plane description associated,
+-- you can use the plane name to extract planes independently.
+class ColorPlane pixel planeToken where
+    -- | Retrieve the index of the component in the
+    -- given pixel type.
+    toComponentIndex :: pixel -> planeToken -> Int
+
+-- | Define the plane for the red color component
+data PlaneRed = PlaneRed
+
+-- | Define the plane for the green color component
+data PlaneGreen = PlaneGreen
+
+-- | Define the plane for the blue color component
+data PlaneBlue = PlaneBlue
+
+-- | Define the plane for the alpha (transparency) component
+data PlaneAlpha = PlaneAlpha
+
+-- | Define the plane for the luma component
+data PlaneLuma = PlaneLuma 
+
+-- | Define the plane for the Cr component
+data PlaneCr = PlaneCr
+
+-- | Define the plane for the Cb component
+data PlaneCb = PlaneCb
+
+instance ColorPlane PixelYCbCr8 PlaneLuma where
+    toComponentIndex _ _ = 0
+
+instance ColorPlane PixelYCbCr8 PlaneCb where
+    toComponentIndex _ _ = 1
+
+instance ColorPlane PixelYCbCr8 PlaneCr where
+    toComponentIndex _ _ = 2
+
+instance ColorPlane PixelYA8 PlaneLuma where
+    toComponentIndex _ _ = 0
+
+instance ColorPlane PixelYA8 PlaneAlpha where
+    toComponentIndex _ _ = 1
+    
+instance ColorPlane PixelRGB8 PlaneRed where
+    toComponentIndex _ _ = 0
+
+instance ColorPlane PixelRGB8 PlaneGreen where
+    toComponentIndex _ _ = 1
+
+instance ColorPlane PixelRGB8 PlaneBlue where
+    toComponentIndex _ _ = 2
+
+instance ColorPlane PixelRGBA8 PlaneRed where
+    toComponentIndex _ _ = 0
+
+instance ColorPlane PixelRGBA8 PlaneGreen where
+    toComponentIndex _ _ = 1
+
+instance ColorPlane PixelRGBA8 PlaneBlue where
+    toComponentIndex _ _ = 2
+
+instance ColorPlane PixelRGBA8 PlaneAlpha where
+    toComponentIndex _ _ = 3
+
+-- | Extract a color plane from an image given a present plane in the image
+-- examples :
+--
+-- @
+--  extractRedPlane :: Image PixelRGB8-> Image Pixel8
+--  extractRedPlane = extractComponent PlaneRed
+-- @
+--
+extractComponent :: forall px plane. (Pixel px, ColorPlane px plane)
+                 => plane -> Image px -> Image Pixel8
+extractComponent plane = unsafeExtractComponent idx
+    where idx = toComponentIndex (undefined :: px) plane
+
 -- | Extract an image plane of an image, returning an image which
 -- can be represented by a gray scale image.
 -- If you ask a component out of bound, the `error` function will
 -- be called
-extractComponent :: forall a. (Pixel a) 
-                 => Int     -- ^ The component index, beginning at 0 ending at (componentCount - 1)
-                 -> Image a -- ^ Source image
-                 -> Image Pixel8
-extractComponent comp img@(Image { imageWidth = w, imageHeight = h })
+unsafeExtractComponent :: forall a. (Pixel a) 
+                       => Int     -- ^ The component index, beginning at 0 ending at (componentCount - 1)
+                       -> Image a -- ^ Source image
+                       -> Image Pixel8
+unsafeExtractComponent comp img@(Image { imageWidth = w, imageHeight = h })
   | comp >= padd = error $ "extractComponent : invalid component index (" 
                          ++ show comp ++ ", max:" ++ show padd ++ ")"
   | otherwise = Image { imageWidth = w, imageHeight = h, imageData = plane }
@@ -529,12 +620,12 @@ instance LumaPlaneExtractable PixelYA8 where
     {-# INLINE computeLuma #-}
     computeLuma (PixelYA8 y _) = y
-    extractLumaPlane = extractComponent 0
+    extractLumaPlane = extractComponent PlaneLuma
 
 instance LumaPlaneExtractable PixelYCbCr8 where
     {-# INLINE computeLuma #-}
     computeLuma (PixelYCbCr8 y _ _) = y
-    extractLumaPlane = extractComponent 0
+    extractLumaPlane = extractComponent PlaneLuma
 
 -- | Free promotion for identic pixel types
 instance (Pixel a) => ColorConvertible a a where
− Codec/client_session_key.aes
@@ -1,2 +0,0 @@-	ÃõîecveÐ7Ï¿'¹n&öóѲÉ8{E‚Úœ¢ìCøµ£1ЛõëF‚8íZL‡¸ùÐ{æ-59ÈB«%­eMpGÛ9?-
¢®i¡Bøó1j‚ðêMöŠÉ
JuicyPixels.cabal view
@@ -1,10 +1,15 @@ Name:                JuicyPixels
-Version:             1.3
-Synopsis:            Picture loading/serialization (in png, jpeg and bitmap)
+Version:             2.0
+Synopsis:            Picture loading/serialization (in png, jpeg, bitmap and gif)
 Description:
-    This library can load and store images in various image formats,
- for now mainly in PNG/Bitmap and Jpeg
- 
+    This library can load and store images in PNG/Bitmap and Jpeg, and
+  read Gif images.
+
+ Version 2.0 changelog:
+    - New extractComponent version with type safe plane
+      extraction
+    - Gif file reading
+
  Version 1.3 changelog:
     - Fix extractComponent function
     - Adding saving for YA8 functions
@@ -29,12 +34,13 @@ Source-Repository this
     Type:      git
     Location:  git://github.com/Twinside/Juicy.Pixels.git
-    Tag:       v1.3
+    Tag:       v2.0
 
 Library
   Default-Language: Haskell2010
   Exposed-modules:  Codec.Picture,
                     Codec.Picture.Bitmap,
+                    Codec.Picture.Gif,
                     Codec.Picture.Png,
                     Codec.Picture.Jpg,
                     Codec.Picture.Saving,
@@ -45,7 +51,7 @@                  bytestring          >= 0.9     && < 0.10,
                  mtl                 >= 1.1     && < 2.2,
                  cereal              >= 0.3.3.0 && < 0.4,
-                 zlib                >= 0.5.3.1,
+                 zlib                >= 0.5.3.1 && < 0.6,
                  transformers        >= 0.2.2   && < 0.4,
                  vector              >= 0.9     && < 1.0,
                  primitive           >= 0.4     && < 0.5,
@@ -56,6 +62,8 @@                  Codec.Picture.Jpg.FastIdct,
                  Codec.Picture.Jpg.FastDct,
                  Codec.Picture.Jpg.Types,
+                 Codec.Picture.Gif.LZW,
                  Codec.Picture.Png.Export,
                  Codec.Picture.Png.Type,
                  Codec.Picture.BitWriter
+
README.md view
@@ -45,6 +45,9 @@     * 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/).