diff --git a/Graphics/ImageMagick/MagickWand/FFI/WandImage.hsc b/Graphics/ImageMagick/MagickWand/FFI/WandImage.hsc --- a/Graphics/ImageMagick/MagickWand/FFI/WandImage.hsc +++ b/Graphics/ImageMagick/MagickWand/FFI/WandImage.hsc @@ -595,6 +595,11 @@ foreign import ccall "MagickGetImageBlob" magickGetImageBlob :: Ptr MagickWand -> Ptr CSize -> IO (Ptr CChar) +-- | MagickGetImagesBlob() implements direct to memory image formats ideal +-- for use with sequenced images to get a dump of the whole sequence +foreign import ccall "MagickGetImagesBlob" magickGetImagesBlob + :: Ptr MagickWand -> Ptr CSize -> IO (Ptr CChar) + -- | MagickGetImageDepth() gets the image depth. foreign import ccall "MagickGetImageDepth" magickGetImageDepth :: Ptr MagickWand -> IO CSize diff --git a/Graphics/ImageMagick/MagickWand/WandImage.hs b/Graphics/ImageMagick/MagickWand/WandImage.hs --- a/Graphics/ImageMagick/MagickWand/WandImage.hs +++ b/Graphics/ImageMagick/MagickWand/WandImage.hs @@ -138,6 +138,7 @@ -- , getImageClipMask -- , getImageBackgroundColor , getImageBlob + , getImagesBlob -- , getImageBluePrimary -- , getImageBorderColor -- , getImageChannelDepth @@ -863,6 +864,25 @@ F.magickResetIterator w cl <- alloca $ \x -> do c <- F.magickGetImageBlob w x + x' <- fmap fromIntegral (peek x) + return (c,x') + out <- packCStringLen cl + F.magickRelinquishMemory $ castPtr $ fst cl + return out + +-- | MagickGetImageBlob() implements direct to memory image formats. It +-- returns the image sequence as a blob and its length. The format of the image +-- determines the format of the returned blob (GIF, JPEG, PNG, etc.). To +-- return a different image format, use MagickSetImageFormat(). +-- +-- Note, some image formats do not permit multiple images to the same image +-- stream (e.g. JPEG). in this instance, just the first image of the +-- sequence is returned as a blob.- Returns the image [sequence] as a blob and the total length +getImagesBlob :: (MonadResource m) => PMagickWand -> m ByteString +getImagesBlob w = liftIO $ do + F.magickResetIterator w + cl <- alloca $ \x -> do + c <- F.magickGetImagesBlob w x x' <- fmap fromIntegral (peek x) return (c,x') out <- packCStringLen cl diff --git a/imagemagick.cabal b/imagemagick.cabal --- a/imagemagick.cabal +++ b/imagemagick.cabal @@ -1,5 +1,5 @@ Name: imagemagick -Version: 0.0.3.1 +Version: 0.0.3.3 Synopsis: bindings to imagemagick library License: OtherLicense License-file: LICENSE @@ -70,7 +70,7 @@ , transformers == 0.3.* , vector >= 0.9 && <0.11 , bytestring >= 0.9 && <0.11 - , text == 0.11.* + , text >= 0.11 && <1.3 , system-filepath == 0.4.* , MonadCatchIO-transformers == 0.3.* extensions: EmptyDataDecls @@ -81,10 +81,6 @@ cpp-options: -DCABAL_OS_WINDOWS pkgconfig-depends: ImageMagick, MagickWand Build-tools: hsc2hs - if os(windows) - cpp-options: -DCABAL_OS_WINDOWS - if os(darwin) - cpp-options: -DCABAL_OS_DARWIN @@ -99,7 +95,7 @@ , transformers == 0.3.* , vector >= 0.9 && <0.11 , bytestring >= 0.9 && <0.11 - , text == 0.11.* + , text >= 0.11 && <1.3 , system-filepath == 0.4.* , imagemagick extensions: EmptyDataDecls @@ -118,7 +114,7 @@ , transformers == 0.3.* , vector >= 0.9 && <0.11 , bytestring >= 0.9 && <0.11 - , text == 0.11.* + , text >= 0.11 && < 1.3 , system-filepath == 0.4.* , imagemagick extensions: EmptyDataDecls @@ -137,7 +133,7 @@ , transformers == 0.3.* , vector >= 0.9 && <0.11 , bytestring >= 0.9 && <0.11 - , text == 0.11.* + , text >= 0.11 && <1.3 , system-filepath == 0.4.* , imagemagick extensions: EmptyDataDecls @@ -156,7 +152,7 @@ , transformers == 0.3.* , vector >= 0.9 && <0.11 , bytestring >= 0.9 && <0.11 - , text == 0.11.* + , text >= 0.11 && <1.3 , system-filepath == 0.4.* , imagemagick extensions: EmptyDataDecls @@ -175,7 +171,7 @@ , transformers == 0.3.* , vector >= 0.9 && <0.11 , bytestring >= 0.9 && <0.11 - , text == 0.11.* + , text >= 0.11 && <1.3 , system-filepath == 0.4.* , imagemagick extensions: EmptyDataDecls @@ -194,7 +190,7 @@ , transformers == 0.3.* , vector >= 0.9 && <0.11 , bytestring >= 0.9 && <0.11 - , text == 0.11.* + , text >= 0.11 && < 1.3 , system-filepath == 0.4.* , imagemagick extensions: EmptyDataDecls @@ -213,7 +209,7 @@ , transformers == 0.3.* , vector >= 0.9 && <0.11 , bytestring >= 0.9 && <0.11 - , text == 0.11.* + , text >= 0.11 && <1.3 , system-filepath == 0.4.* , imagemagick extensions: EmptyDataDecls @@ -232,7 +228,7 @@ , transformers == 0.3.* , vector >= 0.9 && <0.11 , bytestring >= 0.9 && <0.11 - , text == 0.11.* + , text >= 0.11 && < 1.3 , system-filepath == 0.4.* , imagemagick extensions: EmptyDataDecls @@ -250,7 +246,7 @@ , transformers == 0.3.* , vector >= 0.9 && <0.11 , bytestring >= 0.9 && <0.11 - , text == 0.11.* + , text >= 0.11 && <1.3 , system-filepath == 0.4.* , imagemagick extensions: EmptyDataDecls @@ -269,7 +265,7 @@ , transformers == 0.3.* , vector >= 0.9 && <0.11 , bytestring >= 0.9 && <0.11 - , text == 0.11.* + , text >= 0.11 && <1.3 , system-filepath == 0.4.* , imagemagick extensions: EmptyDataDecls @@ -288,7 +284,7 @@ , transformers == 0.3.* , vector >= 0.9 && <0.11 , bytestring >= 0.9 && <0.11 - , text == 0.11.* + , text >= 0.11 && <1.3 , system-filepath == 0.4.* , lifted-base >= 0.1 && <0.3 , imagemagick @@ -307,7 +303,7 @@ , transformers == 0.3.* , vector >= 0.9 && <0.11 , bytestring >= 0.9 && <0.11 - , text == 0.11.* + , text >= 0.11 && <1.3 , system-filepath == 0.4.* , imagemagick extensions: EmptyDataDecls @@ -326,7 +322,7 @@ , transformers == 0.3.* , vector >= 0.9 && <0.11 , bytestring >= 0.9 && <0.11 - , text == 0.11.* + , text >= 0.11 && <1.3 , system-filepath == 0.4.* , imagemagick extensions: EmptyDataDecls @@ -345,7 +341,7 @@ , transformers == 0.3.* , vector >= 0.9 && <0.11 , bytestring >= 0.9 && <0.11 - , text == 0.11.* + , text >= 0.11 && <1.3 , system-filepath == 0.4.* , imagemagick extensions: EmptyDataDecls @@ -365,7 +361,7 @@ , transformers == 0.3.* , vector >= 0.9 && <0.11 , bytestring >= 0.9 && <0.11 - , text == 0.11.* + , text >= 0.11 && <1.3 , system-filepath == 0.4.* , imagemagick extensions: EmptyDataDecls @@ -384,7 +380,7 @@ , transformers == 0.3.* , vector >= 0.9 && <0.11 , bytestring >= 0.9 && <0.11 - , text == 0.11.* + , text >= 0.11 && <1.3 , system-filepath == 0.4.* , imagemagick extensions: EmptyDataDecls @@ -404,7 +400,7 @@ , transformers == 0.3.* , vector >= 0.9 && <0.11 , bytestring >= 0.9 && <0.11 - , text == 0.11.* + , text >= 0.11 && <1.3 , system-filepath == 0.4.* , imagemagick extensions: EmptyDataDecls @@ -423,7 +419,7 @@ , transformers == 0.3.* , vector >= 0.9 && <0.11 , bytestring >= 0.9 && <0.11 - , text == 0.11.* + , text >= 0.11 && <1.3 , system-filepath == 0.4.* , imagemagick extensions: EmptyDataDecls @@ -442,7 +438,7 @@ , transformers == 0.3.* , vector >= 0.9 && <0.11 , bytestring >= 0.9 && <0.11 - , text == 0.11.* + , text >= 0.11 && <1.3 , system-filepath == 0.4.* , imagemagick extensions: EmptyDataDecls @@ -461,7 +457,7 @@ , transformers == 0.3.* , vector >= 0.9 && <0.11 , bytestring >= 0.9 && <0.11 - , text == 0.11.* + , text >= 0.11 && <1.3 , system-filepath == 0.4.* , imagemagick extensions: EmptyDataDecls @@ -480,7 +476,7 @@ , transformers == 0.3.* , vector >= 0.9 && <0.11 , bytestring >= 0.9 && <0.11 - , text == 0.11.* + , text >= 0.11 && <1.3 , system-filepath == 0.4.* , imagemagick extensions: EmptyDataDecls @@ -498,7 +494,7 @@ , transformers == 0.3.* , vector >= 0.9 && <0.11 , bytestring >= 0.9 && <0.11 - , text == 0.11.* + , text >= 0.11 && <1.3 , system-filepath == 0.4.* , imagemagick , QuickCheck >= 2 diff --git a/test/ImageTest.hs b/test/ImageTest.hs --- a/test/ImageTest.hs +++ b/test/ImageTest.hs @@ -65,6 +65,8 @@ , testCase "setting background color" test_setImageBackgroundColor , testCase "watermark" test_watermark , testCase "reset" test_reset + , testCase "getting an imageS blob for an animated GIF" test_getImagesBlobForSequence + , testCase "getting an imageS blob for a single image" test_getImagesBlobForSingle ] ] @@ -403,3 +405,18 @@ pw2 <- pixelWand getImagePixelColor w x y pw2 assertEqualPW pw1 pw2 + +test_getImagesBlobForSequence :: IO() +test_getImagesBlobForSequence = testGetImagesBlob "newtons-cradle.gif" + +test_getImagesBlobForSingle :: IO() +test_getImagesBlobForSingle = testGetImagesBlob "mona-lisa.jpg" + +testGetImagesBlob :: String -> IO() +testGetImagesBlob imgName = withImage imgName $ \w -> do + size <- getImageSize w + blob <- getImagesBlob w + (_,w') <- magickWand + readImageBlob w' blob + size' <- getImageSize w' + liftIO $ size' @?= size