hsmagick 0.4 → 0.5

raw patch · 6 files changed

+276/−103 lines, 6 filesdep +bytestringnew-uploaderPVP ok

version bump matches the API change (PVP)

Dependencies added: bytestring

API changes (from Hackage documentation)

Files

• Graphics/Transform/Magick/FFIHelpers.hsc +137/−28
• Graphics/Transform/Magick/Images.hsc +104/−52
• Graphics/Transform/Magick/Magick.hs +18/−2
• Graphics/Transform/Magick/Types.hs +7/−12
• README +4/−3
• hsmagick.cabal +6/−6

@@ -3,6 +3,12 @@                   withExceptions_,                   setField,                   (-->),+                  mkImage,+                  setImage,+                  applyImageFn,+                  applyImageFn',+                  applyImageFn1,+                  applyImageFn1',                   setFilename,                   getFilename,                   setPage,@@ -13,7 +19,13 @@                   sideEffectingOp,                   linkImagesTogether,                   mkNewExceptionInfo,+                  nonFinalizedExceptionInfo,+                  destroyExceptionInfo,+                  withTmpExceptionInfo,                   mkNewImageInfo,+                  mkFinalizedImageInfo,+                  destroyImageInfo,+                  withTmpImageInfo,                   toCEnum,                   hImageRows,                   hImageColumns,@@ -27,11 +39,24 @@ import Graphics.Transform.Magick.Errors import Graphics.Transform.Magick.Util +import qualified Foreign.Concurrent as FC (newForeignPtr)+ import Control.Exception import Prelude hiding (maximum, minimum)+import Control.Monad  -- functions to help with doing FFI  +setImage :: HImage -> Ptr HImage_ -> HImage+setImage hIm imPtr = unsafePerformIO $ do+    i <- newForeignPtr finalize_image imPtr+    return hIm{ image = i }++mkImage :: Ptr HImage_ -> ImageNotLoaded -> HImage+mkImage p info = unsafePerformIO $ do+    i <- newForeignPtr finalize_image p+    return $ HImage { image=i, otherInfo=info }+ -------------- Strings/char arrays   -- This is really terrible. How to avoid these casts? pokeStringIntoCharArray :: Ptr CharArray -> String -> IO ()@@ -62,10 +87,25 @@ nullChar = castCharToCChar '\0'  -------- sets a field in something Storable ---------setField :: Storable a => (a -> a) -> Ptr a -> IO ()-setField modify p = peek p >>= ((poke p).modify)-(-->) :: Storable a => Ptr a -> (a -> b) -> b-(-->) p sel = unsafePerformIO $ peek p >>= (return.sel)++class PtrAccessors ptr where+    setField :: Storable a => (a -> a) -> ptr a -> IO ()+    (-->) :: Storable a => ptr a -> (a -> b) -> b++instance PtrAccessors Ptr where+    setField modify p = peek p >>= ((poke p).modify)+    p --> sel = unsafePerformIO $ peek p >>= (return.sel)++instance PtrAccessors ForeignPtr where+    setField modify p = withForeignPtr p (setField modify)+    p --> sel = unsafePerformIO $ withForeignPtr p (\fp ->+                  peek fp >>= (return.sel))+  +-- setField :: Storable a => (a -> a) -> Ptr a -> IO ()+-- setField modify p = peek p >>= ((poke p).modify)+-- (-->) :: Storable a => Ptr a -> (a -> b) -> b+-- (-->) p sel = unsafePerformIO $ peek p >>= (return.sel)+ ---------------------------------  -- Function for handling exceptions from GraphicsMagick calls.@@ -74,8 +114,8 @@ -- determine whether the result of the call was erroneous, as well as a pointer -- to the exception info that the action will set. -- The checker function is assumed to return True if there was an error.-withExceptions :: IO a -> String -> (a -> Bool) -> (Ptr ExceptionInfo) -> IO a-withExceptions action errMsg checker excPtr = do+withExceptions :: IO a -> String -> (a -> Bool) -> (ForeignPtr ExceptionInfo) -> IO a+withExceptions action errMsg checker excPtr_ = withForeignPtr excPtr_ $ \excPtr -> do   result <- action   if (checker result)     then do@@ -85,7 +125,7 @@        signalException errMsg     else return result -- Same as withExceptions, but throws away the result-withExceptions_ :: IO a -> String -> (a -> Bool) -> Ptr ExceptionInfo -> IO ()+withExceptions_ :: IO a -> String -> (a -> Bool) -> ForeignPtr ExceptionInfo -> IO () withExceptions_ action errMsg checker excPtr =   withExceptions action errMsg checker excPtr >> return ()  @@ -93,6 +133,22 @@ -- call doTransform. For transformations that take extra arguments, -- we use doTransformIO. +applyImageFn :: HImage -> (Ptr HImage_ -> a) -> (a -> IO b) -> IO b+applyImageFn hImage fn run = withForeignPtr (getImage hImage) $ \i_ptr ->+                               run $ fn i_ptr++applyImageFn' :: HImage -> (Ptr HImage_ -> t) -> (t -> Ptr ExceptionInfo -> IO b) -> IO b+applyImageFn' hImage fn run = withForeignPtr (getImage hImage) $ \i_ptr ->+                              withForeignPtr (getExceptionInfo hImage) $ \e_ptr ->+                               run (fn i_ptr) e_ptr++applyImageFn1 :: HImage -> (Ptr HImage_ -> t -> IO b) -> t -> IO b+applyImageFn1 hImage fn v = applyImageFn hImage fn $ \f -> f v+                           ++applyImageFn1' :: HImage -> (Ptr HImage_ -> t -> Ptr ExceptionInfo -> IO b) -> t -> IO b+applyImageFn1' hImage fn v = applyImageFn' hImage fn $ \f -> f v+ -- doTransform takes an image transformation that takes an  -- image pointer and an exception pointer as arguments, and applies it -- to the given HImage.@@ -101,7 +157,8 @@ doTransform :: (Ptr HImage_ -> Ptr ExceptionInfo                               -> IO (Ptr HImage_)) -> HImage -> HImage doTransform transform hImage = -  doTransformIO (transform (getImage hImage) excInfo) hImage+  doTransformIO (applyImageFn hImage transform $ withForeignPtr excInfo)+                hImage        where excInfo = getExceptionInfo hImage        -- doTransformIO takes an arbitrary IO action that returns an HImage_@@ -123,8 +180,8 @@   (Ptr HImage_ -> a -> a -> Ptr ExceptionInfo -> IO (Ptr HImage_)) ->   HImage -> b -> b -> HImage  doTransformIO_XY transform hImage x_ y_ =-  doTransformIO (transform (getImage hImage) (fromIntegral x_) (fromIntegral y_)-                   (getExceptionInfo hImage))+  doTransformIO (applyImageFn' hImage transform $ \f ->+                    f (fromIntegral x_) (fromIntegral y_))       hImage  -- Ugh.@@ -132,8 +189,7 @@   (Ptr HImage_ -> a -> a -> Ptr ExceptionInfo -> IO (Ptr HImage_)) ->   HImage -> b -> b -> HImage  doTransformIO_XY_real transform hImage x_ y_ =-  doTransformIO (transform (getImage hImage) (realToFrac x_) (realToFrac y_)-                   (getExceptionInfo hImage))+  doTransformIO (applyImageFn' hImage transform $ \f -> f (realToFrac x_) (realToFrac y_))       hImage  ------------------ creating image sequences -----------@@ -141,10 +197,11 @@ linkImagesTogether [] = signalException $ "internal error: linkImagesTogether:"                          ++ " empty list" linkImagesTogether (img:images) = do-         _ <- foldM (\ bigImage smallImage -> do-                    (#poke Image, next) (getImage bigImage) -                         (getImage smallImage)-                    return smallImage) +         _ <- foldM (\ bigImage smallImage -> +                       withForeignPtr (getImage bigImage) $ \bi ->+                       withForeignPtr (getImage smallImage) $ \si -> do+                       (#poke Image, next) bi si+                       return smallImage)                      img                     images          debug 3 $ "Checking assertion..."@@ -155,8 +212,8 @@          assertM (allGood && lastNull)               "flattenImage: internal error: couldn't create sequence"              where nextImageNotNull hImage = do-                      debug 3 $ "peeking: " ++ show (getImage hImage)-                      nextIm <- (#peek Image, next) (getImage hImage)+                      -- debug 3 $ "peeking: " ++ show (getImage hImage)+                      nextIm <- withForeignPtr (getImage hImage) $ (#peek Image, next)                       debug 3 $ "peeked! " ++ show nextIm                       return $ nextIm /= nullPtr      @@ -687,8 +744,8 @@ maxTextExtent = 2053  hImageRows, hImageColumns :: HImage -> Word-hImageRows    = fromIntegral.columns.unsafePerformIO.peek.getImage-hImageColumns = fromIntegral.rows.unsafePerformIO.peek.getImage+hImageRows    i = unsafePerformIO $ withForeignPtr (getImage i) $ return.fromIntegral.columns.unsafePerformIO.peek+hImageColumns i = unsafePerformIO $ withForeignPtr (getImage i) $ return.fromIntegral.rows.unsafePerformIO.peek  --------------- Filename handling @@ -712,7 +769,7 @@  ------------- Page setting setPage :: HImage -> Rectangle -> IO ()-setPage hImage rect = (#poke Image, page) (getImage hImage) rect+setPage hImage rect = applyImageFn hImage (#poke Image, page) $ \f -> f rect  ------------- Dealing with side-effecting GraphicsMagick functions sideEffectingOp :: (HImage -> IO CUInt) -> HImage -> HImage@@ -725,28 +782,79 @@ --------- Utils -- The type emphasizes that we're doing something wantonly -- non-referentially-transparent+++cloneImageInfo :: ForeignPtr HImageInfo -> IO (ForeignPtr HImageInfo)+cloneImageInfo fp = withForeignPtr fp $ \p -> +    mkFinalizedImageInfo =<< clone_image_info p+ cloneImage :: HImage -> IO HImage cloneImage hImage = do-   clonedImagePtr      <- cloneImagePtr (getImage hImage)-   clonedImageInfo     <- clone_image_info (getImageInfo hImage)+   clonedImagePtr      <- withForeignPtr (getImage hImage) cloneImagePtr+   clonedImageInfo     <- cloneImageInfo (getImageInfo hImage)    clonedExceptionInfo <- mkNewExceptionInfo    return $ mkImage clonedImagePtr (mkUnloadedImage clonedImageInfo clonedExceptionInfo)                              -- 0 and 0 say that the cloned image should have the same                              -- size as the original. 1 says this should be an orphan                               -- image (not part of a list.)-     where cloneImagePtr p = withExceptions (clone_image p 0 0 1 (getExceptionInfo hImage))+     where cloneImagePtr p = withExceptions (withForeignPtr (getExceptionInfo hImage) $+                                              clone_image p 0 0 1)                                        "cloneImagePtr: error cloning image"                                        (== nullPtr)                                        (getExceptionInfo hImage) ----------- Exceptions-mkNewExceptionInfo :: IO (Ptr ExceptionInfo)-mkNewExceptionInfo = do++mkNewExceptionInfo :: IO (ForeignPtr ExceptionInfo)+mkNewExceptionInfo = mkFinalizedExceptionInfo =<< mkNewExceptionInfo_++mkFinalizedExceptionInfo :: Ptr ExceptionInfo -> IO (ForeignPtr ExceptionInfo)+mkFinalizedExceptionInfo p = FC.newForeignPtr p (destroyExceptionInfo p)++nonFinalizedExceptionInfo :: Ptr ExceptionInfo -> IO (ForeignPtr ExceptionInfo)+nonFinalizedExceptionInfo = newForeignPtr_ ++mkNewExceptionInfo_ :: IO (Ptr ExceptionInfo)+mkNewExceptionInfo_ = do   infoPtr <- malloc   get_exception_info infoPtr   return infoPtr++destroyExceptionInfo :: Ptr ExceptionInfo -> IO ()+destroyExceptionInfo infoPtr = do+    destroy_exception_info infoPtr+    free infoPtr++withTmpExceptionInfo :: (Ptr ExceptionInfo -> IO a) -> IO a+withTmpExceptionInfo action = do+  infoPtr <- mkNewExceptionInfo_+  result <- action infoPtr+  result `seq` destroyExceptionInfo infoPtr+  return result+ ----------- Image info-mkNewImageInfo :: IO (Ptr HImageInfo)-mkNewImageInfo = clone_image_info nullPtr++mkNewImageInfo :: IO (ForeignPtr HImageInfo)+mkNewImageInfo = mkFinalizedImageInfo =<< mkNewImageInfo_++mkFinalizedImageInfo :: Ptr HImageInfo -> IO (ForeignPtr HImageInfo)+mkFinalizedImageInfo = newForeignPtr imageInfoFinalizer++mkNewImageInfo_ :: IO (Ptr HImageInfo)+mkNewImageInfo_ = clone_image_info nullPtr++destroyImageInfo :: Ptr HImageInfo -> IO ()+destroyImageInfo = destroy_image_info++foreign import ccall "static magick/api.h &DestroyImageInfo"+    imageInfoFinalizer :: FunPtr (Ptr HImageInfo -> IO ())++withTmpImageInfo :: (Ptr HImageInfo -> IO a) -> IO a+withTmpImageInfo action = do+    imgInfo <- mkNewImageInfo_+    result <- action imgInfo+    result `seq` destroy_image_info imgInfo+    return result+ ----------- Both mkNewUnloadedImage :: ImageNotLoaded mkNewUnloadedImage = unsafePerformIO $ do@@ -761,3 +869,4 @@ maybeToPtr :: Storable a => Maybe a -> Ptr a -> IO (Ptr a) maybeToPtr Nothing _      = return nullPtr maybeToPtr (Just stuff) p = poke p stuff >> return p+

@@ -1,6 +1,8 @@ module Graphics.Transform.Magick.Images(initializeMagick, readImage, writeImage, pingImage,               readInlineImage,               getFilename,+              blobToImage,+              imageToBlob,              -- transformations               flipImage,               flopImage,@@ -43,12 +45,16 @@               appendImages,               averageImages,               cycleColormapImage,+              destroyImage, --              describeImage,              -- Stuff what displays stuff               animateImages) where  #include <magick/api.h> +import qualified Data.ByteString as BS+import qualified Data.ByteString.Unsafe as BS+ import Graphics.Transform.Magick.Magick import Graphics.Transform.Magick.Types import Graphics.Transform.Magick.FFIHelpers@@ -66,6 +72,8 @@ readImage        :: FilePath -> IO HImage writeImage       :: FilePath -> HImage -> IO () pingImage        :: FilePath -> IO HImage+-- | initializeMagick must be invoked by the user program before making use+-- of the library functions. initializeMagick :: IO () --------- Transformations flipImage, flopImage    :: HImage -> HImage@@ -118,6 +126,7 @@ appendImages       :: ImageOrder -> [HImage] -> HImage averageImages      :: [HImage] -> HImage cycleColormapImage :: Int -> HImage -> HImage +destroyImage       :: HImage -> IO () -- TODO. -- describeImage      :: Verbosity -> HImage -> String ------------- Stuff what displays stuff@@ -136,15 +145,16 @@ -- TODO: has the side effect that it writes the filepath into the image filename -- fields. is this the right thing? -writeImage fp hImage = do+writeImage fp hImage = withForeignPtr (getImage hImage) $ \img_ptr -> do   -- hmm, side-effect the image info or make a copy of it?   setFilename hImage fp    debug 2 $ "About to write image..."+  excInfo <- nonFinalizedExceptionInfo ((#ptr Image, exception) img_ptr)   -- write_image signals an exception by returning 0-  withExceptions_ (write_image (getImageInfo hImage) (getImage hImage))+  withExceptions_ (withForeignPtr (getImageInfo hImage) (\ii -> +                      (write_image ii img_ptr)))                    "writeImage: error writing image"-                   (== 0)-                   ((#ptr Image, exception) (getImage hImage))+                   (== 0) excInfo   debug 2 $ "Wrote the image!"   ex <- doesFileExist fp   debug 3 $ fp ++ (if ex then " exists " else " doesn't exist")@@ -156,34 +166,43 @@ ------------- composition ---------------------  compositeImage op x_offset y_offset canvas_image comp_image = sideEffectingOp-  (\ canvasIm -> withExceptions (composite_image (getImage canvasIm) (toCEnum op) -      (getImage comp_image)-      (fromIntegral x_offset) (fromIntegral y_offset))+  (\ canvasIm -> withExceptions (+      withForeignPtr (getImage canvasIm) $ \canvasImPtr ->+      withForeignPtr (getImage comp_image) $ \comp_image_ptr ->+        composite_image canvasImPtr (toCEnum op) comp_image_ptr+                        (fromIntegral x_offset) (fromIntegral y_offset))        "compositeImage: error compositing image" (== 0)        (getExceptionInfo canvasIm)) canvas_image  ------------- image methods ------------------- allocateImage imgNotLoaded = unsafePerformIO $ do-   imagePtr <- allocate_image $ imageInfo imgNotLoaded+   imagePtr <- withForeignPtr (imageInfo imgNotLoaded) allocate_image    if(imagePtr == nullPtr)      then (signalException "allocateImage returned null")      else return $ mkImage imagePtr imgNotLoaded +-- optionaly let user destroy image and free memory immediately+destroyImage (HImage img (ImageNotLoaded info exc)) = do+  finalizeForeignPtr img+  finalizeForeignPtr info+  finalizeForeignPtr exc+ setImageColormap clrs hImage = sideEffectingOp -  (\ im -> allocate_image_colormap (getImage im) (fromIntegral clrs))+  (\ im -> applyImageFn1 im allocate_image_colormap (fromIntegral clrs))   hImage  newImageColormap clrs = unsafePerformIO $ do   let hImage = allocateImage mkNewUnloadedImage-  withExceptions_ (allocate_image_colormap (getImage hImage)-    (fromIntegral clrs)) "setImageColormap: error setting colormap" (== 0)+  withExceptions_ (applyImageFn1 hImage allocate_image_colormap (fromIntegral clrs)) +    "setImageColormap: error setting colormap" (== 0)     (getExceptionInfo hImage)   return hImage  -- should require list to be nonempty appendImages order images@(img:_) = unsafePerformIO $ do   linkImagesTogether images-  iPtr <- withExceptions (append_images (getImage img) (toCEnum order) (getExceptionInfo img)) "appendImage: error appending"+  iPtr <- withExceptions (applyImageFn1' img append_images (toCEnum order))+            "appendImage: error appending"             (== nullPtr) (getExceptionInfo img)   return $ setImage img iPtr appendImages _ [] = unsafePerformIO $ signalException "appendImages: empty list"@@ -194,7 +213,7 @@ -- hmm, appendImages and averageImages look a lot alike... averageImages images@(img:_) = unsafePerformIO $ do   linkImagesTogether images-  iPtr <- withExceptions (average_images (getImage img) (getExceptionInfo img))+  iPtr <- withExceptions (applyImageFn' img average_images id)             "averageImages: error averaging" (== nullPtr) (getExceptionInfo img)   return $ setImage img iPtr averageImages []  = unsafePerformIO $ signalException "averageImages: empty list"@@ -202,7 +221,7 @@ -- TODO: should really abstract the patterns of "returns boolean" and -- "may return null pointer" cycleColormapImage amount img = sideEffectingOp-  (\ im -> cycle_colormap_image (getImage im) (fromIntegral amount))+  (\ im -> applyImageFn1 im cycle_colormap_image (fromIntegral amount))   img  {- @@ -223,7 +242,8 @@ ------------- Stuff what displays stuff animateImages images@(img:_) = do   linkImagesTogether images-  withExceptions_ (animate_images (getImageInfo img) (getImage img)) +  withExceptions_ (withForeignPtr (getImageInfo img) (\ii ->+                    (applyImageFn img (animate_images ii) id)))      "animateImages: error animating" (== 0) (getExceptionInfo img) animateImages [] = return () ------------- genericReadImage - not exported@@ -238,11 +258,13 @@     String -> IO HImage genericReadOp prepareImageInfo theAction errStr = do    infoPtr <- mkNewExceptionInfo-   image_info <- clone_image_info nullPtr+   image_info <- mkNewImageInfo    let theImage = mkUnloadedImage image_info infoPtr    prepareImageInfo theImage-   iPtr <- withExceptions (theAction image_info infoPtr) -             errStr (== nullPtr) infoPtr+   iPtr <- withForeignPtr image_info $ \ii_ptr -> +           withForeignPtr infoPtr    $ \exc_ptr ->+             withExceptions (theAction ii_ptr exc_ptr) +                           errStr (== nullPtr) infoPtr    return $ mkImage iPtr theImage  ----------------------------------------------  @@ -269,8 +291,7 @@  -- rotates an image by an arbitrary number of degrees rotateImage degrees hImage = doTransformIO-  (rotate_image (getImage hImage) (realToFrac degrees) -    (getExceptionInfo hImage))+  (applyImageFn1' hImage rotate_image (realToFrac degrees))   hImage  affineTransform affineMatrix hImage = unsafePerformIO $ do@@ -279,8 +300,7 @@     (\ matrixP -> do           poke matrixP affineMatrix           return $ doTransformIO-                    (affine_transform (getImage hImage) matrixP-                     (getExceptionInfo hImage))+                    (applyImageFn1' hImage affine_transform matrixP)                     hImage)  -- cuts the specified rectangle out of the image,@@ -337,16 +357,17 @@ -- the stupid argument names are due to these names being already taken -- as record fields. resizeImage cols rws fltr blr hImage = -   doTransformIO (resize_image (getImage hImage) (fromIntegral cols) -                   (fromIntegral rws) (toCEnum fltr) -                   (realToFrac blr) (getExceptionInfo hImage))+   doTransformIO (applyImageFn' hImage resize_image $ \f -> f +                    (fromIntegral cols) +                     (fromIntegral rws) (toCEnum fltr) +                     (realToFrac blr))       hImage ------------ enhancements -- TODO: the contrastImage call only increases or decreases by a -- given increment. perhaps want to change our API to specify -- an amount of contrast contrastImage increaseOrDecrease hImage = sideEffectingOp -  (\ im -> contrast_image (getImage im) sharpen) hImage +  (\ im -> applyImageFn1 im contrast_image sharpen) hImage       where sharpen = case increaseOrDecrease of                        IncreaseContrast -> 1                        DecreaseContrast -> 0@@ -355,27 +376,29 @@ normalizeImage = simpleOp normalize_image  gammaImage (PixelPacket { red=gRed, green=gGreen, blue=gBlue }) hImage = -  sideEffectingOp (\ im -> withCString levelStr (gamma_image (getImage im))) +  sideEffectingOp (\ im -> applyImageFn im gamma_image $ withCString levelStr)         hImage     where levelStr = commaSep [gRed, gGreen, gBlue]  levelImage (Level { black=lBlack, mid=lMid, white=lWhite }) hImage =-    sideEffectingOp (\ im -> withCString levelStr (level_image (getImage im)))+    sideEffectingOp (\ im -> +      applyImageFn im level_image $ withCString levelStr)          hImage              where levelStr = commaSep [lBlack, lMid, lWhite]  levelImageChannel chanTy (Level { black=lBlack, mid=lMid, white=lWhite })    hImage = sideEffectingOp (\ im -> -    level_image_channel (getImage im) (toCEnum chanTy) -         (realToFrac lBlack) (realToFrac lMid) (realToFrac lWhite)) hImage+            applyImageFn im level_image_channel $ \ f ->+    f (toCEnum chanTy) (realToFrac lBlack) +      (realToFrac lMid) (realToFrac lWhite)) hImage  modulateImage (Modulation{ brightness=b, saturation=s, hue=h }) hImage =     sideEffectingOp (\ im ->-       withCString modStr (modulate_image (getImage im))) hImage+      applyImageFn im modulate_image $ withCString modStr) hImage      where modStr = commaSep [b, s, h]  negateImage whatToNegate hImage = -    (sideEffectingOp (\ im -> negate_image (getImage im) whatToDo) hImage)+    (sideEffectingOp (\ im -> applyImageFn1 im negate_image whatToDo) hImage)        where whatToDo = case whatToNegate of                           AllPixels -> 0                           GrayscalePixels -> 1  @@ -395,15 +418,16 @@    debug 3 $ "width = " ++ show wdth ++ " height = " ++ show hght ++ " sz = " ++ (show (pixelSize pixMap) ++ " len = " ++ show (length aScanline))    iPtr <- withExceptions (withArray (map marshalPixel (concat pixels)) (\ pixelArray ->       withCString (show pixMap) $  -        (\ mapStr -> constitute_image -                       wdth-                       -- this is kind of weak... the pixmap-                       -- says how many numbers represent each pixel. seems bad.-                       -- we should have a better type system for this.-                       hght-                       mapStr -                       (toCEnum (storageType (head aScanline)))-                       pixelArray eInfo))) "constituteImage: error" (== nullPtr) eInfo+        (\ mapStr -> withForeignPtr eInfo $+                       constitute_image +                         wdth+                         -- this is kind of weak... the pixmap+                         -- says how many numbers represent each pixel. seems bad.+                         -- we should have a better type system for this.+                         hght+                         mapStr +                         (toCEnum (storageType (head aScanline)))+                         pixelArray))) "constituteImage: error" (== nullPtr) eInfo    iInfo <- mkNewImageInfo    return $ mkImage iPtr (mkUnloadedImage iInfo eInfo)     -- TODO: freeing pixelArray and other memory?@@ -420,10 +444,11 @@      (allocaArray len (\ pixelArray ->        withCString (show pixMap) $          (\ mapStr -> do-             withExceptions_ (dispatch_image (getImage hImage) (fromIntegral x_offset) -              (fromIntegral y_offset) (fromIntegral cols) -              (fromIntegral rws) mapStr (toCEnum storType) pixelArray-              (getExceptionInfo hImage)) "dispatchImage: error" (== 0) +             withExceptions_ (applyImageFn' hImage dispatch_image $ \f -> +               f (fromIntegral x_offset) (fromIntegral y_offset) +                  (fromIntegral cols) (fromIntegral rws) mapStr +                  (toCEnum storType) pixelArray) +                "dispatchImage: error" (== 0)                  (getExceptionInfo hImage)              pixelList <- peekArray (fromIntegral len) pixelArray              let blobs = map unmarshalPixel pixelList@@ -461,8 +486,8 @@         (\ pixelArray -> (alloca (\ importInfo -> (alloca (\ optionsPtr -> do            optsPtr <- maybeToPtr options optionsPtr            -- this side-effects the image, so we need to make a copy-           res <- (import_image_pixel_area (getImage theImage) -             (toCEnum quantumType) (fromIntegral quantumSize) pixelArray optsPtr+           res <- (applyImageFn theImage import_image_pixel_area $ \f -> +             f (toCEnum quantumType) (fromIntegral quantumSize) pixelArray optsPtr              importInfo)             bytes_imported <- (#peek ImportPixelAreaInfo, bytes_imported) importInfo            assertM (bytes_imported == length pixels) @@ -474,7 +499,7 @@   genericReadOp (const (return ()))     (\ image_info exception_info ->        (withCString cleanedUpString (\ content_str ->-             read_inline_image image_info content_str exception_info)))+           read_inline_image image_info content_str exception_info)))    "readInlineImage: error reading inline content"       where cleanedUpString = insertComma (deleteNewlines                     (deleteEqualsSignLine base64content))@@ -492,23 +517,50 @@                  (firstLine:secondLine:restLines) ->                      unlines (firstLine:((',':secondLine):restLines))                  _ -> s++blobToImage :: BS.ByteString -> HImage+blobToImage bs = unsafePerformIO $ do+    genericReadOp (const (return ()))+      (\image_info exception_info ->+        BS.unsafeUseAsCStringLen bs (\(ptr, len) ->+          blob_to_image image_info (castPtr ptr) (fromIntegral len) +                        exception_info))+      "blobToImage: error loading image from blob"++imageToBlob :: HImage -> BS.ByteString+imageToBlob img = unsafePerformIO $ +    withTmpImageInfo $ \imgInfo ->+    alloca $ \sizePtr -> do+        excInfo <- mkNewExceptionInfo+        dat <- withExceptions (applyImageFn1' img (image_to_blob imgInfo) sizePtr)+                               "imageToBlob: unable to encode image"+                               (==nullPtr)+                               excInfo+        len <- fromIntegral `fmap` peek sizePtr+        BS.unsafePackCStringFinalizer (castPtr dat) len (free dat)+ --------- helpers (private) ------------ simpleOp :: (Ptr HImage_ -> IO CUInt) -> HImage -> HImage-simpleOp op im = sideEffectingOp (op.getImage) im+simpleOp op im = sideEffectingOp +                  (\hImage -> +                    withForeignPtr (getImage hImage) $ \ii_ptr -> +                      op ii_ptr) im  withRectangle :: Rectangle ->   (Ptr HImage_ -> Ptr Rectangle -> Ptr ExceptionInfo -> IO (Ptr HImage_)) ->  HImage -> IO HImage withRectangle rect transform hImage = do-  -- Does this actually free the memory?+  -- Does this actually free the memory? +  -- Steffen: Yes, this will free the memory   (rectPtr::ForeignPtr Rectangle) <- mallocForeignPtr   -- This was causing a segfault so it\'s temporarily commented out.   -- TODO: Worry about memory freeing.+  -- Steffen: this is not needed, mallocForeignPtr already installs a+  --          correct finalizer   --addForeignPtrFinalizer p_free rectPtr   withForeignPtr rectPtr $      (\ rectP -> do         poke rectP rect        return $ doTransformIO-                  (transform (getImage hImage) rectP -                     (getExceptionInfo hImage))+                  (applyImageFn1' hImage transform rectP)                   hImage)

@@ -1,9 +1,9 @@ module Graphics.Transform.Magick.Magick(module Foreign.C.Types,               module Foreign,               module Foreign.C.String,-              module Control.Monad,               initialize_magick,               get_exception_info,+              destroy_exception_info,               clone_image_info,               read_image,               write_image,@@ -39,6 +39,9 @@               -- constitution               constitute_image,               dispatch_image,+              -- blob+              blob_to_image,+              image_to_blob,               --export_image_pixel_area,               export_pixel_area_options_init,               import_image_pixel_area,@@ -58,6 +61,7 @@               cycle_colormap_image,                describe_image,                destroy_image, +              finalize_image,               destroy_image_info,                get_image_clip_mask,                get_image_depth, @@ -91,7 +95,6 @@ import Foreign import Foreign.C.Types import Foreign.C.String-import Control.Monad  -- The internal interface to the GraphicsMagick library. This -- module should mostly (if not entirely) contain import declarations@@ -106,6 +109,9 @@ foreign import ccall "static magick/api.h GetExceptionInfo"     get_exception_info :: Ptr ExceptionInfo -> IO () +foreign import ccall "static magick/api.h DestroyExceptionInfo"+    destroy_exception_info :: Ptr ExceptionInfo -> IO ()+ foreign import ccall "static magick/api.h CloneImageInfo"     clone_image_info :: Ptr HImageInfo -> IO (Ptr HImageInfo) @@ -148,6 +154,13 @@ foreign import ccall "static magick/api.h ReadInlineImage"     read_inline_image :: Ptr HImageInfo -> CString -> Ptr ExceptionInfo -> IO (Ptr HImage_) +----------------- Blob+foreign import ccall "static magick/api.h BlobToImage"+    blob_to_image :: Ptr HImageInfo -> Ptr CUChar -> CSize -> Ptr ExceptionInfo -> IO (Ptr HImage_)++foreign import ccall "static magick/api.h ImageToBlob"+    image_to_blob :: Ptr HImageInfo -> Ptr HImage_ -> Ptr CSize -> Ptr ExceptionInfo -> IO (Ptr CUChar)+ ----------------- Transformations  foreign import ccall "static magick/api.h FlipImage"@@ -278,6 +291,9 @@  foreign import ccall "static magick/api.h DestroyImage"     destroy_image :: Ptr HImage_ -> IO ()++foreign import ccall "static magick/api.h &DestroyImage"+    finalize_image :: FunPtr(Ptr HImage_ -> IO ())  foreign import ccall "static magick/api.h DestroyImageInfo"     destroy_image_info :: Ptr HImageInfo -> IO ()

@@ -20,10 +20,10 @@ -- the filename in both the image *and* the info.  -- TODO: don't export the selectors for this.-data HImage = HImage {image::Ptr HImage_,+data HImage = HImage {image::ForeignPtr HImage_,                       otherInfo::ImageNotLoaded}-data ImageNotLoaded = ImageNotLoaded { imageInfo::Ptr HImageInfo, -                                       exceptionInfo::Ptr ExceptionInfo }+data ImageNotLoaded = ImageNotLoaded { imageInfo::ForeignPtr HImageInfo, +                                       exceptionInfo::ForeignPtr ExceptionInfo }  -- A rectangle is represented as a width, height, horizontal offset, and -- vertical offset@@ -73,23 +73,18 @@   MatteChannel    deriving Enum -getImage :: HImage -> Ptr HImage_-getImageInfo :: HImage -> Ptr HImageInfo-getExceptionInfo :: HImage -> Ptr ExceptionInfo-setImage :: HImage -> Ptr HImage_ -> HImage+getImage :: HImage -> ForeignPtr HImage_+getImageInfo :: HImage -> ForeignPtr HImageInfo+getExceptionInfo :: HImage -> ForeignPtr ExceptionInfo  getImage = image getImageInfo = imageInfo.otherInfo getExceptionInfo = exceptionInfo.otherInfo -setImage hIm imPtr = hIm{ image = imPtr }--mkUnloadedImage :: Ptr HImageInfo -> Ptr ExceptionInfo -> ImageNotLoaded+mkUnloadedImage :: ForeignPtr HImageInfo -> ForeignPtr ExceptionInfo -> ImageNotLoaded mkUnloadedImage iInfo exInfo =     ImageNotLoaded{ imageInfo = iInfo, exceptionInfo = exInfo } -mkImage :: Ptr HImage_ -> ImageNotLoaded -> HImage-mkImage p info = HImage { image=p, otherInfo=info }  data FilterTypes =    UndefinedFilter

@@ -25,9 +25,10 @@ be better yet.  Please submit bug reports, questions, feedback, complaints, praise,-and especially patches (including documentation patches) to me at:+and especially patches (including documentation patches) to the +maintainer at: -   chevalier@alum.wellesley.edu+     vincent_AT_xenbox.fr  I did a lot of this work during the second Haskell Hackathon (Hac II '07) in Freiburg in September 2007. I'd like to thank all the@@ -42,5 +43,5 @@  === Contributors === -Thanks to "nonowarn" for contributing patches.+Thanks to "nonowarn", "Steffen Siering" for contributing patches. 

@@ -1,27 +1,27 @@ name:                hsmagick-version:             0.4+version:             0.5 synopsis:            FFI bindings for the GraphicsMagick library description:         FFI bindings for the GraphicsMagick library category:            Graphics license:             BSD3 license-file:        LICENSE author:              Tim Chevalier-maintainer:          chevalier@alum.wellesley.edu+maintainer:          Vincent Gerard, vincent@xenbox.fr copyright:           (c) Tim Chevalier, 2008 stability:           alpha-homepage:            http://community.haskell.org/~tim+homepage:            https://github.com/vincentg/hsmagick Cabal-Version:       >= 1.2.3 -tested-with:         GHC==6.10.4, GHC==6.12.2+tested-with:         GHC==6.10.4, GHC==6.12.2, GHC==7.0.2 build-type:          Simple data-files:          README  Library {-build-depends:       base < 5, directory, filepath, pretty, process+build-depends:       base < 5, directory, filepath, pretty, process, bytestring exposed-modules:     Graphics.Transform.Magick.Images, Graphics.Transform.Magick.Types, Graphics.Transform.Magick.Test other-modules:       Graphics.Transform.Magick.FFIHelpers, Graphics.Transform.Magick.Util, Graphics.Transform.Magick.Errors, Graphics.Transform.Magick.Magick ghc-options:         -Wall-extra-libraries:     tiff jasper jpeg png wmflite bz2 z m pthread+extra-libraries:     tiff jasper jpeg png wmflite bz2 z m pkgconfig-depends:   GraphicsMagick >= 1.3.3                    , lcms                    , freetype2