JuicyPixels 1.2.1 → 1.3
raw patch · 12 files changed
+537/−42 lines, 12 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- Codec/Picture/BitWriter.hs +3/−3
- Codec/Picture/Gif.hs +191/−0
- Codec/Picture/Gif/LZW.hs +178/−0
- Codec/Picture/Gif/Writer.hs +99/−0
- Codec/Picture/Jpg.hs +19/−14
- Codec/Picture/Png/Export.hs +8/−2
- Codec/Picture/Png/Type.hs +1/−1
- Codec/Picture/Saving.hs +4/−4
- Codec/Picture/Types.hs +14/−10
- Codec/client_session_key.aes +2/−0
- JuicyPixels.cabal +6/−3
- README.md +12/−5
Codec/Picture/BitWriter.hs view
@@ -76,7 +76,7 @@ runBoolWriter writer = do let finalWriter = writer >> flushWriter PairS _ (BoolWriteState builder _ _) <- - run finalWriter (BoolWriteState (empty) 0 0) + run finalWriter (BoolWriteState empty 0 0) return $ toByteString builder -- | Current serializer, bit buffer, bit count @@ -84,7 +84,7 @@ {-# UNPACK #-} !Word8 {-# UNPACK #-} !Int -data BoolWriterT m a = BitPut { run :: (BoolWriteState -> m (PairS a)) } +data BoolWriterT m a = BitPut { run :: BoolWriteState -> m (PairS a) } type BoolWriter s a = BoolWriterT (ST s) a @@ -131,7 +131,7 @@ | otherwise = let leftBitCount = 8 - count :: Int highPart = cleanData .>>. (bitCount - leftBitCount) :: Word32 - prevPart = (fromIntegral currentWord) .<<. leftBitCount :: Word32 + prevPart = fromIntegral currentWord .<<. leftBitCount :: Word32 nextMask = (1 .<<. (bitCount - leftBitCount)) - 1 :: Word32 newData = cleanData .&. nextMask :: Word32
+ Codec/Picture/Gif.hs view
@@ -0,0 +1,191 @@+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+ }+
+ Codec/Picture/Gif/LZW.hs view
@@ -0,0 +1,178 @@+{-# 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)
+ Codec/Picture/Gif/Writer.hs view
@@ -0,0 +1,99 @@+{-# 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
@@ -251,15 +251,15 @@ then 0 else 1 put4BitsOfEach classVal $ huffmanTableDest table mapM_ put . VU.toList $ huffSizes table - forM_ [0 .. 15] $ \i -> do + forM_ [0 .. 15] $ \i -> when (huffSizes table ! i /= 0) (let elements = VU.toList $ huffCodes table V.! i - in mapM_ put $ elements) + in mapM_ put elements) get = do (huffClass, huffDest) <- get4BitOfEach sizes <- replicateM 16 getWord8 - codes <- forM sizes $ \s -> do + codes <- forM sizes $ \s -> VU.replicateM (fromIntegral s) getWord8 return JpgHuffmanTableSpec { huffmanTableClass = @@ -270,7 +270,7 @@ } instance Serialize JpgImage where - put (JpgImage { jpgFrame = frames }) = do + put (JpgImage { jpgFrame = frames }) = putWord8 0xFF >> putWord8 0xD8 >> mapM_ putFrame frames >> putWord8 0xFF >> putWord8 0xD9 @@ -478,9 +478,14 @@ putWord8 . snd $ spectralSelection v put4BitsOfEach (successiveApproxHigh v) $ successiveApproxLow v +{-quantize :: MacroBlock Int16 -> MutableMacroBlock s Int32-} + {--> ST s (MutableMacroBlock s Int32)-} +{-quantize table = mutate (\idx val -> val `quot` fromIntegral (table !!! idx))-} + quantize :: MacroBlock Int16 -> MutableMacroBlock s Int32 -> ST s (MutableMacroBlock s Int32) -quantize table = mutate (\idx val -> val `quot` (fromIntegral $ table !!! idx)) +quantize table = mutate (\idx val -> val `quotient` fromIntegral (table !!! idx)) + where quotient val q = (val + (q `div` 2)) `quot` q -- rounded integer division -- | Apply a quantization matrix to a macroblock {-# INLINE deQuantize #-} @@ -846,7 +851,7 @@ pixelData = runST $ VS.unsafeFreeze =<< S.evalStateT (do resultImage <- lift $ M.replicate imageSize 0 let wrapped = MutableImage imgWidth imgHeight resultImage - setDecodedString {- . (\a -> trace ("read " ++ show (map (printf "%02X" :: Word8 -> String) $ B.unpack a)) a) -}$ imgData + setDecodedString imgData decodeImage compCount (buildJpegImageDecoder img) wrapped return resultImage) (-1, 0, B.empty) @@ -895,7 +900,7 @@ serializeMacroBlock dcCode acCode blk = lift (blk .!!!. 0) >>= (fromIntegral >>> encodeDc) >> writeAcs (0, 1) >> return () where writeAcs acc@(_, 63) = - lift (blk .!!!. 63) >>= (fromIntegral >>> encodeAcCoefs acc) + lift (blk .!!!. 63) >>= (fromIntegral >>> encodeAcCoefs acc) >> return () writeAcs acc@(_, i ) = lift (blk .!!!. i) >>= (fromIntegral >>> encodeAcCoefs acc) >>= writeAcs @@ -948,7 +953,7 @@ , huffmanTableDest = dest , huffSizes = sizes , huffCodes = V.fromListN 16 - [VU.fromListN (fromIntegral $ (sizes ! i)) lst + [VU.fromListN (fromIntegral $ sizes ! i) lst | (i, lst) <- zip [0..] tableDef ] }, Empty) where sizes = VU.fromListN 16 $ map (fromIntegral . length) tableDef @@ -1005,7 +1010,7 @@ } hdr = hdr' { jpgFrameHeaderLength = fromIntegral $ calculateSize hdr' } - hdr' = (JpgFrameHeader{ jpgFrameHeaderLength = 0 + hdr' = JpgFrameHeader{ jpgFrameHeaderLength = 0 , jpgSamplePrecision = 8 , jpgHeight = fromIntegral h , jpgWidth = fromIntegral w @@ -1027,15 +1032,15 @@ , quantizationTableDest = 1 } ] - }) + } lumaQuant = scaleQuantisationMatrix (fromIntegral quality) defaultLumaQuantizationTable chromaQuant = scaleQuantisationMatrix (fromIntegral quality) defaultChromaQuantizationTable - zigzagedLumaQuant = zigZagReorderForwardv $ lumaQuant - zigzagedChromaQuant = zigZagReorderForwardv $ chromaQuant + zigzagedLumaQuant = zigZagReorderForwardv lumaQuant + zigzagedChromaQuant = zigZagReorderForwardv chromaQuant quantTables = [ JpgQuantTableSpec { quantPrecision = 0, quantDestination = 0 , quantTable = zigzagedLumaQuant } , JpgQuantTableSpec { quantPrecision = 0, quantDestination = 1 @@ -1071,8 +1076,8 @@ ySamplingFactor = maxSampling - sizeY + 1 ] - workData <- lift $ createEmptyMutableMacroBlock - zigzaged <- lift $ createEmptyMutableMacroBlock + workData <- lift createEmptyMutableMacroBlock + zigzaged <- lift createEmptyMutableMacroBlock forM_ blockList $ \(comp, table, dc, ac, extractor) -> do prev_dc <- lift $ dc_table .!!!. comp (dc_coeff, neo_block) <- lift (extractor >>=
Codec/Picture/Png/Export.hs view
@@ -77,6 +77,9 @@ instance PngSavable Pixel8 where encodePng = genericEncodePng PngGreyscale 1 +instance PngSavable PixelYA8 where + encodePng = genericEncodePng PngGreyscaleWithAlpha 2 + -- | Write a dynamic image in a .png image file if possible. -- The same restriction as encodeDynamicPng apply. writeDynamicPng :: FilePath -> DynamicImage -> IO (Either String Bool) @@ -86,14 +89,17 @@ -- | Encode a dynamic image in bmp if possible, supported pixel type are : -- +-- - Y8 +-- +-- - YA8 +-- -- - RGB8 -- -- - RGBA8 -- --- - Y8 --- encodeDynamicPng :: DynamicImage -> Either String B.ByteString encodeDynamicPng (ImageRGB8 img) = Right $ encodePng img encodeDynamicPng (ImageRGBA8 img) = Right $ encodePng img encodeDynamicPng (ImageY8 img) = Right $ encodePng img +encodeDynamicPng (ImageYA8 img) = Right $ encodePng img encodeDynamicPng _ = Left "Unsupported image format for PNG export"
Codec/Picture/Png/Type.hs view
@@ -311,6 +311,6 @@ pngComputeCrc = (0xFFFFFFFF `xor`) . B.foldl' updateCrc 0xFFFFFFFF . B.concat where updateCrc crc val = let u32Val = fromIntegral val - lutVal = pngCrcTable ! (fromIntegral $ ((crc `xor` u32Val) .&. 0xFF)) + lutVal = pngCrcTable ! (fromIntegral ((crc `xor` u32Val) .&. 0xFF)) in lutVal `xor` (crc `shiftR` 8)
Codec/Picture/Saving.hs view
@@ -28,19 +28,19 @@ -- as PNG, make all color conversion and such. Equivalent -- of 'decodeImage' for PNG encoding imageToPng :: DynamicImage -> B.ByteString -imageToPng (ImageYCbCr8 img) = encodePng $ (convertImage img :: Image PixelRGB8) +imageToPng (ImageYCbCr8 img) = encodePng (convertImage img :: Image PixelRGB8) imageToPng (ImageRGB8 img) = encodePng img imageToPng (ImageRGBA8 img) = encodePng img imageToPng (ImageY8 img) = encodePng img -imageToPng (ImageYA8 img) = encodePng $ (promoteImage img :: Image PixelRGBA8) +imageToPng (ImageYA8 img) = encodePng (promoteImage img :: Image PixelRGBA8) -- | This function will try to do anything to encode an image -- as bitmap, make all color conversion and such. Equivalent -- of 'decodeImage' for Bitmap encoding imageToBitmap :: DynamicImage -> B.ByteString -imageToBitmap (ImageYCbCr8 img) = encodeBitmap $ (convertImage img :: Image PixelRGB8) +imageToBitmap (ImageYCbCr8 img) = encodeBitmap (convertImage img :: Image PixelRGB8) imageToBitmap (ImageRGB8 img) = encodeBitmap img imageToBitmap (ImageRGBA8 img) = encodeBitmap img imageToBitmap (ImageY8 img) = encodeBitmap img -imageToBitmap (ImageYA8 img) = encodeBitmap $ (promoteImage img :: Image PixelRGBA8) +imageToBitmap (ImageYA8 img) = encodeBitmap (promoteImage img :: Image PixelRGBA8)
Codec/Picture/Types.hs view
@@ -68,14 +68,18 @@ -- | 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 }) = - Image { imageWidth = w, imageHeight = h, imageData = plane } - where plane = stride img 1 padd comp - padd = componentCount (undefined :: a) - 1 +extractComponent 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 } + where plane = stride img 1 padd comp + padd = componentCount (undefined :: a) -- | For any image with an alpha component (transparency), -- drop it, returning a pure opaque image. @@ -512,15 +516,15 @@ instance LumaPlaneExtractable PixelRGB8 where {-# INLINE computeLuma #-} - computeLuma (PixelRGB8 r g b) = floor $ 0.3 * (toRational r) + - 0.59 * (toRational g) + - 0.11 * (toRational b) + computeLuma (PixelRGB8 r g b) = floor $ 0.3 * toRational r + + 0.59 * toRational g + + 0.11 * toRational b instance LumaPlaneExtractable PixelRGBA8 where {-# INLINE computeLuma #-} - computeLuma (PixelRGBA8 r g b _) = floor $ 0.3 * (toRational r) + - 0.59 * (toRational g) + - 0.11 * (toRational b) + computeLuma (PixelRGBA8 r g b _) = floor $ 0.3 * toRational r + + 0.59 * toRational g + + 0.11 * toRational b instance LumaPlaneExtractable PixelYA8 where {-# INLINE computeLuma #-}
+ Codec/client_session_key.aes view
@@ -0,0 +1,2 @@+ ÃõîecveÐ7Ï¿'¹n&öóѲÉ8{EÚ¢ìCøµ£1ÐõëF8íZL¸ùÐ{æ-59ÈB«%eMpGÛ9?+ ¢®i¡Bøó1jðêMöÉ
JuicyPixels.cabal view
@@ -1,9 +1,13 @@ Name: JuicyPixels -Version: 1.2.1 +Version: 1.3 Synopsis: Picture loading/serialization (in png, jpeg and bitmap) Description: This library can load and store images in various image formats, for now mainly in PNG/Bitmap and Jpeg + + Version 1.3 changelog: + - Fix extractComponent function + - Adding saving for YA8 functions homepage: https://github.com/Twinside/Juicy.Pixels License: BSD3 @@ -25,7 +29,7 @@ Source-Repository this Type: git Location: git://github.com/Twinside/Juicy.Pixels.git - Tag: v1.2.1 + Tag: v1.3 Library Default-Language: Haskell2010 @@ -55,4 +59,3 @@ Codec.Picture.Png.Export, Codec.Picture.Png.Type, Codec.Picture.BitWriter -
README.md view
@@ -1,15 +1,22 @@ 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 MUArray -or UArray full of juicy pixels. Or squared pixels, or whatever, as long -as they're unboxed. +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 ------