JuicyPixels 1.2 → 1.2.1
raw patch · 10 files changed
+610/−450 lines, 10 filesdep −arraydep ~bytestringdep ~mtldep ~transformersPVP ok
version bump matches the API change (PVP)
Dependencies removed: array
Dependency ranges changed: bytestring, mtl, transformers
API changes (from Hackage documentation)
+ Codec.Picture: generateFoldImage :: Pixel a => (acc -> Int -> Int -> (acc, a)) -> acc -> Int -> Int -> (acc, Image a)
+ Codec.Picture: saveBmpImage :: String -> DynamicImage -> IO ()
+ Codec.Picture: saveJpgImage :: Int -> String -> DynamicImage -> IO ()
+ Codec.Picture: savePngImage :: String -> DynamicImage -> IO ()
+ Codec.Picture.Saving: imageToBitmap :: DynamicImage -> ByteString
+ Codec.Picture.Saving: imageToJpg :: Int -> DynamicImage -> ByteString
+ Codec.Picture.Saving: imageToPng :: DynamicImage -> ByteString
+ Codec.Picture.Types: generateFoldImage :: Pixel a => (acc -> Int -> Int -> (acc, a)) -> acc -> Int -> Int -> (acc, Image a)
Files
- Codec/Picture.hs +30/−1
- Codec/Picture/BitWriter.hs +145/−145
- Codec/Picture/Jpg.hs +17/−16
- Codec/Picture/Jpg/FastDct.hs +209/−209
- Codec/Picture/Jpg/Types.hs +61/−61
- Codec/Picture/Png/Type.hs +4/−4
- Codec/Picture/Saving.hs +46/−0
- Codec/Picture/Types.hs +42/−1
- JuicyPixels.cabal +12/−13
- README.md +44/−0
Codec/Picture.hs view
@@ -8,14 +8,21 @@ -- Generally, the read* functions read the images from a file and try to decode -- it, and the decode* functions try to decode a bytestring. -- --- For an easy image writing use the write* functions and writeDynamic* functions. +-- For an easy image writing use the 'saveBmpImage', 'saveJpgImage' & 'savePngImage' +-- functions module Codec.Picture ( -- * Generic functions readImage , decodeImage , pixelMap , generateImage + , generateFoldImage + -- * Generic image writing + , saveBmpImage + , saveJpgImage + , savePngImage + -- * Specific image format functions -- ** Bitmap handling , BmpEncodable @@ -62,6 +69,7 @@ import Codec.Picture.Jpg( decodeJpeg, encodeJpeg, encodeJpegAtQuality ) import Codec.Picture.Png( PngSavable( .. ), decodePng, writePng , encodeDynamicPng , writeDynamicPng ) +import Codec.Picture.Saving import Codec.Picture.Types import System.IO ( withFile, IOMode(ReadMode) ) import Prelude hiding(catch) @@ -115,4 +123,25 @@ -- | Try to load a .bmp file. The colorspace would be RGB or RGBA readBitmap :: FilePath -> IO (Either String DynamicImage) readBitmap = withImageDecoder decodeBitmap + +-- | Save an image to a '.jpg' file, will do everything it can to save an image. +saveJpgImage :: Int -> String -> DynamicImage -> IO () +saveJpgImage quality path img = B.writeFile path $ imageToJpg quality img + +-- | Save an image to a '.png' file, will do everything it can to save an image. +-- For example, a simple transcoder to png +-- +-- > transcodeToPng :: FilePath -> FilePath -> IO () +-- > transcodeToPng pathIn pathOut = do +-- > eitherImg <- decodeImage pathIn +-- > case eitherImg of +-- > Left _ -> return () +-- > Right img -> savePngImage img +-- +savePngImage :: String -> DynamicImage -> IO () +savePngImage path img = B.writeFile path $ imageToPng img + +-- | Save an image to a '.bmp' file, will do everything it can to save an image. +saveBmpImage :: String -> DynamicImage -> IO () +saveBmpImage path img = B.writeFile path $ imageToBitmap img
Codec/Picture/BitWriter.hs view
@@ -1,145 +1,145 @@-{-# LANGUAGE Rank2Types #-}--- | This module implement helper functions to read & write data--- at bits level.-module Codec.Picture.BitWriter( BoolWriter- , BoolReader- , writeBits- , byteAlign- , getNextBit- , setDecodedString- , runBoolWriter- ) where--import Control.Monad( when )-import Control.Monad.ST( ST- -- , runST- )-import qualified Control.Monad.Trans.State.Strict as S-import Control.Monad.Trans.Class( MonadTrans( .. ) )-import Data.Word( Word8, Word32 )--- import Data.Serialize( Put, runPut )-import Data.Serialize.Builder( Builder, empty, append, singleton, toByteString )-import Data.Bits( Bits, (.&.), (.|.), shiftR, shiftL )--import qualified Data.ByteString as B--{-# INLINE (.>>.) #-}-{-# INLINE (.<<.) #-}-(.<<.), (.>>.) :: (Bits a) => a -> Int -> a-(.<<.) = shiftL-(.>>.) = shiftR---------------------------------------------------------- Reader------------------------------------------------------ | Current bit index, current value, string-type BoolState = (Int, Word8, B.ByteString)---- | Type used to read bits-type BoolReader s a = S.StateT BoolState (ST s) a---- | 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- (idx, _, chain) <- S.get- when (idx /= 7) (setDecodedString chain)---- | Return the next bit in the input stream.-{-# INLINE getNextBit #-}-getNextBit :: BoolReader s Bool-getNextBit = do- (idx, v, chain) <- S.get- let val = (v .&. (1 `shiftL` idx)) /= 0- if idx == 0- then setDecodedString 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- 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 (v, rest) -> S.put ( 7, v, rest)--------------------------------------------------------- Writer------------------------------------------------------- | Run the writer and get the serialized data.-runBoolWriter :: BoolWriter s b -> ST s B.ByteString-runBoolWriter writer = do- let finalWriter = writer >> flushWriter- PairS _ (BoolWriteState builder _ _) <-- run finalWriter (BoolWriteState (empty) 0 0)- return $ toByteString builder---- | Current serializer, bit buffer, bit count -data BoolWriteState = BoolWriteState !Builder- {-# UNPACK #-} !Word8- {-# UNPACK #-} !Int--data BoolWriterT m a = BitPut { run :: (BoolWriteState -> m (PairS a)) }--type BoolWriter s a = BoolWriterT (ST s) a--data PairS a = PairS a {-# UNPACK #-} !BoolWriteState---- | If some bits are not serialized yet, write--- them in the MSB of a word.-flushWriter :: BoolWriter s ()-flushWriter = BitPut $ \st@(BoolWriteState p val count) -> return . PairS () $- let realVal = val `shiftL` (8 - count)- new_context = BoolWriteState (append p (singleton realVal)) 0 0- in if count == 0 then st else new_context--instance MonadTrans BoolWriterT where- lift a = BitPut $ \s ->- a >>= \b -> return $ PairS b s--instance Monad m => Monad (BoolWriterT m) where- m >>= k = BitPut $ \s -> do- PairS a s' <- run m s- PairS b s'' <- run (k a) s'- return $ PairS b s''- return x = BitPut $ \s -> return $ PairS x s---- | Append some data bits to a Put monad.-writeBits :: Word32 -- ^ The real data to be stored. Actual data should be in the LSB- -> Int -- ^ Number of bit to write from 1 to 32- -> BoolWriter s ()-writeBits = \d c -> BitPut (serialize d c)- where dumpByte str 0xFF = append (append str (singleton 0xFF)) $ singleton 0x00- dumpByte str i = append str (singleton i)-- serialize bitData bitCount (BoolWriteState str currentWord count)- | bitCount + count == 8 =- let newVal = fromIntegral $- (currentWord .<<. bitCount) .|. fromIntegral cleanData- in return . PairS () $ BoolWriteState (dumpByte str newVal) 0 0-- | bitCount + count < 8 =- let newVal = currentWord .<<. bitCount- in return . PairS () $ BoolWriteState str (newVal .|. fromIntegral cleanData)- (count + bitCount)-- | otherwise =- let leftBitCount = 8 - count :: Int- highPart = cleanData .>>. (bitCount - leftBitCount) :: Word32- prevPart = (fromIntegral currentWord) .<<. leftBitCount :: Word32-- nextMask = (1 .<<. (bitCount - leftBitCount)) - 1 :: Word32- newData = cleanData .&. nextMask :: Word32- newCount = bitCount - leftBitCount :: Int-- toWrite = fromIntegral $ prevPart .|. highPart :: Word8- in serialize newData newCount (BoolWriteState (dumpByte str toWrite) 0 0)-- where cleanMask = (1 `shiftL` bitCount) - 1 :: Word32- cleanData = bitData .&. cleanMask :: Word32-+{-# LANGUAGE Rank2Types #-} +-- | This module implement helper functions to read & write data +-- at bits level. +module Codec.Picture.BitWriter( BoolWriter + , BoolReader + , writeBits + , byteAlign + , getNextBit + , setDecodedString + , runBoolWriter + ) where + +import Control.Monad( when ) +import Control.Monad.ST( ST + -- , runST + ) +import qualified Control.Monad.Trans.State.Strict as S +import Control.Monad.Trans.Class( MonadTrans( .. ) ) +import Data.Word( Word8, Word32 ) +-- import Data.Serialize( Put, runPut ) +import Data.Serialize.Builder( Builder, empty, append, singleton, toByteString ) +import Data.Bits( Bits, (.&.), (.|.), shiftR, shiftL ) + +import qualified Data.ByteString as B + +{-# INLINE (.>>.) #-} +{-# INLINE (.<<.) #-} +(.<<.), (.>>.) :: (Bits a) => a -> Int -> a +(.<<.) = shiftL +(.>>.) = shiftR + + +-------------------------------------------------- +---- Reader +-------------------------------------------------- +-- | Current bit index, current value, string +type BoolState = (Int, Word8, B.ByteString) + +-- | Type used to read bits +type BoolReader s a = S.StateT BoolState (ST s) a + +-- | 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 + (idx, _, chain) <- S.get + when (idx /= 7) (setDecodedString chain) + +-- | Return the next bit in the input stream. +{-# INLINE getNextBit #-} +getNextBit :: BoolReader s Bool +getNextBit = do + (idx, v, chain) <- S.get + let val = (v .&. (1 `shiftL` idx)) /= 0 + if idx == 0 + then setDecodedString 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 + 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 (v, rest) -> S.put ( 7, v, rest) + +-------------------------------------------------- +---- Writer +-------------------------------------------------- + +-- | Run the writer and get the serialized data. +runBoolWriter :: BoolWriter s b -> ST s B.ByteString +runBoolWriter writer = do + let finalWriter = writer >> flushWriter + PairS _ (BoolWriteState builder _ _) <- + run finalWriter (BoolWriteState (empty) 0 0) + return $ toByteString builder + +-- | Current serializer, bit buffer, bit count +data BoolWriteState = BoolWriteState !Builder + {-# UNPACK #-} !Word8 + {-# UNPACK #-} !Int + +data BoolWriterT m a = BitPut { run :: (BoolWriteState -> m (PairS a)) } + +type BoolWriter s a = BoolWriterT (ST s) a + +data PairS a = PairS a {-# UNPACK #-} !BoolWriteState + +-- | If some bits are not serialized yet, write +-- them in the MSB of a word. +flushWriter :: BoolWriter s () +flushWriter = BitPut $ \st@(BoolWriteState p val count) -> return . PairS () $ + let realVal = val `shiftL` (8 - count) + new_context = BoolWriteState (append p (singleton realVal)) 0 0 + in if count == 0 then st else new_context + +instance MonadTrans BoolWriterT where + lift a = BitPut $ \s -> + a >>= \b -> return $ PairS b s + +instance Monad m => Monad (BoolWriterT m) where + m >>= k = BitPut $ \s -> do + PairS a s' <- run m s + PairS b s'' <- run (k a) s' + return $ PairS b s'' + return x = BitPut $ \s -> return $ PairS x s + +-- | Append some data bits to a Put monad. +writeBits :: Word32 -- ^ The real data to be stored. Actual data should be in the LSB + -> Int -- ^ Number of bit to write from 1 to 32 + -> BoolWriter s () +writeBits = \d c -> BitPut (serialize d c) + where dumpByte str 0xFF = append (append str (singleton 0xFF)) $ singleton 0x00 + dumpByte str i = append str (singleton i) + + serialize bitData bitCount (BoolWriteState str currentWord count) + | bitCount + count == 8 = + let newVal = fromIntegral $ + (currentWord .<<. bitCount) .|. fromIntegral cleanData + in return . PairS () $ BoolWriteState (dumpByte str newVal) 0 0 + + | bitCount + count < 8 = + let newVal = currentWord .<<. bitCount + in return . PairS () $ BoolWriteState str (newVal .|. fromIntegral cleanData) + (count + bitCount) + + | otherwise = + let leftBitCount = 8 - count :: Int + highPart = cleanData .>>. (bitCount - leftBitCount) :: Word32 + prevPart = (fromIntegral currentWord) .<<. leftBitCount :: Word32 + + nextMask = (1 .<<. (bitCount - leftBitCount)) - 1 :: Word32 + newData = cleanData .&. nextMask :: Word32 + newCount = bitCount - leftBitCount :: Int + + toWrite = fromIntegral $ prevPart .|. highPart :: Word8 + in serialize newData newCount (BoolWriteState (dumpByte str toWrite) 0 0) + + where cleanMask = (1 `shiftL` bitCount) - 1 :: Word32 + cleanData = bitData .&. cleanMask :: Word32 +
Codec/Picture/Jpg.hs view
@@ -26,9 +26,11 @@ ) import Data.Maybe( fromJust ) import qualified Data.Vector as V +import Data.Vector.Unboxed( (!) ) +import qualified Data.Vector.Unboxed as VU import qualified Data.Vector.Storable as VS import qualified Data.Vector.Storable.Mutable as M -import Data.Array.Unboxed( Array, UArray, elems, listArray, (!) ) +-- import Data.Array.Unboxed( Array, UArray, elems, listArray, (!) ) import qualified Data.ByteString as B import Foreign.Storable ( Storable ) @@ -202,13 +204,13 @@ -- | Stored on 4 bits , huffmanTableDest :: !Word8 - , huffSizes :: !(UArray Word32 Word8) - , huffCodes :: !(Array Word32 (UArray Int Word8)) + , huffSizes :: !(VU.Vector Word8) + , huffCodes :: !(V.Vector (VU.Vector Word8)) } deriving Show -buildPackedHuffmanTree :: Array Word32 (UArray Int Word8) -> HuffmanTree -buildPackedHuffmanTree = buildHuffmanTree . map elems . elems +buildPackedHuffmanTree :: V.Vector (VU.Vector Word8) -> HuffmanTree +buildPackedHuffmanTree = buildHuffmanTree . map VU.toList . V.toList -- | Decode a list of huffman values, not optimized for speed, but it -- should work. @@ -241,31 +243,30 @@ (skip 1 >> eatUntilCode) instance SizeCalculable JpgHuffmanTableSpec where - calculateSize table = 1 + 16 + sum [fromIntegral e | e <- elems $ huffSizes table] + calculateSize table = 1 + 16 + sum [fromIntegral e | e <- VU.toList $ huffSizes table] instance Serialize JpgHuffmanTableSpec where put table = do let classVal = if huffmanTableClass table == DcComponent then 0 else 1 put4BitsOfEach classVal $ huffmanTableDest table - mapM_ put {- . (\a -> trace ("sizes :" ++ show a) a) -}. elems $ huffSizes table + mapM_ put . VU.toList $ huffSizes table forM_ [0 .. 15] $ \i -> do when (huffSizes table ! i /= 0) - (let elements = elems $ huffCodes table ! i - in mapM_ put {- . (\a -> trace (show a) a)-} $ elements) + (let elements = VU.toList $ huffCodes table V.! i + in mapM_ put $ elements) get = do (huffClass, huffDest) <- get4BitOfEach sizes <- replicateM 16 getWord8 codes <- forM sizes $ \s -> do - let si = fromIntegral s - listArray (0, si - 1) <$> replicateM (fromIntegral s) getWord8 + VU.replicateM (fromIntegral s) getWord8 return JpgHuffmanTableSpec { huffmanTableClass = if huffClass == 0 then DcComponent else AcComponent , huffmanTableDest = huffDest - , huffSizes = listArray (0, 15) sizes - , huffCodes = listArray (0, 15) codes + , huffSizes = VU.fromListN 16 sizes + , huffCodes = V.fromListN 16 codes } instance Serialize JpgImage where @@ -946,11 +947,11 @@ (JpgHuffmanTableSpec { huffmanTableClass = classVal , huffmanTableDest = dest , huffSizes = sizes - , huffCodes = listArray (0, 15) - [listArray (0, fromIntegral $ (sizes ! i) - 1) lst + , huffCodes = V.fromListN 16 + [VU.fromListN (fromIntegral $ (sizes ! i)) lst | (i, lst) <- zip [0..] tableDef ] }, Empty) - where sizes = listArray (0,15) $ map (fromIntegral . length) tableDef + where sizes = VU.fromListN 16 $ map (fromIntegral . length) tableDef -- | Encode an image in jpeg at a reasonnable quality level. -- If you want better quality or reduced file size, you should
Codec/Picture/Jpg/FastDct.hs view
@@ -1,209 +1,209 @@-module Codec.Picture.Jpg.FastDct( referenceDct, fastDctLibJpeg ) where--import Control.Applicative( (<$>) )-import Data.Int( Int16, Int32 )-import Data.Bits( Bits, shiftR, shiftL )-import Control.Monad.ST( ST )--import qualified Data.Vector.Storable.Mutable as M--import Codec.Picture.Jpg.Types-import Control.Monad( forM, forM_ )--{-# INLINE (.>>.) #-}-{-# INLINE (.<<.) #-}-(.>>.), (.<<.) :: (Bits a) => a -> Int -> a-(.>>.) = shiftR-(.<<.) = shiftL---- | Reference implementation of the DCT, directly implementing the formula--- of ITU-81. It's slow as hell, perform to many operations, but is accurate--- and a good reference point.-referenceDct :: MutableMacroBlock s Int32- -> MutableMacroBlock s Int16- -> ST s (MutableMacroBlock s Int32)-referenceDct workData block = forM_ [(u, v) | u <- [0 :: Int .. 7], v <- [0..7]] (\(u,v) -> do- val <- at (u,v)- (workData .<-. (v * 8 + u)) . truncate $ (1 / 4) * c u * c v * val)- >> return workData- where -- at :: (Int, Int) -> ST s Float- at (u,v) = sum <$> (forM [(x,y) | x <- [0..7], y <- [0..7 :: Int]] $ \(x,y) -> do- sample <- fromIntegral <$> (block .!!!. (y * 8 + x))- return $ sample * cos ((2 * fromIntegral x + 1) * fromIntegral u * (pi :: Float)/ 16) - * cos ((2 * fromIntegral y + 1) * fromIntegral v * pi / 16))- c 0 = 1 / sqrt 2- c _ = 1--pASS1_BITS, cONST_BITS :: Int-cONST_BITS = 13-pASS1_BITS = 2---fIX_0_298631336, fIX_0_390180644, fIX_0_541196100,- fIX_0_765366865, fIX_0_899976223, fIX_1_175875602,- fIX_1_501321110, fIX_1_847759065, fIX_1_961570560,- fIX_2_053119869, fIX_2_562915447, fIX_3_072711026 :: Int32-fIX_0_298631336 =(2446) -- FIX(0.298631336) */-fIX_0_390180644 =(3196) -- FIX(0.390180644) */-fIX_0_541196100 =(4433) -- FIX(0.541196100) */-fIX_0_765366865 =(6270) -- FIX(0.765366865) */-fIX_0_899976223 =(7373) -- FIX(0.899976223) */-fIX_1_175875602 =(9633) -- FIX(1.175875602) */-fIX_1_501321110 =(12299) -- FIX(1.501321110) */-fIX_1_847759065 =(15137) -- FIX(1.847759065) */-fIX_1_961570560 =(16069) -- FIX(1.961570560) */-fIX_2_053119869 =(16819) -- FIX(2.053119869) */-fIX_2_562915447 =(20995) -- FIX(2.562915447) */-fIX_3_072711026 =(25172) -- FIX(3.072711026) */--cENTERJSAMPLE :: Int32-cENTERJSAMPLE = 128---- | Fast DCT extracted from libjpeg-fastDctLibJpeg :: MutableMacroBlock s Int32- -> MutableMacroBlock s Int16- -> ST s (MutableMacroBlock s Int32)-fastDctLibJpeg workData sample_block = do- firstPass workData 0- secondPass workData 7- {-_ <- mutate (\_ a -> a `quot` 8) workData-}- return workData- where -- Pass 1: process rows.- -- Note results are scaled up by sqrt(8) compared to a true DCT;- -- furthermore, we scale the results by 2**PASS1_BITS.- firstPass _ 8 = return ()- firstPass dataBlock i = do- let baseIdx = i * 8- readAt idx = fromIntegral <$> sample_block .!!!. (baseIdx + idx)- mult = (*)- writeAt idx n = (dataBlock .<-. (baseIdx + idx)) n- writeAtPos idx n = (dataBlock .<-. (baseIdx + idx))- (n .>>. (cONST_BITS - pASS1_BITS))-- blk0 <- readAt 0- blk1 <- readAt 1- blk2 <- readAt 2- blk3 <- readAt 3- blk4 <- readAt 4- blk5 <- readAt 5- blk6 <- readAt 6- blk7 <- readAt 7-- let tmp0 = blk0 + blk7- tmp1 = blk1 + blk6- tmp2 = blk2 + blk5- tmp3 = blk3 + blk4-- tmp10 = tmp0 + tmp3- tmp12 = tmp0 - tmp3- tmp11 = tmp1 + tmp2- tmp13 = tmp1 - tmp2-- tmp0' = blk0 - blk7- tmp1' = blk1 - blk6- tmp2' = blk2 - blk5- tmp3' = blk3 - blk4-- -- Stage 4 and output- writeAt 0 $ (tmp10 + tmp11 - 8 * cENTERJSAMPLE) .<<. pASS1_BITS- writeAt 4 $ (tmp10 - tmp11) .<<. pASS1_BITS-- let z1 = mult (tmp12 + tmp13) fIX_0_541196100- + (1 .<<. (cONST_BITS - pASS1_BITS - 1))-- writeAtPos 2 $ z1 + mult tmp12 fIX_0_765366865- writeAtPos 6 $ z1 - mult tmp13 fIX_1_847759065-- let tmp10' = tmp0' + tmp3'- tmp11' = tmp1' + tmp2'- tmp12' = tmp0' + tmp2'- tmp13' = tmp1' + tmp3'- z1' = mult (tmp12' + tmp13') fIX_1_175875602 -- c3 */- -- Add fudge factor here for final descale. */- + (1 .<<. (cONST_BITS - pASS1_BITS-1))- tmp0'' = mult tmp0' fIX_1_501321110- tmp1'' = mult tmp1' fIX_3_072711026- tmp2'' = mult tmp2' fIX_2_053119869- tmp3'' = mult tmp3' fIX_0_298631336-- tmp10'' = mult tmp10' (- fIX_0_899976223)- tmp11'' = mult tmp11' (- fIX_2_562915447)- tmp12'' = mult tmp12' (- fIX_0_390180644) + z1'- tmp13'' = mult tmp13' (- fIX_1_961570560) + z1'-- writeAtPos 1 $ tmp0'' + tmp10'' + tmp12''- writeAtPos 3 $ tmp1'' + tmp11'' + tmp13''- writeAtPos 5 $ tmp2'' + tmp11'' + tmp12''- writeAtPos 7 $ tmp3'' + tmp10'' + tmp13''-- firstPass dataBlock $ i + 1-- -- Pass 2: process columns.- -- We remove the PASS1_BITS scaling, but leave the results scaled up- -- by an overall factor of 8.- secondPass :: M.STVector s Int32 -> Int -> ST s ()- secondPass _ (-1) = return ()- secondPass block i = do- let readAt idx = block .!!!. ((7 - i) + idx * 8)- mult = (*)- writeAt idx n = (block .<-. (8 * idx + (7 - i))) n- writeAtPos idx n = (block .<-. (8 * idx + (7 - i))) $ n .>>. (cONST_BITS + pASS1_BITS + 3)- blk0 <- readAt 0- blk1 <- readAt 1- blk2 <- readAt 2- blk3 <- readAt 3- blk4 <- readAt 4- blk5 <- readAt 5- blk6 <- readAt 6- blk7 <- readAt 7-- let tmp0 = blk0 + blk7- tmp1 = blk1 + blk6- tmp2 = blk2 + blk5- tmp3 = blk3 + blk4-- -- Add fudge factor here for final descale. */- tmp10 = tmp0 + tmp3 + (1 .<<. (pASS1_BITS-1))- tmp12 = tmp0 - tmp3- tmp11 = tmp1 + tmp2- tmp13 = tmp1 - tmp2-- tmp0' = blk0 - blk7- tmp1' = blk1 - blk6- tmp2' = blk2 - blk5- tmp3' = blk3 - blk4-- writeAt 0 $ (tmp10 + tmp11) .>>. (pASS1_BITS + 3)- writeAt 4 $ (tmp10 - tmp11) .>>. (pASS1_BITS + 3)-- let z1 = mult (tmp12 + tmp13) fIX_0_541196100- + (1 .<<. (cONST_BITS + pASS1_BITS - 1))-- writeAtPos 2 $ z1 + mult tmp12 fIX_0_765366865- writeAtPos 6 $ z1 - mult tmp13 fIX_1_847759065-- let tmp10' = tmp0' + tmp3'- tmp11' = tmp1' + tmp2'- tmp12' = tmp0' + tmp2'- tmp13' = tmp1' + tmp3'-- z1' = mult (tmp12' + tmp13') fIX_1_175875602- -- Add fudge factor here for final descale. */- + 1 .<<. (cONST_BITS+pASS1_BITS-1);-- tmp0'' = mult tmp0' fIX_1_501321110- tmp1'' = mult tmp1' fIX_3_072711026- tmp2'' = mult tmp2' fIX_2_053119869- tmp3'' = mult tmp3' fIX_0_298631336- tmp10'' = mult tmp10' (- fIX_0_899976223)- tmp11'' = mult tmp11' (- fIX_2_562915447)- tmp12'' = mult tmp12' (- fIX_0_390180644)- + z1'- tmp13'' = mult tmp13' (- fIX_1_961570560)- + z1'- writeAtPos 1 $ tmp0'' + tmp10'' + tmp12''- writeAtPos 3 $ tmp1'' + tmp11'' + tmp13''- writeAtPos 5 $ tmp2'' + tmp11'' + tmp12''- writeAtPos 7 $ tmp3'' + tmp10'' + tmp13''-- secondPass block (i - 1)+module Codec.Picture.Jpg.FastDct( referenceDct, fastDctLibJpeg ) where + +import Control.Applicative( (<$>) ) +import Data.Int( Int16, Int32 ) +import Data.Bits( Bits, shiftR, shiftL ) +import Control.Monad.ST( ST ) + +import qualified Data.Vector.Storable.Mutable as M + +import Codec.Picture.Jpg.Types +import Control.Monad( forM, forM_ ) + +{-# INLINE (.>>.) #-} +{-# INLINE (.<<.) #-} +(.>>.), (.<<.) :: (Bits a) => a -> Int -> a +(.>>.) = shiftR +(.<<.) = shiftL + +-- | Reference implementation of the DCT, directly implementing the formula +-- of ITU-81. It's slow as hell, perform to many operations, but is accurate +-- and a good reference point. +referenceDct :: MutableMacroBlock s Int32 + -> MutableMacroBlock s Int16 + -> ST s (MutableMacroBlock s Int32) +referenceDct workData block = forM_ [(u, v) | u <- [0 :: Int .. 7], v <- [0..7]] (\(u,v) -> do + val <- at (u,v) + (workData .<-. (v * 8 + u)) . truncate $ (1 / 4) * c u * c v * val) + >> return workData + where -- at :: (Int, Int) -> ST s Float + at (u,v) = sum <$> (forM [(x,y) | x <- [0..7], y <- [0..7 :: Int]] $ \(x,y) -> do + sample <- fromIntegral <$> (block .!!!. (y * 8 + x)) + return $ sample * cos ((2 * fromIntegral x + 1) * fromIntegral u * (pi :: Float)/ 16) + * cos ((2 * fromIntegral y + 1) * fromIntegral v * pi / 16)) + c 0 = 1 / sqrt 2 + c _ = 1 + +pASS1_BITS, cONST_BITS :: Int +cONST_BITS = 13 +pASS1_BITS = 2 + + +fIX_0_298631336, fIX_0_390180644, fIX_0_541196100, + fIX_0_765366865, fIX_0_899976223, fIX_1_175875602, + fIX_1_501321110, fIX_1_847759065, fIX_1_961570560, + fIX_2_053119869, fIX_2_562915447, fIX_3_072711026 :: Int32 +fIX_0_298631336 =(2446) -- FIX(0.298631336) */ +fIX_0_390180644 =(3196) -- FIX(0.390180644) */ +fIX_0_541196100 =(4433) -- FIX(0.541196100) */ +fIX_0_765366865 =(6270) -- FIX(0.765366865) */ +fIX_0_899976223 =(7373) -- FIX(0.899976223) */ +fIX_1_175875602 =(9633) -- FIX(1.175875602) */ +fIX_1_501321110 =(12299) -- FIX(1.501321110) */ +fIX_1_847759065 =(15137) -- FIX(1.847759065) */ +fIX_1_961570560 =(16069) -- FIX(1.961570560) */ +fIX_2_053119869 =(16819) -- FIX(2.053119869) */ +fIX_2_562915447 =(20995) -- FIX(2.562915447) */ +fIX_3_072711026 =(25172) -- FIX(3.072711026) */ + +cENTERJSAMPLE :: Int32 +cENTERJSAMPLE = 128 + +-- | Fast DCT extracted from libjpeg +fastDctLibJpeg :: MutableMacroBlock s Int32 + -> MutableMacroBlock s Int16 + -> ST s (MutableMacroBlock s Int32) +fastDctLibJpeg workData sample_block = do + firstPass workData 0 + secondPass workData 7 + {-_ <- mutate (\_ a -> a `quot` 8) workData-} + return workData + where -- Pass 1: process rows. + -- Note results are scaled up by sqrt(8) compared to a true DCT; + -- furthermore, we scale the results by 2**PASS1_BITS. + firstPass _ 8 = return () + firstPass dataBlock i = do + let baseIdx = i * 8 + readAt idx = fromIntegral <$> sample_block .!!!. (baseIdx + idx) + mult = (*) + writeAt idx n = (dataBlock .<-. (baseIdx + idx)) n + writeAtPos idx n = (dataBlock .<-. (baseIdx + idx)) + (n .>>. (cONST_BITS - pASS1_BITS)) + + blk0 <- readAt 0 + blk1 <- readAt 1 + blk2 <- readAt 2 + blk3 <- readAt 3 + blk4 <- readAt 4 + blk5 <- readAt 5 + blk6 <- readAt 6 + blk7 <- readAt 7 + + let tmp0 = blk0 + blk7 + tmp1 = blk1 + blk6 + tmp2 = blk2 + blk5 + tmp3 = blk3 + blk4 + + tmp10 = tmp0 + tmp3 + tmp12 = tmp0 - tmp3 + tmp11 = tmp1 + tmp2 + tmp13 = tmp1 - tmp2 + + tmp0' = blk0 - blk7 + tmp1' = blk1 - blk6 + tmp2' = blk2 - blk5 + tmp3' = blk3 - blk4 + + -- Stage 4 and output + writeAt 0 $ (tmp10 + tmp11 - 8 * cENTERJSAMPLE) .<<. pASS1_BITS + writeAt 4 $ (tmp10 - tmp11) .<<. pASS1_BITS + + let z1 = mult (tmp12 + tmp13) fIX_0_541196100 + + (1 .<<. (cONST_BITS - pASS1_BITS - 1)) + + writeAtPos 2 $ z1 + mult tmp12 fIX_0_765366865 + writeAtPos 6 $ z1 - mult tmp13 fIX_1_847759065 + + let tmp10' = tmp0' + tmp3' + tmp11' = tmp1' + tmp2' + tmp12' = tmp0' + tmp2' + tmp13' = tmp1' + tmp3' + z1' = mult (tmp12' + tmp13') fIX_1_175875602 -- c3 */ + -- Add fudge factor here for final descale. */ + + (1 .<<. (cONST_BITS - pASS1_BITS-1)) + tmp0'' = mult tmp0' fIX_1_501321110 + tmp1'' = mult tmp1' fIX_3_072711026 + tmp2'' = mult tmp2' fIX_2_053119869 + tmp3'' = mult tmp3' fIX_0_298631336 + + tmp10'' = mult tmp10' (- fIX_0_899976223) + tmp11'' = mult tmp11' (- fIX_2_562915447) + tmp12'' = mult tmp12' (- fIX_0_390180644) + z1' + tmp13'' = mult tmp13' (- fIX_1_961570560) + z1' + + writeAtPos 1 $ tmp0'' + tmp10'' + tmp12'' + writeAtPos 3 $ tmp1'' + tmp11'' + tmp13'' + writeAtPos 5 $ tmp2'' + tmp11'' + tmp12'' + writeAtPos 7 $ tmp3'' + tmp10'' + tmp13'' + + firstPass dataBlock $ i + 1 + + -- Pass 2: process columns. + -- We remove the PASS1_BITS scaling, but leave the results scaled up + -- by an overall factor of 8. + secondPass :: M.STVector s Int32 -> Int -> ST s () + secondPass _ (-1) = return () + secondPass block i = do + let readAt idx = block .!!!. ((7 - i) + idx * 8) + mult = (*) + writeAt idx n = (block .<-. (8 * idx + (7 - i))) n + writeAtPos idx n = (block .<-. (8 * idx + (7 - i))) $ n .>>. (cONST_BITS + pASS1_BITS + 3) + blk0 <- readAt 0 + blk1 <- readAt 1 + blk2 <- readAt 2 + blk3 <- readAt 3 + blk4 <- readAt 4 + blk5 <- readAt 5 + blk6 <- readAt 6 + blk7 <- readAt 7 + + let tmp0 = blk0 + blk7 + tmp1 = blk1 + blk6 + tmp2 = blk2 + blk5 + tmp3 = blk3 + blk4 + + -- Add fudge factor here for final descale. */ + tmp10 = tmp0 + tmp3 + (1 .<<. (pASS1_BITS-1)) + tmp12 = tmp0 - tmp3 + tmp11 = tmp1 + tmp2 + tmp13 = tmp1 - tmp2 + + tmp0' = blk0 - blk7 + tmp1' = blk1 - blk6 + tmp2' = blk2 - blk5 + tmp3' = blk3 - blk4 + + writeAt 0 $ (tmp10 + tmp11) .>>. (pASS1_BITS + 3) + writeAt 4 $ (tmp10 - tmp11) .>>. (pASS1_BITS + 3) + + let z1 = mult (tmp12 + tmp13) fIX_0_541196100 + + (1 .<<. (cONST_BITS + pASS1_BITS - 1)) + + writeAtPos 2 $ z1 + mult tmp12 fIX_0_765366865 + writeAtPos 6 $ z1 - mult tmp13 fIX_1_847759065 + + let tmp10' = tmp0' + tmp3' + tmp11' = tmp1' + tmp2' + tmp12' = tmp0' + tmp2' + tmp13' = tmp1' + tmp3' + + z1' = mult (tmp12' + tmp13') fIX_1_175875602 + -- Add fudge factor here for final descale. */ + + 1 .<<. (cONST_BITS+pASS1_BITS-1); + + tmp0'' = mult tmp0' fIX_1_501321110 + tmp1'' = mult tmp1' fIX_3_072711026 + tmp2'' = mult tmp2' fIX_2_053119869 + tmp3'' = mult tmp3' fIX_0_298631336 + tmp10'' = mult tmp10' (- fIX_0_899976223) + tmp11'' = mult tmp11' (- fIX_2_562915447) + tmp12'' = mult tmp12' (- fIX_0_390180644) + + z1' + tmp13'' = mult tmp13' (- fIX_1_961570560) + + z1' + writeAtPos 1 $ tmp0'' + tmp10'' + tmp12'' + writeAtPos 3 $ tmp1'' + tmp11'' + tmp13'' + writeAtPos 5 $ tmp2'' + tmp11'' + tmp12'' + writeAtPos 7 $ tmp3'' + tmp10'' + tmp13'' + + secondPass block (i - 1)
Codec/Picture/Jpg/Types.hs view
@@ -1,61 +1,61 @@-module Codec.Picture.Jpg.Types( MutableMacroBlock- , createEmptyMutableMacroBlock- , mutate- , printMacroBlock- , (!!!), (.!!!.), (.<-.)- ) where--import Control.Monad.ST( ST )-import Foreign.Storable ( Storable )-import Control.Monad.Primitive ( PrimState, PrimMonad )-import qualified Data.Vector.Storable as V-import qualified Data.Vector.Storable.Mutable as M--- import Data.Vector.Storable( (!) )--import Text.Printf--{-# INLINE (!!!) #-}-(!!!) :: (Storable e) => V.Vector e -> Int -> e-(!!!) = -- (!) - V.unsafeIndex--{-# INLINE (.!!!.) #-}-(.!!!.) :: (PrimMonad m, Storable a)- => M.STVector (PrimState m) a -> Int -> m a-(.!!!.) = -- M.read- M.unsafeRead--{-# INLINE (.<-.) #-}-(.<-.) :: (PrimMonad m, Storable a)- => M.STVector (PrimState m) a -> Int -> a -> m ()-(.<-.) = -- M.write - M.unsafeWrite---- | Macroblock that can be transformed.-type MutableMacroBlock s a = M.STVector s a--{-# INLINE createEmptyMutableMacroBlock #-}--- | Create a new macroblock with the good array size-createEmptyMutableMacroBlock :: (Storable a, Num a) => ST s (MutableMacroBlock s a)-createEmptyMutableMacroBlock = M.replicate 64 0--{-# INLINE mutate #-}--- | Return the transformed block-mutate :: Storable a- => (Int -> a -> a) -- ^ The updating function- -> MutableMacroBlock s a -> ST s (MutableMacroBlock s a)-mutate f block = update 0 >> return block- where updateVal i = (block .!!!. i) >>= (block .<-. i) . f i-- update 63 = updateVal 63- update n = updateVal n >> update (n + 1)--printMacroBlock :: (Storable a, PrintfArg a)- => MutableMacroBlock s a -> ST s String-printMacroBlock block = pLn 0- where pLn 64 = return "===============================\n"- pLn i = do- v <- block .!!!. i- vn <- pLn (i+1)- return $ printf (if i `mod` 8 == 0 then "\n%5d " else "%5d ") v ++ vn-+module Codec.Picture.Jpg.Types( MutableMacroBlock + , createEmptyMutableMacroBlock + , mutate + , printMacroBlock + , (!!!), (.!!!.), (.<-.) + ) where + +import Control.Monad.ST( ST ) +import Foreign.Storable ( Storable ) +import Control.Monad.Primitive ( PrimState, PrimMonad ) +import qualified Data.Vector.Storable as V +import qualified Data.Vector.Storable.Mutable as M +-- import Data.Vector.Storable( (!) ) + +import Text.Printf + +{-# INLINE (!!!) #-} +(!!!) :: (Storable e) => V.Vector e -> Int -> e +(!!!) = -- (!) + V.unsafeIndex + +{-# INLINE (.!!!.) #-} +(.!!!.) :: (PrimMonad m, Storable a) + => M.STVector (PrimState m) a -> Int -> m a +(.!!!.) = -- M.read + M.unsafeRead + +{-# INLINE (.<-.) #-} +(.<-.) :: (PrimMonad m, Storable a) + => M.STVector (PrimState m) a -> Int -> a -> m () +(.<-.) = -- M.write + M.unsafeWrite + +-- | Macroblock that can be transformed. +type MutableMacroBlock s a = M.STVector s a + +{-# INLINE createEmptyMutableMacroBlock #-} +-- | Create a new macroblock with the good array size +createEmptyMutableMacroBlock :: (Storable a, Num a) => ST s (MutableMacroBlock s a) +createEmptyMutableMacroBlock = M.replicate 64 0 + +{-# INLINE mutate #-} +-- | Return the transformed block +mutate :: Storable a + => (Int -> a -> a) -- ^ The updating function + -> MutableMacroBlock s a -> ST s (MutableMacroBlock s a) +mutate f block = update 0 >> return block + where updateVal i = (block .!!!. i) >>= (block .<-. i) . f i + + update 63 = updateVal 63 + update n = updateVal n >> update (n + 1) + +printMacroBlock :: (Storable a, PrintfArg a) + => MutableMacroBlock s a -> ST s String +printMacroBlock block = pLn 0 + where pLn 64 = return "===============================\n" + pLn i = do + v <- block .!!!. i + vn <- pLn (i+1) + return $ printf (if i `mod` 8 == 0 then "\n%5d " else "%5d ") v ++ vn +
Codec/Picture/Png/Type.hs view
@@ -24,7 +24,7 @@ , putWord8, getWord8 , putWord32be, getWord32be , getByteString, putByteString ) -import Data.Array.Unboxed( UArray, listArray, (!) ) +import Data.Vector.Unboxed( Vector, fromListN, (!) ) import qualified Data.Vector.Storable as V import Data.List( foldl' ) import Data.Word( Word32, Word8 ) @@ -298,8 +298,8 @@ imageTypeOfCode _ = fail "Invalid png color code" -- | From the Annex D of the png specification. -pngCrcTable :: UArray Word32 Word32 -pngCrcTable = listArray (0, 255) [ foldl' updateCrcConstant c [zero .. 7] | c <- [0 .. 255] ] +pngCrcTable :: Vector Word32 +pngCrcTable = fromListN 256 [ foldl' updateCrcConstant c [zero .. 7] | c <- [0 .. 255] ] where zero = 0 :: Int -- To avoid defaulting to Integer updateCrcConstant c _ | c .&. 1 /= 0 = magicConstant `xor` (c `shiftR` 1) | otherwise = c `shiftR` 1 @@ -311,6 +311,6 @@ pngComputeCrc = (0xFFFFFFFF `xor`) . B.foldl' updateCrc 0xFFFFFFFF . B.concat where updateCrc crc val = let u32Val = fromIntegral val - lutVal = pngCrcTable ! ((crc `xor` u32Val) .&. 0xFF) + lutVal = pngCrcTable ! (fromIntegral $ ((crc `xor` u32Val) .&. 0xFF)) in lutVal `xor` (crc `shiftR` 8)
+ Codec/Picture/Saving.hs view
@@ -0,0 +1,46 @@+module Codec.Picture.Saving( imageToJpg + , imageToPng + , imageToBitmap + ) where + +import qualified Data.ByteString as B +import Codec.Picture.Bitmap +import Codec.Picture.Jpg +import Codec.Picture.Png +import Codec.Picture.Types + +-- | This function will try to do anything to encode an image +-- as JPEG, make all color conversion and such. Equivalent +-- of 'decodeImage' for jpeg encoding +imageToJpg :: Int -> DynamicImage -> B.ByteString +imageToJpg quality dynImage = + let encodeAtQuality = encodeJpegAtQuality (fromIntegral quality) + in case dynImage of + ImageYCbCr8 img -> encodeAtQuality img + ImageRGB8 img -> encodeAtQuality (convertImage img) + ImageRGBA8 img -> encodeAtQuality (convertImage $ dropAlphaLayer img) + ImageY8 img -> encodeAtQuality . convertImage + $ (promoteImage img :: Image PixelRGB8) + ImageYA8 img -> encodeAtQuality $ + convertImage (promoteImage $ dropAlphaLayer img :: Image PixelRGB8) + +-- | This function will try to do anything to encode an image +-- 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 (ImageRGB8 img) = encodePng img +imageToPng (ImageRGBA8 img) = encodePng img +imageToPng (ImageY8 img) = encodePng img +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 (ImageRGB8 img) = encodeBitmap img +imageToBitmap (ImageRGBA8 img) = encodeBitmap img +imageToBitmap (ImageY8 img) = encodeBitmap img +imageToBitmap (ImageYA8 img) = encodeBitmap $ (promoteImage img :: Image PixelRGBA8) +
Codec/Picture/Types.hs view
@@ -31,9 +31,10 @@ , pixelMap , dropAlphaLayer , generateImage + , generateFoldImage ) where -import Control.Monad( forM_ ) +import Control.Monad( forM_, foldM ) import Control.Applicative( (<$>), (<*>) ) import Control.DeepSeq( NFData( .. ) ) import Control.Monad.ST( ST, runST ) @@ -418,6 +419,13 @@ -- The function will receive value from 0 to width-1 for the x parameter -- and 0 to height-1 for the y parameter. The coordinate 0,0 is the upper -- left corner of the image, and (width-1, height-1) the lower right corner. +-- +-- for example, to create a small gradient image : +-- +-- > imageCreator :: String -> Image PixelRGB8 +-- > imageCreator path = writePng path $ generateImage pixelRenderer 250 300 +-- > where pixelRenderer x y = PixelRGB8 x y 128 +-- generateImage :: forall a. (Pixel a) => (Int -> Int -> a) -- ^ Generating function, with `x` and `y` params. -> Int -- ^ Width in pixels @@ -435,8 +443,41 @@ writePixel mutImage x y $ f x y V.unsafeFreeze arr +-- | This function implement the same algorithm as 'generateImage', +-- and let use an user-defined state +generateFoldImage :: forall a acc. (Pixel a) + => (acc -> Int -> Int -> (acc, a)) -- ^ Function taking the state, x and y + -> acc -- ^ Initial state + -> Int -- ^ Width in pixels + -> Int -- ^ Height in pixels + -> (acc, Image a) +generateFoldImage f intialAcc w h = + (finalState, Image { imageWidth = w, imageHeight = h, imageData = generated }) + where compCount = componentCount (undefined :: a) + (finalState, generated) = runST $ do + arr <- M.new (w * h * compCount) + let mutImage = MutableImage { + mutableImageWidth = w, + mutableImageHeight = h, + mutableImageData = arr } + foldResult <- foldM (\acc (x,y) -> do + let (acc', px) = f acc x y + writePixel mutImage x y px + return acc') intialAcc [(x,y) | y <- [0 .. h-1], x <- [0 .. w-1]] + + frozen <- V.unsafeFreeze arr + return (foldResult, frozen) + {-# INLINE pixelMap #-} -- | `map` equivalent for an image, working at the pixel level. +-- Little example : a brightness function for an rgb image +-- +-- > brightnessRGB8 :: Int -> Image PixelRGB8 -> Image PixelRGB8 +-- > brightnessRGB8 add = pixelMap brightFunction +-- > where up v = fromIntegral (fromIntegral v + add) +-- > brightFunction (PixelRGB8 r g b) = +-- > PixelRGB8 (up r) (up g) (up b) +-- pixelMap :: forall a b. (Pixel a, Pixel b) => (a -> b) -> Image a -> Image b pixelMap f image@(Image { imageWidth = w, imageHeight = h }) = Image w h pixels
JuicyPixels.cabal view
@@ -1,5 +1,5 @@ Name: JuicyPixels -Version: 1.2 +Version: 1.2.1 Synopsis: Picture loading/serialization (in png, jpeg and bitmap) Description: This library can load and store images in various image formats, @@ -25,7 +25,7 @@ Source-Repository this Type: git Location: git://github.com/Twinside/Juicy.Pixels.git - Tag: v1.2 + Tag: v1.2.1 Library Default-Language: Haskell2010 @@ -33,19 +33,19 @@ Codec.Picture.Bitmap, Codec.Picture.Png, Codec.Picture.Jpg, + Codec.Picture.Saving, Codec.Picture.Types Ghc-options: -O3 -Wall - Build-depends: base >= 4 && < 5, - array, - bytestring, - mtl >= 1.1, - cereal >= 0.3.3.0 && < 0.4, - zlib >= 0.5.3.1, - transformers >= 0.2.2 && < 0.3, - vector >= 0.9 && < 1.0, - primitive >= 0.4 && < 0.5, - deepseq >= 1.1 && < 1.4 + Build-depends: base >= 4 && < 5, + bytestring >= 0.9 && < 0.10, + mtl >= 1.1 && < 2.2, + cereal >= 0.3.3.0 && < 0.4, + zlib >= 0.5.3.1, + transformers >= 0.2.2 && < 0.4, + vector >= 0.9 && < 1.0, + primitive >= 0.4 && < 0.5, + deepseq >= 1.1 && < 1.4 -- Modules not exported by this package. Other-modules: Codec.Picture.Jpg.DefaultTable, @@ -56,4 +56,3 @@ Codec.Picture.Png.Type, Codec.Picture.BitWriter -
+ README.md view
@@ -0,0 +1,44 @@+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. + +Documentation +------------- +The library documentation can be accessed on [Hackage](http://hackage.haskell.org/package/JuicyPixels) + +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 + +_I love juicy pixels_ + +You can make [donations on this page](http://twinside.github.com/Juicy.Pixels/). +