module Graphics.ImageMagick.MagickWand.WandImage
( getImageHeight
, getImageWidth
, getImagePixelColor
, resizeImage
, getImageCompressionQuality
, setImageCompression
, setImageCompressionQuality
, getImageBackgroundColor
, setImageBackgroundColor
, extentImage
, floodfillPaintImage
, negateImage
, negateImageChannel
, getImageClipMask
, setImageClipMask
, compositeImage
, compositeImageChannel
, transparentPaintImage
, newImage
, drawImage
, borderImage
, shaveImage
, setImageAlphaChannel
, flipImage
, flopImage
, blurImage
, blurImageChannel
, normalizeImage
, normalizeImageChannel
, shadowImage
, addImage
, appendImages
, addNoiseImage
, writeImage
, writeImages
, setVirtualPixelMethod
, trimImage
, resetImagePage
, distortImage
, shadeImage
, colorizeImage
, fxImage
, fxImageChannel
, sigmoidalContrastImage
, sigmoidalContrastImageChannel
, evaluateImage
, evaluateImageChannel
, evaluateImages
, rollImage
, annotateImage
, mergeImageLayers
, tintImage
, gaussianBlurImageChannel
, gaussianBlurImage
, setImageMatte
, cropImage
, shearImage
, scaleImage
, sparseColorImage
, functionImage
, functionImageChannel
, coalesceImages
, getNumberImages
, getImage
, compareImageLayers
, getImageAlphaChannel
, getImageBlob
, getImageDelay
, getImageDepth
, getImageFormat
, getImageSignature
, readImage
, readImageBlob
, setImageDelay
, setImageDepth
, setImageFormat
, setImageType
, stripImage
, getImageScene
, setImage
, removeImage
, importImagePixels
, exportImagePixels
, rotateImage
) where
import Control.Applicative ((<$>))
import Control.Monad.IO.Class
import Control.Monad.Trans.Resource
import Data.ByteString (ByteString,
packCString,
packCStringLen,
useAsCString,
useAsCStringLen)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Text.Encoding (decodeUtf8,
encodeUtf8)
import Data.Vector.Storable (Vector)
import qualified Data.Vector.Storable as V
import Filesystem.Path.CurrentOS
import Foreign
import Foreign.C.Types
import Graphics.ImageMagick.MagickCore.Types
import qualified Graphics.ImageMagick.MagickWand.FFI.MagickWand as F
import Graphics.ImageMagick.MagickWand.FFI.Types
import qualified Graphics.ImageMagick.MagickWand.FFI.WandImage as F
import Graphics.ImageMagick.MagickWand.MagickWand
import Graphics.ImageMagick.MagickWand.PixelWand
import Graphics.ImageMagick.MagickWand.Types
import Graphics.ImageMagick.MagickWand.Utils
import Prelude hiding
(FilePath)
getImageHeight :: (MonadResource m) => Ptr MagickWand -> m Int
getImageHeight w = liftIO $ fmap fromIntegral (F.magickGetImageHeight w)
getImageWidth :: (MonadResource m) => Ptr MagickWand -> m Int
getImageWidth w = liftIO $ fmap fromIntegral (F.magickGetImageWidth w)
getImagePixelColor :: (MonadResource m)
=> PMagickWand
-> Int
-> Int
-> PPixelWand
-> m ()
getImagePixelColor w x y pw = withException_ w $! F.magickGetImagePixelColor w (fromIntegral x) (fromIntegral y) pw
resizeImage :: (MonadResource m) => Ptr MagickWand -> Int -> Int -> FilterTypes -> Double -> m ()
resizeImage pw w h f s = withException_ pw $! F.magickResizeImage pw (fromIntegral w) (fromIntegral h) f (realToFrac s)
getImageCompressionQuality :: (MonadResource m) => Ptr MagickWand -> m Int
getImageCompressionQuality = liftIO . fmap fromIntegral . F.magickGetImageCompressionQuality
setImageCompressionQuality :: (MonadResource m) => Ptr MagickWand -> Int -> m ()
setImageCompressionQuality w s = withException_ w $! F.magickSetImageCompressionQuality w (fromIntegral s)
getImageBackgroundColor :: (MonadResource m) => PMagickWand -> m PPixelWand
getImageBackgroundColor w = pixelWand >>= \p -> getImageBackgroundColor1 w p >> return p
getImageBackgroundColor1 :: (MonadResource m) => PMagickWand -> PPixelWand -> m ()
getImageBackgroundColor1 w p = withException_ w $! F.magickGetImageBackgroundColor w p
setImageBackgroundColor :: (MonadResource m) => PMagickWand -> PPixelWand -> m ()
setImageBackgroundColor w p = withException_ w $! F.magickSetImageBackgroundColor w p
extentImage :: (MonadResource m) => PMagickWand -> Int -> Int -> Int -> Int -> m ()
extentImage w width height offsetX offsetY = withException_ w $!
F.magickExtentImage w (fromIntegral width) (fromIntegral height) (fromIntegral offsetX) (fromIntegral offsetY)
floodfillPaintImage :: (MonadResource m) => PMagickWand -> ChannelType -> PPixelWand -> Double -> PPixelWand -> Int -> Int -> Bool -> m ()
floodfillPaintImage w channel fill fuzz border x y invert = withException_ w $!
F.magickFloodfillPaintImage w channel fill (realToFrac fuzz) border (fromIntegral x) (fromIntegral y) (toMBool invert)
negateImage :: (MonadResource m) => PMagickWand -> Bool -> m ()
negateImage p b = withException_ p $! F.magickNegateImage p (toMBool b)
negateImageChannel :: (MonadResource m) => PMagickWand -> ChannelType -> Bool -> m ()
negateImageChannel p c b = withException_ p $! F.magickNegateImageChannel p c (toMBool b)
getImageClipMask :: (MonadResource m) => PMagickWand -> m PMagickWand
getImageClipMask = liftIO . F.magickGetImageClipMask
setImageClipMask :: (MonadResource m) => PMagickWand -> PMagickWand -> m ()
setImageClipMask w s = withException_ w $ F.magickSetImageClipMask w s
compositeImage :: (MonadResource m) => PMagickWand -> PMagickWand -> CompositeOperator -> Int -> Int -> m ()
compositeImage p s c w h = withException_ p $ F.magickCompositeImage p s c (fromIntegral w) (fromIntegral h)
compositeImageChannel :: (MonadResource m) => PMagickWand -> PMagickWand -> ChannelType -> CompositeOperator -> Int -> Int -> m ()
compositeImageChannel p s ch c w h = withException_ p $
F.magickCompositeImageChannel p s ch c (fromIntegral w) (fromIntegral h)
transparentPaintImage :: (MonadResource m)
=> PMagickWand
-> PPixelWand
-> Double
-> Double
-> Bool
-> m ()
transparentPaintImage w p alfa fuzz invert = withException_ w $ F.magickTransparentPaintImage w p alfa fuzz (toMBool invert)
newImage :: (MonadResource m)
=> PMagickWand
-> Int
-> Int
-> PPixelWand
-> m ()
newImage p width height b = withException_ p $! F.magickNewImage p (fromIntegral width) (fromIntegral height) b
drawImage :: (MonadResource m) => PMagickWand -> PDrawingWand -> m ()
drawImage p d = withException_ p $ F.magickDrawImage p d
borderImage :: (MonadResource m) => PMagickWand -> PPixelWand -> Int -> Int -> m ()
borderImage w bordercolor height width = withException_ w $ F.magickBorderImage w bordercolor (fromIntegral width) (fromIntegral height)
shaveImage :: (MonadResource m) => PMagickWand -> Int -> Int -> m ()
shaveImage w columns rows = withException_ w $ F.magickShaveImage w (fromIntegral columns) (fromIntegral rows)
setImageAlphaChannel :: (MonadResource m) => PMagickWand -> AlphaChannelType -> m ()
setImageAlphaChannel w alpha_type = withException_ w $ F.magickSetImageAlphaChannel w alpha_type
flipImage :: (MonadResource m) => Ptr MagickWand -> m ()
flipImage w = withException_ w $ F.magickFlipImage w
flopImage :: (MonadResource m) => Ptr MagickWand -> m ()
flopImage w = withException_ w $ F.magickFlopImage w
addImage :: (MonadResource m) => PMagickWand -> PMagickWand -> m ()
addImage w w' = withException_ w $ F.magickAddImage w w'
appendImages :: (MonadResource m)
=> PMagickWand
-> Bool
-> m (ReleaseKey, PMagickWand)
appendImages w b = allocate (F.magickAppendImages w (toMBool b)) (void . F.destroyMagickWand)
addNoiseImage :: (MonadResource m)
=> PMagickWand
-> NoiseType
-> m ()
addNoiseImage w n = withException_ w $ F.magickAddNoiseImage w n
writeImage :: (MonadResource m)
=> PMagickWand
-> Maybe (FilePath)
-> m ()
writeImage w Nothing = withException_ w $ F.magickWriteImage w nullPtr
writeImage w (Just fn) = withException_ w $ useAsCString (encode fn) (\f -> F.magickWriteImage w f)
writeImages :: (MonadResource m) => Ptr MagickWand -> FilePath -> Bool -> m ()
writeImages w fn b = withException_ w $ useAsCString (encode fn) (\f -> F.magickWriteImages w f (toMBool b))
blurImage :: (MonadResource m) => PMagickWand -> Double -> Double -> m ()
blurImage w r s = withException_ w $ F.magickBlurImage w (realToFrac r) (realToFrac s)
blurImageChannel :: (MonadResource m) => PMagickWand -> ChannelType -> Double -> Double -> m ()
blurImageChannel w c r s = withException_ w $ F.magickBlurImageChannel w c (realToFrac r) (realToFrac s)
normalizeImage :: (MonadResource m) => PMagickWand -> m ()
normalizeImage w = withException_ w $ F.magickNormalizeImage w
normalizeImageChannel :: (MonadResource m) => PMagickWand -> ChannelType -> m ()
normalizeImageChannel w c = withException_ w $ F.magickNormalizeImageChannel w c
shadowImage :: (MonadResource m)
=> PMagickWand
-> Double
-> Double
-> Int
-> Int
-> m ()
shadowImage w opacity sigma x y = withException_ w $ F.magickShadowImage w (realToFrac opacity) (realToFrac sigma)
(fromIntegral x) (fromIntegral y)
setVirtualPixelMethod :: (MonadResource m) => PMagickWand -> VirtualPixelMethod -> m VirtualPixelMethod
setVirtualPixelMethod = (liftIO .). F.magickSetVirtualPixelMethod
trimImage :: (MonadResource m) => PMagickWand -> Double -> m ()
trimImage w fuzz = withException_ w $ F.magickTrimImage w (realToFrac fuzz)
resetImagePage :: (MonadResource m) => PMagickWand -> Maybe Text -> m ()
resetImagePage w Nothing = withException_ w $ F.magickResetImagePage w nullPtr
resetImagePage w (Just page) = withException_ w $ useAsCString (encodeUtf8 page) (F.magickResetImagePage w)
distortImage :: (MonadResource m)
=> PMagickWand
-> DistortImageMethod
-> [Double]
-> Bool
-> m ()
distortImage w method args bestfit = withException_ w $! withArrayLen (map realToFrac args) distort
where
distort len arr = F.magickDistortImage w method (fromIntegral len) arr (toMBool bestfit)
shadeImage :: (MonadResource m)
=> PMagickWand
-> Bool
-> Double
-> Double
-> m ()
shadeImage w gray azimuth elevation = withException_ w $ F.magickShadeImage w (toMBool gray)
(realToFrac azimuth) (realToFrac elevation)
colorizeImage :: (MonadResource m) => PMagickWand -> PPixelWand -> PPixelWand -> m ()
colorizeImage w colorize opacity = withException_ w $! F.magickColorizeImage w colorize opacity
fxImage :: (MonadResource m) => PMagickWand -> Text -> m (ReleaseKey, Ptr MagickWand)
fxImage w expr = wandResource (useAsCString (encodeUtf8 expr) (F.magickFxImage w))
fxImageChannel :: (MonadResource m) => PMagickWand -> ChannelType -> Text -> m (ReleaseKey, Ptr MagickWand)
fxImageChannel w channel expr = wandResource (useAsCString (encodeUtf8 expr) (F.magickFxImageChannel w channel))
sigmoidalContrastImage :: (MonadResource m) => PMagickWand -> Bool -> Double -> Double -> m ()
sigmoidalContrastImage w sharpen alpha beta =
withException_ w $! F.magickSigmoidalContrastImage w (toMBool sharpen) (realToFrac alpha) (realToFrac beta)
sigmoidalContrastImageChannel :: (MonadResource m) => PMagickWand -> ChannelType -> Bool -> Double -> Double -> m ()
sigmoidalContrastImageChannel w channel sharpen alpha beta =
withException_ w $! F.magickSigmoidalContrastImageChannel w channel (toMBool sharpen) (realToFrac alpha) (realToFrac beta)
evaluateImage :: (MonadResource m)
=> PMagickWand
-> MagickEvaluateOperator
-> CDouble
-> m ()
evaluateImage w op value = withException_ w $! F.magickEvaluateImage w op value
evaluateImages :: (MonadResource m)
=> PMagickWand
-> MagickEvaluateOperator
-> m ()
evaluateImages w op = withException_ w $! F.magickEvaluateImages w op
evaluateImageChannel :: (MonadResource m)
=> PMagickWand
-> ChannelType
-> MagickEvaluateOperator
-> CDouble
-> m ()
evaluateImageChannel w channel op value = withException_ w $! F.magickEvaluateImageChannel w channel op value
rollImage :: (MonadResource m) => PMagickWand -> Double -> Double -> m ()
rollImage w x y = withException_ w $! F.magickRollImage w (realToFrac x) (realToFrac y)
annotateImage :: (MonadResource m)
=> PMagickWand
-> PDrawingWand
-> Double
-> Double
-> Double
-> Text
-> m ()
annotateImage w dw x y angle text =
withException_ w $! useAsCString (encodeUtf8 text)
(F.magickAnnotateImage w dw (realToFrac x) (realToFrac y) (realToFrac angle))
mergeImageLayers :: (MonadResource m) => PMagickWand -> ImageLayerMethod -> m (ReleaseKey, PMagickWand)
mergeImageLayers w method = wandResource (F.magickMergeImageLayers w method)
tintImage :: (MonadResource m) => PMagickWand
-> PPixelWand
-> PPixelWand
-> m ()
tintImage w t o = withException_ w $ F.magickTintImage w t o
gaussianBlurImage :: (MonadResource m) => PMagickWand
-> Double
-> Double
-> m ()
gaussianBlurImage w r s = withException_ w $ F.magickGaussianBlurImage w (realToFrac r) (realToFrac s)
gaussianBlurImageChannel :: (MonadResource m) => PMagickWand
-> ChannelType
-> Double
-> Double
-> m ()
gaussianBlurImageChannel w c r s = withException_ w $ F.magickGaussianBlurImageChannel w c (realToFrac r) (realToFrac s)
setImageMatte :: (MonadResource m) => PMagickWand
-> Bool
-> m ()
setImageMatte w b = withException_ w $ F.magickSetImageMatte w (toMBool b)
cropImage :: (MonadResource m) => PMagickWand
-> Int
-> Int
-> Int
-> Int
-> m ()
cropImage w width height x y = withException_ w $ F.magickCropImage w (fromIntegral width) (fromIntegral height)
(fromIntegral x) (fromIntegral y)
shearImage :: (MonadResource m) => PMagickWand
-> PPixelWand
-> Double
-> Double
-> m ()
shearImage w pw x_shear y_shear =
withException_ w $ F.magickShearImage w pw (realToFrac x_shear) (realToFrac y_shear)
scaleImage :: (MonadResource m) => PMagickWand
-> Int
-> Int
-> m ()
scaleImage w columns rows =
withException_ w $ F.magickScaleImage w (fromIntegral columns) (fromIntegral rows)
sparseColorImage :: (MonadResource m) => PMagickWand
-> ChannelType
-> SparseColorMethod
-> Vector Double
-> m()
sparseColorImage w c m v =
withException_ w $ V.unsafeWith v $ \v' -> F.magickSparseColorImage w c m (fromIntegral $ V.length v) v'
functionImage :: (MonadResource m) => PMagickWand -> MagickFunction -> Vector Double -> m ()
functionImage w f v =
withException_ w $ V.unsafeWith v $ \v' -> F.magickFunctionImage w f (fromIntegral $ V.length v) v'
functionImageChannel :: (MonadResource m) => PMagickWand -> ChannelType -> MagickFunction -> Vector Double -> m ()
functionImageChannel w c f v =
withException_ w $ V.unsafeWith v $ \v' -> F.magickFunctionImageChannel w c f (fromIntegral $ V.length v) v'
coalesceImages :: (MonadResource m) => PMagickWand
-> m (ReleaseKey, PMagickWand)
coalesceImages = wandResource . F.magickCoalesceImages
getNumberImages :: (MonadResource m) => PMagickWand -> m Int
getNumberImages w = liftIO $ fromIntegral <$> F.magickGetNumberImages w
getImage :: (MonadResource m) => PMagickWand -> m (ReleaseKey, PMagickWand)
getImage = wandResource . F.magickGetImage
compareImageLayers :: (MonadResource m) => PMagickWand -> ImageLayerMethod -> m (ReleaseKey, PMagickWand)
compareImageLayers = (wandResource .). F.magickCompareImageLayers
getImageScene :: (MonadResource m) => PMagickWand -> m Int
getImageScene w = liftIO $ fromIntegral <$> F.magickGetImageScene w
removeImage :: (MonadResource m) => PMagickWand -> m ()
removeImage w = withException_ w $ F.magickRemoveImage w
setImage :: (MonadResource m) => PMagickWand -> PMagickWand -> m ()
setImage w sw = withException_ w $ F.magickSetImage w sw
importImagePixels :: (MonadResource m, Pixel a) => PMagickWand
-> Int
-> Int
-> Int
-> Int
-> Text
-> [a]
-> m ()
importImagePixels w x y width height cmap pixels =
withException_ w $ useAsCString (encodeUtf8 cmap) $ \cstr ->
withPixels pixels $ (F.magickImportImagePixels w x' y' width' height' cstr stype) . castPtr
where
x' = fromIntegral x
y' = fromIntegral y
width' = fromIntegral width
height' = fromIntegral height
stype = pixelStorageType pixels
exportImagePixels :: (MonadResource m, Pixel a) => PMagickWand
-> Int
-> Int
-> Int
-> Int
-> Text
-> m [a]
exportImagePixels w x y width height cmap = liftIO $ useAsCString (encodeUtf8 cmap) $ \cstr ->
exportArray arrLength (F.magickExportImagePixels w x' y' width' height' cstr) (undefined)
where
exportArray :: (Pixel a) => Int -> (StorageType -> Ptr () -> IO b) -> [a] -> IO [a]
exportArray s f hack = allocaArray s (\q -> f storage (castPtr q) >> peekArray s q)
where storage = pixelStorageType hack
x' = fromIntegral x
y' = fromIntegral y
width' = fromIntegral width
height' = fromIntegral height
arrLength = width * height * (T.length cmap)
rotateImage :: (MonadResource m) => PMagickWand -> PPixelWand -> Double -> m ()
rotateImage w background degrees = withException_ w $ F.magickRotateImage w background (realToFrac degrees)
getImageDepth :: (MonadResource m) => PMagickWand -> m Int
getImageDepth w = liftIO $ fromIntegral <$> F.magickGetImageDepth w
setImageDepth :: (MonadResource m) => PMagickWand -> Int -> m ()
setImageDepth w depth = withException_ w $ F.magickSetImageDepth w (fromIntegral depth)
setImageCompression:: (MonadResource m) => PMagickWand -> CompressionType -> m ()
setImageCompression w compressionType = withException_ w $ F.magickSetImageCompression w compressionType
getImageDelay :: (MonadResource m) => PMagickWand -> m Int
getImageDelay w = liftIO $ fromIntegral <$> F.magickGetImageDelay w
setImageDelay :: (MonadResource m) => PMagickWand -> Int -> m ()
setImageDelay w delay = withException_ w $ F.magickSetImageDelay w (fromIntegral delay)
getImageBlob :: (MonadResource m) => PMagickWand -> m ByteString
getImageBlob w = liftIO $ do
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
readImage :: (MonadResource m) => Ptr MagickWand -> FilePath -> m ()
readImage w fn = withException_ w $ useAsCString (encode fn) (F.magickReadImage w)
readImageBlob :: (MonadResource m) => PMagickWand -> ByteString -> m ()
readImageBlob w bs = withException_ w $ useAsCStringLen bs $
\(cstr, len) -> F.magickReadImageBlob w (castPtr cstr) (fromIntegral len)
getImageFormat :: (MonadResource m) => PMagickWand -> m Text
getImageFormat w = liftIO $ do
cstr <- F.magickGetImageFormat w
decodeUtf8 <$> packCString cstr
setImageFormat :: (MonadResource m) => PMagickWand -> Text -> m ()
setImageFormat w format = withException_ w $ useAsCString (encodeUtf8 format) (F.magickSetImageFormat w)
stripImage :: (MonadResource m) => PMagickWand -> m ()
stripImage w = withException_ w $ (F.magickStripImage w)
getImageSignature :: (MonadResource m) => PMagickWand -> m ByteString
getImageSignature w = liftIO $ F.magickGetImageSignature w >>= packCString
getImageAlphaChannel :: (MonadResource m) => PMagickWand -> m Bool
getImageAlphaChannel = fromMBool . F.magickGetImageAlphaChannel
setImageType :: (MonadResource m) => PMagickWand -> ImageType -> m ()
setImageType w imageType = withException_ w $ F.magickSetImageType w imageType