├── Setup.hs ├── data ├── beach.jpg ├── sasha.jpg ├── croptest.png ├── google.ico ├── marked.png ├── trimtest.png ├── mona-lisa.jpg ├── resettest.png ├── rotatetest.gif ├── watermark.png ├── newtons-cradle.gif ├── orientation_0.jpeg ├── orientation_1.jpeg ├── orientation_2.jpeg ├── orientation_3.jpeg ├── orientation_4.jpeg ├── orientation_5.jpeg ├── orientation_6.jpeg ├── orientation_7.jpeg └── orientation_8.jpeg ├── sequence.miff ├── .gitignore ├── src └── Graphics │ └── ImageMagick │ ├── MagickWand │ ├── FFI │ │ ├── ImageDrawing.hsc │ │ ├── Types.hsc │ │ ├── PixelIterator.hsc │ │ ├── WandProperties.hsc │ │ ├── PixelWand.hsc │ │ └── DrawingWand.hsc │ ├── Utils.hs │ ├── PixelPacket.hs │ ├── Types.hs │ ├── PixelIterator.hs │ └── PixelWand.hs │ ├── MagickCore │ ├── FFI │ │ ├── Quantize.hsc │ │ ├── Option.hsc │ │ ├── Mime.hsc │ │ ├── Log.hsc │ │ └── Gem.hsc │ ├── Types │ │ ├── MBits.hs │ │ └── FFI │ │ │ ├── PaintMethod.hsc │ │ │ ├── MagickFunction.hsc │ │ │ ├── Constitute.hsc │ │ │ ├── DitherMethod.hsc │ │ │ ├── Fx.hsc │ │ │ ├── Image.hsc │ │ │ ├── Geometry.hsc │ │ │ ├── AlphaChannelType.hsc │ │ │ ├── Types.hsc │ │ │ ├── ChannelType.hsc │ │ │ ├── Log.hsc │ │ │ ├── Layer.hsc │ │ │ ├── PixelPacket.hsc │ │ │ ├── FilterTypes.hsc │ │ │ ├── ColorspaceType.hsc │ │ │ ├── Compress.hsc │ │ │ ├── CacheView.hsc │ │ │ ├── Distort.hsc │ │ │ ├── Quantize.hsc │ │ │ ├── Statistic.hsc │ │ │ ├── Composite.hsc │ │ │ └── Exception.hsc │ ├── Quantize.hs │ ├── Option.hs │ ├── Exception.hs │ ├── Mime.hs │ ├── Gem.hs │ └── Types.hs │ ├── MagickCore.hs │ └── MagickWand.hs ├── stack.yaml ├── travis ├── install-imagemagick.sh └── cabal-apt-install ├── ChangeLog ├── examples ├── basic.hs ├── floodfill.hs ├── extent.hs ├── cyclops.hs ├── trans_paint.hs ├── grayscale.hs ├── round_mask.hs ├── resize.hs ├── clipmask.hs ├── tilt_shift.hs ├── pixel_mod.hs ├── basic2.hs ├── reflect.hs ├── bunny.hs ├── make_tile.hs ├── modulate.hs ├── landscape_3d.hs ├── gel.hs ├── draw_shapes.hs ├── wandtest.hs ├── 3dlogo.hs ├── affine.hs └── text_effects.hs ├── README ├── .github └── workflows │ └── haskell-ci.yml └── LICENSE /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /data/beach.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/qnikst/imagemagick/HEAD/data/beach.jpg -------------------------------------------------------------------------------- /data/sasha.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/qnikst/imagemagick/HEAD/data/sasha.jpg -------------------------------------------------------------------------------- /sequence.miff: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/qnikst/imagemagick/HEAD/sequence.miff -------------------------------------------------------------------------------- /data/croptest.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/qnikst/imagemagick/HEAD/data/croptest.png -------------------------------------------------------------------------------- /data/google.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/qnikst/imagemagick/HEAD/data/google.ico -------------------------------------------------------------------------------- /data/marked.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/qnikst/imagemagick/HEAD/data/marked.png -------------------------------------------------------------------------------- /data/trimtest.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/qnikst/imagemagick/HEAD/data/trimtest.png -------------------------------------------------------------------------------- /data/mona-lisa.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/qnikst/imagemagick/HEAD/data/mona-lisa.jpg -------------------------------------------------------------------------------- /data/resettest.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/qnikst/imagemagick/HEAD/data/resettest.png -------------------------------------------------------------------------------- /data/rotatetest.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/qnikst/imagemagick/HEAD/data/rotatetest.gif -------------------------------------------------------------------------------- /data/watermark.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/qnikst/imagemagick/HEAD/data/watermark.png -------------------------------------------------------------------------------- /data/newtons-cradle.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/qnikst/imagemagick/HEAD/data/newtons-cradle.gif -------------------------------------------------------------------------------- /data/orientation_0.jpeg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/qnikst/imagemagick/HEAD/data/orientation_0.jpeg -------------------------------------------------------------------------------- /data/orientation_1.jpeg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/qnikst/imagemagick/HEAD/data/orientation_1.jpeg -------------------------------------------------------------------------------- /data/orientation_2.jpeg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/qnikst/imagemagick/HEAD/data/orientation_2.jpeg -------------------------------------------------------------------------------- /data/orientation_3.jpeg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/qnikst/imagemagick/HEAD/data/orientation_3.jpeg -------------------------------------------------------------------------------- /data/orientation_4.jpeg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/qnikst/imagemagick/HEAD/data/orientation_4.jpeg -------------------------------------------------------------------------------- /data/orientation_5.jpeg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/qnikst/imagemagick/HEAD/data/orientation_5.jpeg -------------------------------------------------------------------------------- /data/orientation_6.jpeg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/qnikst/imagemagick/HEAD/data/orientation_6.jpeg -------------------------------------------------------------------------------- /data/orientation_7.jpeg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/qnikst/imagemagick/HEAD/data/orientation_7.jpeg -------------------------------------------------------------------------------- /data/orientation_8.jpeg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/qnikst/imagemagick/HEAD/data/orientation_8.jpeg -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | cabal-dev 2 | dist 3 | TAGS 4 | .stack-work/ 5 | dist-newstyle 6 | stack.yaml.lock 7 | .DS_Store 8 | -------------------------------------------------------------------------------- /src/Graphics/ImageMagick/MagickWand/FFI/ImageDrawing.hsc: -------------------------------------------------------------------------------- 1 | module Graphics.ImageMagick.MagickWand.FFI.ImageDrawing 2 | where 3 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | flags: 2 | imagemagick: 3 | buildexamples: false 4 | packages: 5 | - '.' 6 | extra-deps: [] 7 | resolver: lts-14.1 8 | -------------------------------------------------------------------------------- /travis/install-imagemagick.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | VERSION=6.9.3-1 3 | set -ex 4 | wget http://www.imagemagick.org/download/ImageMagick-${VERSION}.tar.gz 5 | tar -xzvf ImageMagick-${VERSION}.tar.gz 6 | cd ImageMagick-${VERSION} && ./configure --prefix=/usr && make && sudo make install 7 | -------------------------------------------------------------------------------- /ChangeLog: -------------------------------------------------------------------------------- 1 | 0.0.0.5 2 | ------- 3 | * Add image orientation functions, thanks to (@alexd1971) 4 | 0.0.0.4 5 | ------- 6 | * Fix setImageAlphaChannel 7 | * Drop dependency on system-filepath package, so now it's possible 8 | to pass special image addresses like xc:// 9 | 10 | 0.0.3.4 11 | ------- 12 | * Drop support of the imagemagick < 6.8 13 | 14 | -------------------------------------------------------------------------------- /src/Graphics/ImageMagick/MagickCore/FFI/Quantize.hsc: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE ForeignFunctionInterface #-} 3 | 4 | module Graphics.ImageMagick.MagickCore.FFI.Quantize 5 | where 6 | 7 | #include 8 | 9 | import Foreign 10 | import Graphics.ImageMagick.MagickCore.Types.FFI.Quantize 11 | 12 | foreign import ccall unsafe "GetQuantizeInfo" 13 | c_getQuantizeInfo :: Ptr QuantizeInfo -> IO () 14 | 15 | -------------------------------------------------------------------------------- /src/Graphics/ImageMagick/MagickCore/Types/MBits.hs: -------------------------------------------------------------------------------- 1 | module Graphics.ImageMagick.MagickCore.Types.MBits 2 | where 3 | 4 | import Data.Bits 5 | import Graphics.ImageMagick.MagickCore.Types.FFI.ChannelType 6 | 7 | class MBits a where 8 | (^|^) :: a -> a -> a 9 | (^&^) :: a -> a -> a 10 | 11 | instance MBits ChannelType where 12 | a ^|^ b = ChannelType (unChannelType a .|. unChannelType b) 13 | a ^&^ b = ChannelType (unChannelType a .&. unChannelType b) 14 | -------------------------------------------------------------------------------- /src/Graphics/ImageMagick/MagickCore/Quantize.hs: -------------------------------------------------------------------------------- 1 | module Graphics.ImageMagick.MagickCore.Quantize where 2 | 3 | import Control.Monad.Trans.Resource 4 | import Control.Monad.IO.Class 5 | 6 | import Foreign 7 | 8 | import qualified Graphics.ImageMagick.MagickCore.FFI.Quantize as F 9 | import Graphics.ImageMagick.MagickCore.Types.FFI.Quantize (QuantizeInfo) 10 | 11 | getQuantizeInfo :: (MonadResource m) => m QuantizeInfo 12 | getQuantizeInfo = liftIO $ 13 | alloca $ \qiPtr -> do 14 | () <- F.c_getQuantizeInfo qiPtr 15 | peek qiPtr 16 | -------------------------------------------------------------------------------- /travis/cabal-apt-install: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | set -eu 3 | 4 | sudo apt-get -q update 5 | sudo apt-get -q -y install dctrl-tools 6 | 7 | # Try installing some of the build-deps with apt-get for speed. 8 | eval "$( 9 | printf '%s' "grep-aptavail -n -sPackage '(' -FFALSE -X FALSE ')'" 10 | 2>/dev/null cabal install "$@" --dry-run -v | \ 11 | sed -nre "s/^([^ ]+)-[0-9.]+ \(.*$/ -o '(' -FPackage -X libghc-\1-dev ')'/p" | \ 12 | xargs -d'\n' 13 | )" | sort -u | xargs -d'\n' sudo apt-get -q -y install -- libghc-quickcheck2-dev 14 | 15 | # Install whatever is still needed with cabal. 16 | cabal install "$@" 17 | -------------------------------------------------------------------------------- /src/Graphics/ImageMagick/MagickCore/FFI/Option.hsc: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE ForeignFunctionInterface #-} 3 | 4 | module Graphics.ImageMagick.MagickCore.FFI.Option 5 | where 6 | 7 | import Foreign.C.String 8 | import Foreign.C.Types 9 | 10 | import Graphics.ImageMagick.MagickCore.Types.FFI.ChannelType 11 | 12 | #include 13 | 14 | -- | ParseChannelOption() parses channel type string representation 15 | 16 | foreign import ccall "ParseChannelOption" parseChannelOption 17 | :: CString -> IO ChannelType 18 | 19 | -------------------------------------------------------------------------------- /src/Graphics/ImageMagick/MagickCore/Option.hs: -------------------------------------------------------------------------------- 1 | module Graphics.ImageMagick.MagickCore.Option 2 | ( parseChannelOption 3 | ) where 4 | 5 | import Control.Monad.IO.Class 6 | import Control.Monad.Trans.Resource 7 | import Data.ByteString (ByteString, useAsCString) 8 | 9 | import qualified Graphics.ImageMagick.MagickCore.FFI.Option as F 10 | import Graphics.ImageMagick.MagickCore.Types 11 | 12 | 13 | parseChannelOption :: (MonadResource m) => ByteString -> m ChannelType 14 | parseChannelOption s = liftIO $ useAsCString s F.parseChannelOption 15 | -------------------------------------------------------------------------------- /src/Graphics/ImageMagick/MagickCore/Types/FFI/PaintMethod.hsc: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE ForeignFunctionInterface #-} 3 | module Graphics.ImageMagick.MagickCore.Types.FFI.PaintMethod 4 | where 5 | 6 | import Foreign.C.Types 7 | #include 8 | 9 | newtype PaintMethod = PaintMethod { unPaintMethod :: CInt } 10 | 11 | 12 | #{enum PaintMethod, PaintMethod, 13 | undefinedMethod = UndefinedMethod, 14 | pointMethod = PointMethod, 15 | replaceMethod = ReplaceMethod, 16 | floodfillMethod = FloodfillMethod, 17 | fillToBorderMethod = FillToBorderMethod, 18 | resetMethod = ResetMethod 19 | } 20 | 21 | -------------------------------------------------------------------------------- /examples/basic.hs: -------------------------------------------------------------------------------- 1 | import Control.Monad 2 | import Filesystem.Path.CurrentOS 3 | import Graphics.ImageMagick.MagickWand 4 | import Graphics.ImageMagick.MagickWand.Internal 5 | import System.Environment 6 | 7 | 8 | main = do 9 | [img,out] <- getArgs 10 | withMagickWandGenesis $ do 11 | (_,w) <- magickWand 12 | stR <- readImage w $ decodeString img 13 | -- unless stR $ throwWandException 14 | magickIterate w $ \p -> do 15 | resizeImage p 106 80 lanczosFilter 1.0 16 | return () 17 | writeImages w (decodeString out) True 18 | -- unless stW $ throwWandException 19 | return () 20 | 21 | -------------------------------------------------------------------------------- /src/Graphics/ImageMagick/MagickCore/FFI/Mime.hsc: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE ForeignFunctionInterface #-} 3 | 4 | module Graphics.ImageMagick.MagickCore.FFI.Mime 5 | where 6 | 7 | import Foreign.C.String 8 | #include 9 | 10 | 11 | -- | MagickToMime() returns the officially registered (or de facto) MIME 12 | -- media-type corresponding to a magick string. If there is no registered 13 | -- media-type, then the string "image/x-magick" (all lower case) is returned. 14 | -- The returned string must be deallocated by the user. 15 | foreign import ccall "MagickToMime" magickToMime 16 | :: CString -> IO CString 17 | -------------------------------------------------------------------------------- /src/Graphics/ImageMagick/MagickCore.hs: -------------------------------------------------------------------------------- 1 | module Graphics.ImageMagick.MagickCore 2 | ( module Graphics.ImageMagick.MagickCore.Exception 3 | , module Graphics.ImageMagick.MagickCore.Gem 4 | , module Graphics.ImageMagick.MagickCore.Mime 5 | , module Graphics.ImageMagick.MagickCore.Option 6 | , module Graphics.ImageMagick.MagickCore.Types 7 | ) where 8 | 9 | import Graphics.ImageMagick.MagickCore.Exception 10 | import Graphics.ImageMagick.MagickCore.Gem 11 | import Graphics.ImageMagick.MagickCore.Mime 12 | import Graphics.ImageMagick.MagickCore.Option 13 | import Graphics.ImageMagick.MagickCore.Types 14 | -------------------------------------------------------------------------------- /README: -------------------------------------------------------------------------------- 1 | Imagemagick bindings 2 | ==================== 3 | 4 | [![Build Status](https://travis-ci.org/qnikst/imagemagick.svg)](https://travis-ci.org/qnikst/imagemagick) 5 | 6 | 7 | Authors: 8 | Alexander Vershilov 9 | Kirill Zaborsky 10 | 11 | Contributors: 12 | Tim Adams 13 | Chris Moline 14 | Aleksey Danilevsky 15 | 16 | 17 | How To Build 18 | ============ 19 | 20 | On Ubuntu 14.04 21 | 22 | # Install the build-essential package 23 | # Run travis/install-imagemagick.sh 24 | # Now you can build the ImageMagick haskell bindings: stack init && stack install 25 | -------------------------------------------------------------------------------- /src/Graphics/ImageMagick/MagickCore/FFI/Log.hsc: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE ForeignFunctionInterface #-} 3 | 4 | module Graphics.ImageMagick.MagickCore.FFI.Log 5 | where 6 | 7 | import Foreign.C.String 8 | import Foreign.C.Types 9 | import Graphics.ImageMagick.MagickCore.Types.FFI.Log 10 | #include 11 | 12 | 13 | -- | SetLogEventMask() accepts a list that determines which events to log. All 14 | -- other events are ignored. By default, no debug is enabled. This method 15 | -- returns the previous log event mask. 16 | foreign import ccall "SetLogEventMask" setLogEventMask 17 | :: CString -> IO LogEventType 18 | -------------------------------------------------------------------------------- /src/Graphics/ImageMagick/MagickCore/Types/FFI/MagickFunction.hsc: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE ForeignFunctionInterface #-} 3 | 4 | module Graphics.ImageMagick.MagickCore.Types.FFI.MagickFunction 5 | where 6 | 7 | import Foreign.C.Types 8 | #include 9 | 10 | newtype MagickFunction = MagickFunction { unMagickFunction :: CInt } 11 | deriving (Eq, Show) 12 | 13 | #{enum MagickFunction, MagickFunction, 14 | undefinedFunction = UndefinedFunction, 15 | polynomialFunction = PolynomialFunction, 16 | sinusoidFunction = SinusoidFunction, 17 | arcsinFunction = ArcsinFunction, 18 | arctanFunction = ArctanFunction 19 | } 20 | 21 | -------------------------------------------------------------------------------- /src/Graphics/ImageMagick/MagickCore/Types/FFI/Constitute.hsc: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE ForeignFunctionInterface #-} 3 | 4 | module Graphics.ImageMagick.MagickCore.Types.FFI.Constitute 5 | where 6 | 7 | import Foreign.C.Types 8 | #include 9 | 10 | newtype StorageType = StorageType { unStorageType :: CInt } 11 | deriving (Eq, Show) 12 | 13 | #{enum StorageType, StorageType 14 | , undefinedPixel = UndefinedPixel 15 | , charPixel = CharPixel 16 | , doublePixel = DoublePixel 17 | , floatPixel = FloatPixel 18 | , integerPixel = IntegerPixel 19 | , longPixel = LongPixel 20 | , quantumPixel = QuantumPixel 21 | , shortPixel = ShortPixel 22 | } 23 | -------------------------------------------------------------------------------- /src/Graphics/ImageMagick/MagickCore/Types/FFI/DitherMethod.hsc: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE ForeignFunctionInterface #-} 3 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 4 | module Graphics.ImageMagick.MagickCore.Types.FFI.DitherMethod 5 | where 6 | 7 | import Foreign.C.Types 8 | import Foreign.Storable 9 | #include 10 | 11 | newtype DitherMethod = DitherMethod { unDitherMethod :: CInt } 12 | deriving (Eq,Show,Storable) 13 | 14 | #{enum DitherMethod, DitherMethod 15 | , undefinedDitherFilter = UndefinedDitherMethod 16 | , noDitherMethod = NoDitherMethod 17 | , riemersmaDitherMethod = RiemersmaDitherMethod 18 | , floydSteinbergDitherMethod = FloydSteinbergDitherMethod 19 | } 20 | 21 | -------------------------------------------------------------------------------- /src/Graphics/ImageMagick/MagickCore/Types/FFI/Fx.hsc: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE ForeignFunctionInterface #-} 3 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 4 | 5 | module Graphics.ImageMagick.MagickCore.Types.FFI.Fx 6 | where 7 | 8 | import Foreign.C.Types 9 | #include 10 | 11 | newtype NoiseType = NoiseType { unNoiseType :: CInt } 12 | deriving (Eq, Show) 13 | 14 | #{enum NoiseType, NoiseType, 15 | undefinedNoise = UndefinedNoise, 16 | uniformNoise = UniformNoise, 17 | gaussianNoise = GaussianNoise, 18 | multiplicativeGaussianNoise = MultiplicativeGaussianNoise, 19 | impulseNoise = ImpulseNoise, 20 | laplacianNoise = LaplacianNoise, 21 | poissonNoise = PoissonNoise, 22 | randomNoise = RandomNoise 23 | } 24 | -------------------------------------------------------------------------------- /examples/floodfill.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | -- | Example taken from: http://members.shaw.ca/el.supremo/MagickWand/floodfill.htm 3 | -- 4 | -- Replace the white background area of 1st argument with transparent and don't forget 5 | -- that for this the channel must be "rgba" and the output image must be PNG 6 | -- or other format which supports transparency 7 | 8 | import Graphics.ImageMagick.MagickWand 9 | 10 | main = do 11 | withMagickWandGenesis $ do 12 | (_,w) <- magickWand 13 | readImage w "logo:" 14 | 15 | fc <- pixelWand 16 | bc <- pixelWand 17 | 18 | fc `setColor` "none" 19 | bc `setColor` "white" 20 | 21 | channel <- parseChannelOption "rgba" 22 | 23 | floodfillPaintImage w channel fc 20 bc 0 0 False 24 | 25 | w `writeImage` (Just "logo_floodfill.png") 26 | -------------------------------------------------------------------------------- /examples/extent.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | -- http://members.shaw.ca/el.supremo/MagickWand/extent.htm 4 | -- convert logo: -background blue -extent 1024x768-192-144 logo_extent.jpg 5 | -- Read an image and centre it on a larger 1024x768, extended canvas. 6 | -- The input image must be no larger than 1024x768 because this code does not 7 | -- check for errors 8 | 9 | import Graphics.ImageMagick.MagickWand 10 | 11 | main :: IO () 12 | main = do 13 | 14 | withMagickWandGenesis $ do 15 | (_,w) <- magickWand 16 | p <- pixelWand 17 | 18 | p `setColor` "blue" 19 | 20 | w `readImage` "logo:" 21 | 22 | width <- getImageWidth w 23 | height <- getImageHeight w 24 | 25 | w `setImageBackgroundColor` p 26 | 27 | extentImage w 1024 768 (-(1024-width) `div` 2) (-(768-height) `div` 2) 28 | 29 | w `writeImage` (Just "logo_extent.png") 30 | -------------------------------------------------------------------------------- /src/Graphics/ImageMagick/MagickCore/Exception.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveDataTypeable #-} 2 | module Graphics.ImageMagick.MagickCore.Exception 3 | ( MagickWandException(..) 4 | -- * support for ImageMagick Exceptions 5 | , ExceptionCarrier(..) 6 | , ExceptionSeverity 7 | , ExceptionType 8 | ) where 9 | 10 | import Control.Exception.Base 11 | import Data.Typeable 12 | import Graphics.ImageMagick.MagickCore.Types 13 | 14 | data MagickWandException = MagickWandException ExceptionSeverity ExceptionType String 15 | deriving (Typeable) 16 | 17 | 18 | instance Show (MagickWandException) where 19 | show (MagickWandException _ x s) = concat [show x, ": ", s] 20 | 21 | instance Exception MagickWandException 22 | 23 | -- * Exception Carrier can be different objects 24 | -- that are used in functions 25 | 26 | class ExceptionCarrier a where 27 | getException :: a -> IO MagickWandException 28 | 29 | -------------------------------------------------------------------------------- /src/Graphics/ImageMagick/MagickCore/Types/FFI/Image.hsc: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE ForeignFunctionInterface #-} 3 | module Graphics.ImageMagick.MagickCore.Types.FFI.Image 4 | where 5 | 6 | import Foreign.C.Types 7 | #include 8 | newtype ImageType = ImageType { unImageType :: CInt } 9 | deriving (Eq, Show) 10 | 11 | #{enum ImageType, ImageType 12 | , undefinedType = UndefinedType 13 | , bilevelType = BilevelType 14 | , grayscaleType = GrayscaleType 15 | , grayscaleMatteType = GrayscaleMatteType 16 | , paletteType = PaletteType 17 | , paletteMatteType = PaletteMatteType 18 | , trueColorType = TrueColorType 19 | , trueColorMatteType = TrueColorMatteType 20 | , colorSeparationType = ColorSeparationType 21 | , colorSeparationMatteType = ColorSeparationMatteType 22 | , optimizeType = OptimizeType 23 | , paletteBilevelMatteType = PaletteBilevelMatteType 24 | } 25 | -------------------------------------------------------------------------------- /src/Graphics/ImageMagick/MagickCore/Mime.hs: -------------------------------------------------------------------------------- 1 | module Graphics.ImageMagick.MagickCore.Mime 2 | ( toMime 3 | ) where 4 | 5 | import Control.Applicative 6 | import Control.Monad.IO.Class 7 | import Control.Monad.Trans.Resource 8 | import Data.ByteString (packCString, 9 | useAsCString) 10 | import Data.Text (Text) 11 | import Data.Text.Encoding (decodeUtf8, 12 | encodeUtf8) 13 | import Foreign 14 | import Prelude 15 | 16 | 17 | import qualified Graphics.ImageMagick.MagickCore.FFI.Mime as F 18 | 19 | toMime :: (MonadResource m) => Text -> m Text 20 | toMime format = liftIO $ do 21 | cstr <- useAsCString (encodeUtf8 format) F.magickToMime 22 | mime <- decodeUtf8 <$> packCString cstr 23 | free cstr 24 | return mime 25 | -------------------------------------------------------------------------------- /examples/cyclops.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | -- | Example taken from: http://members.shaw.ca/el.supremo/MagickWand/cyclops.htm 3 | -- http://www.imagemagick.org/discourse-server/viewtopic.php?f=18&t=12118 4 | {- 5 | magick convert cyclops.gif -bordercolor white -border 1x1 -matte \ 6 | -fill none -fuzz 20% -draw "matte 0,0 floodfill" \ 7 | -shave 1x1 cyclops_flood_3.png 8 | -} 9 | 10 | import Graphics.ImageMagick.MagickWand 11 | 12 | main :: IO () 13 | main = 14 | withMagickWandGenesis $ do 15 | (_,w) <- magickWand 16 | readImage w src 17 | 18 | fc <- pixelWand 19 | bc <- pixelWand 20 | 21 | fc `setColor` "none" 22 | bc `setColor` "white" 23 | 24 | borderImage w bc 1 1 25 | setImageAlphaChannel w setAlphaChannel 26 | channel <- parseChannelOption "rgba" 27 | floodfillPaintImage w channel fc 20 bc 0 0 False 28 | shaveImage w 1 1 29 | writeImages w out True 30 | 31 | where 32 | src = "cyclops_sm.gif" 33 | out = "cyclops_sm_flood.png" 34 | -------------------------------------------------------------------------------- /src/Graphics/ImageMagick/MagickCore/Types/FFI/Geometry.hsc: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE ForeignFunctionInterface #-} 3 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 4 | 5 | module Graphics.ImageMagick.MagickCore.Types.FFI.Geometry 6 | where 7 | 8 | import Foreign.C.Types 9 | #include 10 | 11 | newtype GravityType = GravityType { unGravityType :: CInt } 12 | deriving (Eq, Show) 13 | 14 | #{enum GravityType, GravityType 15 | , forgetGravity = ForgetGravity 16 | , northWestGravity = NorthWestGravity 17 | , northGravity = NorthGravity 18 | , northEastGravity = NorthEastGravity 19 | , westGravity = WestGravity 20 | , centerGravity = CenterGravity 21 | , eastGravity = EastGravity 22 | , southWestGravity = SouthWestGravity 23 | , southGravity = SouthGravity 24 | , southEastGravity = SouthEastGravity 25 | , staticGravity = StaticGravity 26 | } 27 | 28 | undefinedGravity :: GravityType 29 | undefinedGravity = forgetGravity 30 | 31 | -------------------------------------------------------------------------------- /src/Graphics/ImageMagick/MagickWand.hs: -------------------------------------------------------------------------------- 1 | module Graphics.ImageMagick.MagickWand 2 | ( module Graphics.ImageMagick.MagickCore 3 | , module Graphics.ImageMagick.MagickWand.DrawingWand 4 | , module Graphics.ImageMagick.MagickWand.MagickWand 5 | , module Graphics.ImageMagick.MagickWand.PixelIterator 6 | , module Graphics.ImageMagick.MagickWand.PixelPacket 7 | , module Graphics.ImageMagick.MagickWand.PixelWand 8 | , module Graphics.ImageMagick.MagickWand.Types 9 | , module Graphics.ImageMagick.MagickWand.WandImage 10 | ) where 11 | 12 | import Graphics.ImageMagick.MagickCore 13 | import Graphics.ImageMagick.MagickWand.DrawingWand 14 | import Graphics.ImageMagick.MagickWand.MagickWand 15 | import Graphics.ImageMagick.MagickWand.PixelIterator 16 | import Graphics.ImageMagick.MagickWand.PixelPacket 17 | import Graphics.ImageMagick.MagickWand.PixelWand 18 | import Graphics.ImageMagick.MagickWand.Types 19 | import Graphics.ImageMagick.MagickWand.WandImage 20 | -------------------------------------------------------------------------------- /src/Graphics/ImageMagick/MagickCore/Types/FFI/AlphaChannelType.hsc: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE ForeignFunctionInterface #-} 3 | module Graphics.ImageMagick.MagickCore.Types.FFI.AlphaChannelType 4 | where 5 | 6 | import Foreign.C.Types 7 | #include 8 | newtype AlphaChannelType = AlphaChannelType { unAlphaChannelType :: CInt } 9 | deriving (Eq, Show) 10 | 11 | #{enum AlphaChannelType, AlphaChannelType 12 | , undefinedAlphaChannel = UndefinedAlphaChannel 13 | , activateAlphaChannel = ActivateAlphaChannel 14 | , backgroundAlphaChannel = BackgroundAlphaChannel 15 | , copyAlphaChannel = CopyAlphaChannel 16 | , deactivateAlphaChannel = DeactivateAlphaChannel 17 | , extractAlphaChannel = ExtractAlphaChannel 18 | , opaqueAlphaChannel = OpaqueAlphaChannel 19 | , resetAlphaChannel = ResetAlphaChannel /* deprecated */ 20 | , setAlphaChannel = SetAlphaChannel 21 | , shapeAlphaChannel = ShapeAlphaChannel 22 | , transparentAlphaChannel = TransparentAlphaChannel 23 | , lattenAlphaChannel = FlattenAlphaChannel 24 | , removeAlphaChannel = RemoveAlphaChannel 25 | } 26 | -------------------------------------------------------------------------------- /src/Graphics/ImageMagick/MagickCore/Types/FFI/Types.hsc: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE ForeignFunctionInterface #-} 3 | {-# LANGUAGE RankNTypes #-} 4 | module Graphics.ImageMagick.MagickCore.Types.FFI.Types 5 | where 6 | 7 | import Data.Int 8 | import Data.Word 9 | #include 10 | 11 | type MagickRealType = #type MagickRealType 12 | type MagickStatusType = #type MagickStatusType 13 | type MagickOffsetType = #type MagickOffsetType 14 | type MagickSizeType = #type MagickSizeType 15 | type SignedQuantum = #type SignedQuantum 16 | type QuantumAny = #type QuantumAny 17 | type Quantum = #type Quantum 18 | type IndexPacket = #type IndexPacket 19 | 20 | magickEpsilon :: forall a. Fractional a => a 21 | magickEpsilon = 1e-10 -- #const MagickEpsilon 22 | maxColormapSize :: forall a. Num a => a 23 | maxColormapSize = #const MaxColormapSize 24 | maxMap :: forall a. Num a => a 25 | maxMap = #const MaxMap 26 | quantumFormat :: forall a. Num a => a 27 | quantumFormat = #const QuantumFormat 28 | quantumRange :: forall a. Num a => a 29 | quantumRange = #const QuantumRange 30 | -------------------------------------------------------------------------------- /src/Graphics/ImageMagick/MagickCore/Types/FFI/ChannelType.hsc: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP, ForeignFunctionInterface, NoMonomorphismRestriction #-} 2 | 3 | module Graphics.ImageMagick.MagickCore.Types.FFI.ChannelType 4 | where 5 | 6 | import Foreign.C.Types 7 | #include 8 | 9 | newtype ChannelType = ChannelType { unChannelType :: CInt } 10 | deriving (Eq, Show) 11 | 12 | #{enum ChannelType, ChannelType 13 | , undefinedCHannel = UndefinedChannel 14 | , redChannel = RedChannel 15 | , grayChannel = GrayChannel 16 | , cyanChannel = CyanChannel 17 | , greenChannel = GreenChannel 18 | , magentaChannel = MagentaChannel 19 | , blueChannel = BlueChannel 20 | , yellowChannel = YellowChannel 21 | , alphaChannel = AlphaChannel 22 | , opacityChannel = OpacityChannel 23 | , matteChannel = MatteChannel 24 | , blackChannel = BlackChannel 25 | , indexChannel = IndexChannel 26 | , compositeChannels = CompositeChannels 27 | , allChannels = AllChannels 28 | , trueAlphaChannel = TrueAlphaChannel 29 | , rgbChannels = RGBChannels 30 | , grayChannels = GrayChannels 31 | , syncChannels = SyncChannels 32 | , defaultChannels = DefaultChannels 33 | } 34 | -------------------------------------------------------------------------------- /examples/trans_paint.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | -- http://members.shaw.ca/el.supremo/MagickWand/trans_paint.htm 3 | -- Last updated 2008/11/25 08:48 4 | -- 5 | -- Use MagickTransparentPaintImage to change *all* white pixels 6 | -- to transparent in the logo: image 7 | 8 | import Graphics.ImageMagick.MagickWand 9 | 10 | main = do 11 | -- start image magick block 12 | withMagickWandGenesis $ do 13 | (_, w) <- magickWand 14 | readImage w "logo: " 15 | -- Set up the pixelwand containing the colour to be "targeted" 16 | -- by transparency 17 | t <- pixelWand 18 | t `setColor` "white" 19 | 20 | -- Change the transparency of all colours which match target (with 21 | -- fuzz applied). In this case they are made completely transparent (0) 22 | -- but you can set this to any value from 0 to 1. 23 | transparentPaintImage w t 0 fuzz False 24 | 25 | writeImages w "logo_white.png" True 26 | where 27 | -- A larger fuzz value allows more colours "near" white to be 28 | -- modified. A fuzz of zero only allows an exact match with the 29 | -- given colour 30 | fuzz = 0 31 | -------------------------------------------------------------------------------- /src/Graphics/ImageMagick/MagickCore/Types/FFI/Log.hsc: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE ForeignFunctionInterface #-} 3 | 4 | module Graphics.ImageMagick.MagickCore.Types.FFI.Log 5 | where 6 | 7 | import Foreign.C.Types 8 | #include 9 | 10 | 11 | newtype LogEventType = LogEventType { unLogEventType :: CInt } 12 | deriving (Eq, Show) 13 | 14 | #{enum LogEventType, LogEventType 15 | , undefinedEvents = UndefinedEvents 16 | , noEvents = NoEvents 17 | , traceEvent = TraceEvent 18 | , annotateEvent = AnnotateEvent 19 | , blobEvent = BlobEvent 20 | , cacheEvent = CacheEvent 21 | , coderEvent = CoderEvent 22 | , configureEvent = ConfigureEvent 23 | , deprecateEvent = DeprecateEvent 24 | , drawEvent = DrawEvent 25 | , exceptionEvent = ExceptionEvent 26 | , imageEvent = ImageEvent 27 | , localeEvent = LocaleEvent 28 | , moduleEvent = ModuleEvent 29 | , policyEvent = PolicyEvent 30 | , resourceEvent = ResourceEvent 31 | , transformEvent = TransformEvent 32 | , userEvent = UserEvent 33 | , wandEvent = WandEvent 34 | , x11Event = X11Event 35 | , accelerateEvent = AccelerateEvent 36 | , allEvents = AllEvents 37 | } 38 | -------------------------------------------------------------------------------- /src/Graphics/ImageMagick/MagickCore/Types/FFI/Layer.hsc: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE ForeignFunctionInterface #-} 3 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 4 | 5 | module Graphics.ImageMagick.MagickCore.Types.FFI.Layer 6 | where 7 | 8 | import Foreign.C.Types 9 | #include 10 | 11 | newtype ImageLayerMethod = ImageLayerMethod { unImageLayerMethod :: CInt } 12 | deriving (Eq, Show) 13 | 14 | #{enum ImageLayerMethod, ImageLayerMethod 15 | , undefinedLayer = UndefinedLayer 16 | , coalesceLayer = CoalesceLayer 17 | , compareAnyLayer = CompareAnyLayer 18 | , compareClearLayer = CompareClearLayer 19 | , compareOverlayLayer = CompareOverlayLayer 20 | , disposeLayer = DisposeLayer 21 | , optimizeLayer = OptimizeLayer 22 | , optimizeImageLayer = OptimizeImageLayer 23 | , optimizePlusLayer = OptimizePlusLayer 24 | , optimizeTransLayer = OptimizeTransLayer 25 | , removeDupsLayer = RemoveDupsLayer 26 | , removeZeroLayer = RemoveZeroLayer 27 | , compositeLayer = CompositeLayer 28 | , mergeLayer = MergeLayer 29 | , flattenLayer = FlattenLayer 30 | , mosaicLayer = MosaicLayer 31 | , trimBoundsLayer = TrimBoundsLayer 32 | } 33 | -------------------------------------------------------------------------------- /examples/grayscale.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | -- 3 | -- Create a simple grayscale gradient using Pixel Iterators 4 | -- 5 | import Control.Monad 6 | import Data.ByteString.Char8 as S 7 | import qualified Data.Vector.Storable as V 8 | import Graphics.ImageMagick.MagickWand 9 | import Text.Printf 10 | 11 | main :: IO () 12 | main = withMagickWandGenesis $ do 13 | pWand <- pixelWand 14 | pWand `setColor` "white" 15 | (_,mWand) <- magickWand 16 | -- Create a 100x100 image with a default of white 17 | newImage mWand 100 100 pWand 18 | -- Get a new pixel iterator 19 | 20 | (_,it) <- pixelIterator mWand 21 | rows <- pixelIterateList it 22 | forM_ rows $ \row -> do 23 | (flip imapM_) row $ \x v -> do 24 | let gray = x*255 `div` 100 25 | hex = S.pack $ '#':(printf "%02x%02x%02x" gray gray gray) 26 | v `setColor` hex 27 | -- Sync writes the pixels back to the m_wand 28 | pixelSyncIterator it 29 | mWand `writeImage` (Just "bits_demo.gif") 30 | 31 | imapM_ :: (Monad m, V.Storable a) => (Int -> a -> m ()) -> V.Vector a -> m () 32 | imapM_ f v = V.foldM'_ (\x a -> f x a >> return (x+1)) 1 v 33 | -------------------------------------------------------------------------------- /examples/round_mask.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | -- Last updated 2008/11/04 11:11 3 | 4 | -- http://www.imagemagick.org/discourse-server/viewtopic.php?f=10&t=10993 5 | -- convert -size 640x480 xc:none -fill white -draw 'roundRectangle 15,15 624,464 15,15' logo: -compose SrcIn -composite mask_result.png 6 | -- 7 | 8 | import Graphics.ImageMagick.MagickWand 9 | 10 | main :: IO () 11 | main = 12 | withMagickWandGenesis $ do 13 | (_,mWand) <- magickWand 14 | (_,lWand) <- magickWand 15 | pWand <- pixelWand 16 | (_,dWand) <- drawingWand 17 | -- Create the initial 640x480 transparent canvas 18 | pWand `setColor` "none" 19 | 20 | newImage mWand 640 480 pWand 21 | 22 | pWand `setColor` "white" 23 | 24 | dWand `setFillColor` pWand 25 | 26 | drawRoundRectangle dWand 15 15 624 464 15 15 27 | 28 | mWand `drawImage` dWand 29 | 30 | lWand `readImage` "logo:" 31 | 32 | -- Note that MagickSetImageCompose is usually only used for the MagickMontageImage 33 | -- function and isn't used or needed by MagickCompositeImage 34 | 35 | compositeImage mWand lWand srcInCompositeOp 0 0 36 | 37 | -- Write the new image 38 | writeImages mWand "mask_result.png" True 39 | -------------------------------------------------------------------------------- /src/Graphics/ImageMagick/MagickCore/FFI/Gem.hsc: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE ForeignFunctionInterface #-} 3 | 4 | module Graphics.ImageMagick.MagickCore.FFI.Gem 5 | where 6 | 7 | import Foreign 8 | import Foreign.C.Types 9 | import Graphics.ImageMagick.MagickCore.Types.FFI.Types 10 | #include 11 | 12 | foreign import ccall "ConvertHSBToRGB" convertHSBToRGB 13 | :: CDouble -> CDouble -> CDouble -> Ptr Quantum -> Ptr Quantum -> Ptr Quantum -> IO () 14 | foreign import ccall "ConvertHSLToRGB" convertHSLToRGB 15 | :: CDouble -> CDouble -> CDouble -> Ptr Quantum -> Ptr Quantum -> Ptr Quantum -> IO () 16 | foreign import ccall "ConvertHWBToRGB" convertHWBToRGB 17 | :: CDouble -> CDouble -> CDouble -> Ptr Quantum -> Ptr Quantum -> Ptr Quantum -> IO () 18 | foreign import ccall "ConvertRGBToHSB" convertRGBToHSB 19 | :: Quantum -> Quantum -> Quantum -> Ptr CDouble -> Ptr CDouble -> Ptr CDouble -> IO () 20 | foreign import ccall "ConvertRGBToHSL" convertRGBToHSL 21 | :: Quantum -> Quantum -> Quantum -> Ptr CDouble -> Ptr CDouble -> Ptr CDouble -> IO () 22 | foreign import ccall "ConvertRGBToHWB" convertRGBToHWB 23 | :: Quantum -> Quantum -> Quantum -> Ptr CDouble -> Ptr CDouble -> Ptr CDouble -> IO () 24 | 25 | -------------------------------------------------------------------------------- /src/Graphics/ImageMagick/MagickCore/Types/FFI/PixelPacket.hsc: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE ForeignFunctionInterface #-} 3 | {-# LANGUAGE NoMonomorphismRestriction #-} 4 | module Graphics.ImageMagick.MagickCore.Types.FFI.PixelPacket 5 | where 6 | 7 | import Foreign 8 | #include 9 | 10 | data PixelPacket 11 | 12 | instance Storable PixelPacket where 13 | sizeOf = const #size PixelPacket 14 | alignment _ = 1 15 | peek = error "not yet implemented" 16 | poke = error "not yet implemented" 17 | 18 | pixelPacketGetRed, pixelPacketGetGreen, pixelPacketGetBlue 19 | , pixelPacketGetOpacity 20 | :: Storable a => Ptr b -> IO a 21 | pixelPacketGetRed = #peek PixelPacket, red 22 | pixelPacketGetGreen = #peek PixelPacket, green 23 | pixelPacketGetBlue = #peek PixelPacket, blue 24 | pixelPacketGetOpacity = #peek PixelPacket, opacity 25 | 26 | pixelPacketSetRed, pixelPacketSetGreen, pixelPacketSetBlue 27 | , pixelPacketSetOpacity 28 | :: Storable a => Ptr b -> a -> IO () 29 | 30 | pixelPacketSetRed = #poke PixelPacket, red 31 | pixelPacketSetGreen = #poke PixelPacket, green 32 | pixelPacketSetBlue = #poke PixelPacket, blue 33 | pixelPacketSetOpacity = #poke PixelPacket, opacity 34 | 35 | -------------------------------------------------------------------------------- /examples/resize.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | -- | Example taken from: http://members.shaw.ca/el.supremo/MagickWand/resize.htm 3 | -- 4 | -- convert logo: -filter lanczos -resize 50% -quality 95 logo_resize.jpg 5 | -- Read an image, resize it by 50% and sharpen it, and then save as 6 | -- a high quality JPG 7 | -- Note that ImageMagick's default quality is 75. 8 | 9 | import Graphics.ImageMagick.MagickWand 10 | 11 | main :: IO () 12 | main = do 13 | withMagickWandGenesis $ do 14 | (_,w) <- magickWand 15 | 16 | -- Read the image 17 | readImage w "logo:" 18 | 19 | -- Cut them in half but make sure they don't underflow 20 | width <- fmap safeHalf (getImageWidth w) 21 | height <- fmap safeHalf (getImageHeight w) 22 | 23 | -- Resize the image using the Lanczos filter 24 | -- The blur factor is a 'Double', where > 1 is blurry, < 1 is sharp 25 | -- I haven't figured out how you would change the blur parameter of MagickResizeImage 26 | -- on the command line so I have set it to its default of one. 27 | resizeImage w width height lanczosFilter 1 28 | 29 | -- Set the compression quality to 95 (high quality = low compression) 30 | setImageCompressionQuality w 95 31 | 32 | -- Write the new image 33 | writeImages w "logo_resize.jpg" True 34 | 35 | where 36 | safeHalf = max 1 . (`div`2) 37 | 38 | -------------------------------------------------------------------------------- /src/Graphics/ImageMagick/MagickWand/Utils.hs: -------------------------------------------------------------------------------- 1 | module Graphics.ImageMagick.MagickWand.Utils 2 | ( fromMBool 3 | , toMBool 4 | , withException 5 | , withException_ 6 | , withExceptionIO 7 | ) 8 | where 9 | 10 | import Control.Exception.Base 11 | import Control.Monad 12 | import Control.Monad.IO.Class 13 | import Control.Monad.Trans.Resource 14 | import Graphics.ImageMagick.MagickWand.FFI.Types 15 | import Graphics.ImageMagick.MagickWand.Types 16 | 17 | fromMBool :: (MonadResource m) => IO MagickBooleanType -> m Bool 18 | fromMBool = liftM (==mTrue) . liftIO 19 | {-# INLINE fromMBool #-} 20 | 21 | withException :: (MonadResource m, ExceptionCarrier a) => a -> IO (MagickBooleanType, b) -> m b 22 | withException a f = liftIO $ do 23 | (r,b) <- f 24 | unless (r==mTrue) $ getException a >>= throw 25 | return b 26 | {-# INLINE withException #-} 27 | 28 | withException_ :: (MonadResource m, ExceptionCarrier a) => a -> IO MagickBooleanType -> m () 29 | withException_ a f = liftIO $ f >>= \x -> void $ unless (x==mTrue) (getException a >>= throw) 30 | 31 | -- TODO find some better way around IO + MonadResource 32 | withExceptionIO :: (ExceptionCarrier a) => a -> IO (MagickBooleanType, b) -> IO b 33 | withExceptionIO a f = liftIO $ do 34 | (r,b) <- f 35 | unless (r==mTrue) $ getException a >>= throw 36 | return b 37 | 38 | toMBool :: Bool -> MagickBooleanType 39 | toMBool True = mTrue 40 | toMBool False = mFalse 41 | {-# INLINE toMBool #-} 42 | -------------------------------------------------------------------------------- /examples/clipmask.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | -- | http://www.imagemagick.org/discourse-server/viewtopic.php?f=10&t=12285 3 | -- and more recently: http://www.imagemagick.org/discourse-server/viewtopic.php?f=1&t=16783 4 | -- http://www.imagemagick.org/Usage/channels/#masked_compose 5 | -- Replicate a masked composite: 6 | -- convert -size 100x100 tile:tile_water.jpg tile:tile_disks.jpg \ 7 | -- mask_bite.png -composite compose_masked.png 8 | -- 9 | 10 | import Graphics.ImageMagick.MagickWand 11 | import Graphics.ImageMagick.MagickCore 12 | 13 | main = do 14 | -- MagickWand *dest = NULL, *src = NULL, *mask = NULL; 15 | 16 | withMagickWandGenesis $ do 17 | 18 | -- Create the wands 19 | (_,dest) <- magickWand 20 | (_,mask) <- magickWand 21 | (_,src) <- magickWand 22 | 23 | setSize dest 100 100 24 | setSize src 100 100 25 | 26 | readImage dest "tile:tile_water.jpg" -- tile: ? 27 | readImage mask "mask_bite.png" -- ? 28 | 29 | -- When you create a mask, you use white for those parts that you want 30 | -- to show through and black for those which must not show through. 31 | -- But internally it's the opposite so the mask must be negated 32 | 33 | negateImage mask False 34 | setImageClipMask dest mask 35 | 36 | readImage src "tile:tile_disks.jpg" 37 | 38 | -- This does the src (overlay) over the dest (background) 39 | compositeImage dest src overCompositeOp 0 0 40 | 41 | writeImages dest "clip_out.jpg" True 42 | -------------------------------------------------------------------------------- /src/Graphics/ImageMagick/MagickCore/Types/FFI/FilterTypes.hsc: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE ForeignFunctionInterface #-} 3 | 4 | module Graphics.ImageMagick.MagickCore.Types.FFI.FilterTypes 5 | where 6 | 7 | import Foreign.C.Types 8 | #include 9 | 10 | newtype FilterTypes = FilterTypes { unPCREOption :: CInt } 11 | deriving (Eq,Show) 12 | 13 | #{enum FilterTypes, FilterTypes 14 | , undefinedFilter = UndefinedFilter 15 | , pointFilter = PointFilter 16 | , boxFilter = BoxFilter 17 | , triangleFilter = TriangleFilter 18 | , hermiteFilter = HermiteFilter 19 | , hanningFilter = HanningFilter 20 | , hammingFilter = HammingFilter 21 | , blackmanFilter = BlackmanFilter 22 | , gaussianFilter = GaussianFilter 23 | , qaudraticFilter = QuadraticFilter 24 | , cubicFilter = CubicFilter 25 | , catromFilter = CatromFilter 26 | , mirchellFilter = MitchellFilter 27 | , jincFilter = JincFilter 28 | , sinkFilter = SincFilter 29 | , sinkFastFilter = SincFastFilter 30 | , kaiserFilter = KaiserFilter 31 | , welshFilter = WelshFilter 32 | , parzenFilter = ParzenFilter 33 | , bohmanFilter = BohmanFilter 34 | , bartlettFilter = BartlettFilter 35 | , lagrangeFilter = LagrangeFilter 36 | , lanczosFilter = LanczosFilter 37 | , lanczosSharpFilter = LanczosSharpFilter 38 | , lanczos2Filter = Lanczos2Filter 39 | , lanczos2SharpFilter = Lanczos2SharpFilter 40 | , robidouxFilter = RobidouxFilter 41 | } 42 | 43 | -------------------------------------------------------------------------------- /src/Graphics/ImageMagick/MagickCore/Types/FFI/ColorspaceType.hsc: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE ForeignFunctionInterface #-} 3 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 4 | module Graphics.ImageMagick.MagickCore.Types.FFI.ColorspaceType 5 | where 6 | 7 | import Foreign.C.Types 8 | import Foreign.Storable 9 | #include 10 | 11 | newtype ColorspaceType = ColorspaceType { unColorspaceType :: CInt } 12 | deriving (Eq, Show, Storable) 13 | 14 | 15 | #{enum ColorspaceType, ColorspaceType, 16 | undefinedColorspace = UndefinedColorspace, 17 | rgbColorspace = RGBColorspace, 18 | grayColorspace = GRAYColorspace, 19 | transparentColorspace = TransparentColorspace, 20 | ohtaColorspace = OHTAColorspace, 21 | labColorspace = LabColorspace, 22 | xyzColorspace = XYZColorspace, 23 | ycbCrColorspace = YCbCrColorspace, 24 | yccColorspace = YCCColorspace, 25 | yiqColorspace = YIQColorspace, 26 | ypbprColorspace = YPbPrColorspace, 27 | yuvColorspace = YUVColorspace, 28 | cmykColorspace = CMYKColorspace, 29 | srgbColorspace = sRGBColorspace, 30 | hsbColorspace = HSBColorspace, 31 | hslColorspace = HSLColorspace, 32 | hwbColorspace = HWBColorspace, 33 | rec601LumaColorspace = Rec601LumaColorspace, 34 | rec601YCbCrColorspace = Rec601YCbCrColorspace, 35 | rec709LumaColorspace = Rec709LumaColorspace, 36 | rec709YCbCrColorspace = Rec709YCbCrColorspace, 37 | logColorspace = LogColorspace, 38 | cmyColorspace = CMYColorspace 39 | } 40 | -------------------------------------------------------------------------------- /src/Graphics/ImageMagick/MagickCore/Types/FFI/Compress.hsc: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE ForeignFunctionInterface #-} 3 | module Graphics.ImageMagick.MagickCore.Types.FFI.Compress 4 | where 5 | 6 | import Foreign.C.Types 7 | #include 8 | 9 | newtype CompressionType = CompressionType { unCompressionType :: CInt } 10 | deriving (Eq, Show) 11 | 12 | 13 | #{enum CompressionType, CompressionType 14 | , undefinedCompression = UndefinedCompression 15 | , noCompression = NoCompression 16 | , bzipCompression = BZipCompression 17 | , dxt1Compression = DXT1Compression 18 | , dxt3Compression = DXT3Compression 19 | , dxt5Compression = DXT5Compression 20 | , axCompression = FaxCompression 21 | , group4Compression = Group4Compression 22 | , jpegCompression = JPEGCompression 23 | , jpeg2000Compression = JPEG2000Compression /* ISO/IEC std 15444-1 */ 24 | , losslessJPEGCompression = LosslessJPEGCompression 25 | , lzwCompression = LZWCompression 26 | , rleCompression = RLECompression 27 | , zipCompression = ZipCompression 28 | , zipsCompression = ZipSCompression 29 | , pizCompression = PizCompression 30 | , pxr24Compression = Pxr24Compression 31 | , b44Compression = B44Compression 32 | , b44aCompression = B44ACompression 33 | , lzmaCompression = LZMACompression /* Lempel-Ziv-Markov chain algorithm */ 34 | , jbig1Compression = JBIG1Compression /* ISO/IEC std 11544 / ITU-T rec T.82 */ 35 | , jbig2Compression = JBIG2Compression /* ISO/IEC std 14492 / ITU-T rec T.88 */ 36 | } 37 | -------------------------------------------------------------------------------- /src/Graphics/ImageMagick/MagickCore/Types/FFI/CacheView.hsc: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE ForeignFunctionInterface #-} 3 | 4 | module Graphics.ImageMagick.MagickCore.Types.FFI.CacheView 5 | where 6 | 7 | import Foreign.C.Types 8 | #include 9 | 10 | newtype VirtualPixelMethod = VirtualPixelMethod { unVirtualPixelMethod :: CInt } 11 | deriving (Eq, Show) 12 | 13 | #{enum VirtualPixelMethod, VirtualPixelMethod, 14 | undefinedVirtualPixelMethod = UndefinedVirtualPixelMethod, 15 | backgroundVirtualPixelMethod = BackgroundVirtualPixelMethod, 16 | constantVirtualPixelMethod = ConstantVirtualPixelMethod, 17 | ditherVirtualPixelMethod = DitherVirtualPixelMethod, 18 | edgeVirtualPixelMethod = EdgeVirtualPixelMethod, 19 | mirrorVirtualPixelMethod = MirrorVirtualPixelMethod, 20 | randomVirtualPixelMethod = RandomVirtualPixelMethod, 21 | tileVirtualPixelMethod = TileVirtualPixelMethod, 22 | transparentVirtualPixelMethod = TransparentVirtualPixelMethod, 23 | maskVirtualPixelMethod = MaskVirtualPixelMethod, 24 | blackVirtualPixelMethod = BlackVirtualPixelMethod, 25 | grayVirtualPixelMethod = GrayVirtualPixelMethod, 26 | whiteVirtualPixelMethod = WhiteVirtualPixelMethod, 27 | horizontalTileVirtualPixelMethod = HorizontalTileVirtualPixelMethod, 28 | verticalTileVirtualPixelMethod = VerticalTileVirtualPixelMethod, 29 | horizontalTileEdgeVirtualPixelMethod = HorizontalTileEdgeVirtualPixelMethod, 30 | verticalTileEdgeVirtualPixelMethod = VerticalTileEdgeVirtualPixelMethod, 31 | checkerTileVirtualPixelMethod = CheckerTileVirtualPixelMethod 32 | } 33 | -------------------------------------------------------------------------------- /examples/tilt_shift.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | {- 3 | Implement Anthony's tilt-shift example from http://www.imagemagick.org/Usage/photos/#tilt_shift 4 | NOTE that I use the -function version - not the linear one 5 | convert beijing_md.jpg -sigmoidal-contrast 15x30% \ 6 | \( +clone -sparse-color Barycentric '0,0 black 0,%[fx:h-1] gray80' \ 7 | -function polynomial 4,-4,1 \) \ 8 | -compose Blur -set option:compose:args 15 -composite \ 9 | beijing_model.jpg 10 | -} 11 | 12 | import Graphics.ImageMagick.MagickWand 13 | import qualified Data.Vector.Storable as V 14 | 15 | main = do 16 | 17 | -- arguments for MagickSparseColorImage 18 | -- Note that the colours are stored as separate *normalized* RGB components 19 | let funclist = V.fromList [4,-4,1] 20 | withMagickWandGenesis $ do 21 | (_,mw) <- magickWand 22 | mw `readImage` "beijing_md.jpg" 23 | h <- getImageHeight mw 24 | let arglist = V.fromList [0,0, 25 | {-RGB black-} 0,0,0, 26 | 0, fromIntegral (h-1), 27 | {-RGB white-} 1, 1, 1] 28 | -- arglist[6] = ; --TODO 29 | sigmoidalContrastImage mw True 15 (quantumRange*30/100) 30 | (_, cw) <- cloneMagickWand mw 31 | sparseColorImage cw (blueChannel ^|^ greenChannel ^|^ redChannel) barycentricColorInterpolate arglist 32 | -- Do the polynomial function 33 | functionImage cw polynomialFunction funclist 34 | -- -set option:compose:args 15 35 | setImageArtifact cw "compose:args" "15" 36 | 37 | compositeImage mw cw blurCompositeOp 0 0 38 | mw `writeImage` (Just "beijing_model.jpg") 39 | -------------------------------------------------------------------------------- /examples/pixel_mod.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | -- | Example taken from: http://members.shaw.ca/el.supremo/MagickWand/pixel_mod.htm 3 | -- example/pixel_mod.c 4 | -- Change the colour of one pixel in the logo: image 5 | -- using either DrawPoint or a RegionIterator 6 | 7 | import Control.Applicative ((<$>)) 8 | import Data.Maybe 9 | import Data.Vector.Storable ((!)) 10 | import Graphics.ImageMagick.MagickWand 11 | 12 | main :: IO () 13 | main = withMagickWandGenesis $ do 14 | {- Create a wand -} 15 | (_,mw) <- magickWand 16 | {- Read the input image -} 17 | readImage mw "logo:" 18 | -- Change this define to `False` to use the region iterator instead of the Draw 19 | let useDraw = True 20 | if useDraw 21 | then do 22 | -- Get a one-pixel region at coordinate 200,100 23 | (_,iterator) <- pixelRegionIterator mw 200 100 1 1 24 | pixels <- fromJust <$> pixelGetNextIteratorRow iterator 25 | -- Modify the pixel 26 | pixels!0 `setColor` "red" 27 | -- then sync it back into the wand 28 | pixelSyncIterator iterator 29 | else do 30 | fill <- pixelWand 31 | (_,dw) <- drawingWand 32 | -- Set the fill to "red" or you can do the same thing with this: 33 | -- PixelSetColor(fill,"rgb(255,0,0)"); 34 | fill `setColor` "red" 35 | dw `setFillColor` fill 36 | -- Uses the current Fill as the colour of the point at 200,100 37 | drawPoint dw 200 100 38 | {- 39 | srand(time(0)); 40 | for(i=0;i<50;i++) { 41 | // plonk some random black pixels in the image 42 | j = rand()%DS_WIDTH; 43 | k = rand()%DS_HEIGHT; 44 | image[k*DS_WIDTH+j] = 0; 45 | } 46 | -} 47 | drawImage mw dw 48 | 49 | {- write it -} 50 | writeImage mw (Just "logo_pixel.gif") 51 | -------------------------------------------------------------------------------- /examples/basic2.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleContexts #-} 2 | import Control.Monad 3 | import Control.Monad.IO.Class 4 | import Control.Monad.Trans.Resource 5 | import qualified Data.Vector.Storable as V 6 | import Filesystem.Path.CurrentOS 7 | import Graphics.ImageMagick.MagickWand 8 | import System.Environment 9 | 10 | {- Example application for making contrast image 11 | - Example is taken from imagemagick documentation 12 | -} 13 | main = do 14 | [img, img'] <- getArgs 15 | withMagickWandGenesis $ do 16 | (_,w) <- magickWand 17 | tR <- readImage w $ decodeString img 18 | -- unless tR throw 19 | (_,w') <- cloneMagickWand w 20 | (_,it) <- pixelIterator w 21 | (_,it') <- pixelIterator w' 22 | h <- getImageHeight w 23 | forM_ [1..h] $ \y -> do 24 | (_,pixels) <- pixelGetNextIteratorRow it 25 | (_,pixels') <- pixelGetNextIteratorRow it' 26 | V.zipWithM_ (contrast it') pixels pixels' 27 | writeImages w' (decodeString img') True 28 | where 29 | contrast :: (MonadResource m) => PPixelIterator -> PPixelWand -> PPixelWand -> m Bool 30 | contrast i p p' = do 31 | c <- pixelGetMagickColor p 32 | setPixelRed c =<< fmap sigmoidalContrast (getPixelRed c) 33 | setPixelGreen c =<< fmap sigmoidalContrast (getPixelGreen c) 34 | setPixelBlue c =<< fmap sigmoidalContrast (getPixelBlue c) 35 | setPixelIndex c =<< fmap sigmoidalContrast (getPixelIndex c) 36 | pixelSetMagickColor p' c 37 | pixelSyncIterator i 38 | quantumScale :: MagickRealType 39 | quantumScale = 1 / quantumRange 40 | sigmoidalContrast :: MagickRealType -> MagickRealType 41 | sigmoidalContrast x = (quantumRange/(1+ exp (10.0*(0.5-quantumScale*x) ))-0.0066928509)*1.0092503 42 | 43 | 44 | -------------------------------------------------------------------------------- /examples/reflect.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | -- | Example taken from: http://members.shaw.ca/el.supremo/MagickWand/reflect.htm 3 | {- convert logo: '(' logo: -resize 100%x50%! -flip -size 640x240 \ 4 | gradient:white-black +matte -compose copyopacity -composite ')' \ 5 | -append logo_reflect.png -} 6 | import Graphics.ImageMagick.MagickWand 7 | import Graphics.ImageMagick.MagickWand.FFI.Types 8 | 9 | main :: IO () 10 | main = withMagickWandGenesis $ do 11 | (_,mw) <- magickWand 12 | readImage mw "logo:" 13 | -- We know that logo: is 640x480 but in the general case 14 | -- we need to get the dimensions of the image 15 | w <- getImageWidth mw 16 | h <- getImageHeight mw 17 | 18 | -- +matte is the same as -alpha off 19 | -- This does it the "new" way but if your IM doesn't have this 20 | -- then MagickSetImageMatte(mw,MagickFalse); can be used 21 | -- TODO: fails, should we ignore it? 22 | mw `setImageAlphaChannel` deactivateAlphaChannel 23 | -- clone the input image 24 | (_,mwr) <- magickWand--cloneMagickWand mw 25 | readImage mwr "logo:" 26 | -- Resize it 27 | resizeImage mwr w (h `div` 2) lanczosFilter 1 28 | -- Flip the image over to form the reflection 29 | flipImage mwr 30 | -- Create the gradient image which will be used as the alpha 31 | -- channel in the reflection image 32 | (_,mwg) <- magickWand 33 | setSize mwg w (h `div` 2) 34 | readImage mwg "gradient:white-black" 35 | 36 | -- Copy the gradient in to the alpha channel of the reflection image 37 | compositeImage mwr mwg copyOpacityCompositeOp 0 0 38 | 39 | -- Add the reflection image to the wand which holds the original image 40 | addImage mw mwr 41 | 42 | -- Append the reflection to the bottom (MagickTrue) of the original image 43 | (_,mwg') <- appendImages mw True 44 | 45 | -- and save the result 46 | writeImage mwg' (Just "logo_reflect.png") 47 | -------------------------------------------------------------------------------- /src/Graphics/ImageMagick/MagickWand/PixelPacket.hs: -------------------------------------------------------------------------------- 1 | module Graphics.ImageMagick.MagickWand.PixelPacket 2 | ( getPixelRed 3 | , setPixelRed 4 | , getPixelBlue 5 | , setPixelBlue 6 | , getPixelGreen 7 | , setPixelGreen 8 | , getPixelIndex 9 | , setPixelIndex 10 | ) where 11 | 12 | import Control.Monad.IO.Class 13 | import Foreign 14 | import qualified Graphics.ImageMagick.MagickWand.FFI.Types as F 15 | import Graphics.ImageMagick.MagickWand.Types 16 | 17 | 18 | getPixel' :: (MonadIO m) => (Ptr F.MagickPixelPacket -> IO MagickRealType) -> PMagickPixelPacket -> m MagickRealType 19 | getPixel' f wp = liftIO $ withForeignPtr wp f 20 | {-# INLINE getPixel' #-} 21 | 22 | getPixelRed :: (MonadIO m) => PMagickPixelPacket -> m MagickRealType 23 | getPixelRed = getPixel' F.getPixelRed 24 | 25 | getPixelBlue :: (MonadIO m) => PMagickPixelPacket -> m MagickRealType 26 | getPixelBlue = getPixel' F.getPixelBlue 27 | 28 | getPixelGreen :: (MonadIO m) => PMagickPixelPacket -> m MagickRealType 29 | getPixelGreen = getPixel' F.getPixelGreen 30 | 31 | getPixelIndex :: (MonadIO m) => PMagickPixelPacket -> m MagickRealType 32 | getPixelIndex = getPixel' F.getPixelIndex 33 | 34 | setPixel' :: (MonadIO m) => (Ptr F.MagickPixelPacket -> MagickRealType -> IO ()) -> PMagickPixelPacket -> MagickRealType -> m () 35 | setPixel' f wp c = liftIO $ withForeignPtr wp (`f` c) 36 | {-# INLINE setPixel' #-} 37 | 38 | setPixelRed :: (MonadIO m) => PMagickPixelPacket -> MagickRealType -> m () 39 | setPixelRed = setPixel' F.setPixelRed 40 | 41 | setPixelIndex :: (MonadIO m) => PMagickPixelPacket -> MagickRealType -> m () 42 | setPixelIndex = setPixel' F.setPixelIndex 43 | 44 | setPixelGreen :: (MonadIO m) => PMagickPixelPacket -> MagickRealType -> m () 45 | setPixelGreen = setPixel' F.setPixelGreen 46 | 47 | setPixelBlue :: (MonadIO m) => PMagickPixelPacket -> MagickRealType -> m () 48 | setPixelBlue = setPixel' F.setPixelBlue 49 | -------------------------------------------------------------------------------- /src/Graphics/ImageMagick/MagickCore/Types/FFI/Distort.hsc: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE ForeignFunctionInterface #-} 3 | module Graphics.ImageMagick.MagickCore.Types.FFI.Distort 4 | where 5 | 6 | import Foreign.C.Types 7 | #include 8 | 9 | newtype DistortImageMethod = DistortImageMethod { unDistortImageMethod :: CInt } 10 | 11 | #{enum DistortImageMethod, DistortImageMethod 12 | , undefinedDistortion = UndefinedDistortion 13 | , affineDistortion = AffineDistortion 14 | , affineProjectionDistortion = AffineProjectionDistortion 15 | , scaleRotateTranslateDistortion = ScaleRotateTranslateDistortion 16 | , perspectiveDistortion = PerspectiveDistortion 17 | , perspectiveProjectionDistortion = PerspectiveProjectionDistortion 18 | , bilinearForwardDistortion = BilinearForwardDistortion 19 | , bilinearReverseDistortion = BilinearReverseDistortion 20 | , polynomialDistortion = PolynomialDistortion 21 | , arcDistortion = ArcDistortion 22 | , polarDistortion = PolarDistortion 23 | , dePolarDistortion = DePolarDistortion 24 | , cylinder2PlaneDistortion = Cylinder2PlaneDistortion 25 | , plane2CylinderDistortion = Plane2CylinderDistortion 26 | , barrelDistortion = BarrelDistortion 27 | , barrelInverseDistortion = BarrelInverseDistortion 28 | , shepardsDistortion = ShepardsDistortion 29 | , resizeDistortion = ResizeDistortion 30 | , sentinelDistortion = SentinelDistortion 31 | } 32 | 33 | bilinearDistortion :: DistortImageMethod 34 | bilinearDistortion = bilinearForwardDistortion 35 | 36 | newtype SparseColorMethod = SparseColorMethod { unSparseColorMethod :: CInt } 37 | 38 | #{enum SparseColorMethod, SparseColorMethod, 39 | undefinedColorInterpolate = UndefinedDistortion, 40 | barycentricColorInterpolate = AffineDistortion, 41 | bilinearColorInterpolate = BilinearReverseDistortion, 42 | polynomialColorInterpolate = PolynomialDistortion, 43 | shepardsColorInterpolate = ShepardsDistortion, 44 | voronoiColorInterpolate = SentinelDistortion, 45 | inverseColorInterpolate =InverseColorInterpolate 46 | } 47 | -------------------------------------------------------------------------------- /examples/bunny.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | -- | Example taken from: http://members.shaw.ca/el.supremo/MagickWand/bunny.htm 3 | -- This implements the command: 4 | -- convert bunny_grass.gif ( bunny_anim.gif -repage 0x0+5+15! ) \ 5 | -- -coalesce -delete 0 -deconstruct -loop 0 bunny_bgnd.gif 6 | -- from Anthony's examples at: http://www.imagemagick.org/Usage/anim_basics/#cleared 7 | 8 | import Control.Monad (forM_) 9 | import Control.Monad.Trans.Resource (release) 10 | import Graphics.ImageMagick.MagickWand 11 | 12 | main :: IO () 13 | main = withMagickWandGenesis $ do 14 | {- Create a wand -} 15 | (mw0k,mw0) <- magickWand 16 | 17 | {- Read the first input image -} 18 | readImage mw0 "bunny_grass.gif" 19 | 20 | --( bunny_anim.gif -repage 0x0+5+15\! ) 21 | -- We need a separate wand to do this bit in parentheses 22 | localGenesis $ do 23 | (_,aw) <- magickWand 24 | readImage aw "bunny_anim.gif" 25 | resetImagePage aw (Just "0x0+5+15!") 26 | 27 | -- Now we have to add the images in the aw wand on to the end 28 | -- of the mw wand. 29 | addImage mw0 aw 30 | -- thee aw wand is destoyed on exiting `localGenesis` so that it can be used 31 | -- for the next operation 32 | 33 | 34 | -- -coalesce 35 | (aw0k, aw0) <- coalesceImages mw0 36 | 37 | -- do "-delete 0" by copying the images from the "aw" wand to 38 | -- the "mw" wand but omit the first one 39 | -- free up the mw wand and recreate it for this step 40 | release mw0k 41 | (_,mw1) <- magickWand 42 | n <- getNumberImages aw0 43 | forM_ [1..(n-1)] $ \i -> localGenesis $ do 44 | aw0 `setIteratorIndex` i 45 | (_,tw) <- getImage aw0 46 | addImage mw1 tw 47 | 48 | resetIterator mw1 49 | 50 | -- free up aw for the next step 51 | release aw0k 52 | 53 | -- -deconstruct 54 | -- Anthony says that MagickDeconstructImages is equivalent 55 | -- to MagickCompareImagesLayers so we'll use that 56 | 57 | (_,aw1) <- compareImageLayers mw1 compareAnyLayer 58 | 59 | -- -loop 0 60 | setOption aw1 "loop" "0" 61 | 62 | {- write the images into one file -} 63 | writeImages aw1 "bunny_bgnd.gif" True 64 | -------------------------------------------------------------------------------- /src/Graphics/ImageMagick/MagickCore/Types/FFI/Quantize.hsc: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE ForeignFunctionInterface #-} 3 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 4 | 5 | module Graphics.ImageMagick.MagickCore.Types.FFI.Quantize where 6 | 7 | import Graphics.ImageMagick.MagickCore.Types (ColorspaceType, DitherMethod) 8 | import Graphics.ImageMagick.MagickWand.FFI.Types (MagickBooleanType) 9 | import Foreign.C.Types (CSize) 10 | import Foreign.Storable 11 | 12 | #include 13 | 14 | data QuantizeInfo = QuantizeInfo { numberOfColors :: CSize 15 | , treeDepth :: CSize 16 | , shouldDither :: MagickBooleanType 17 | , colorspace :: ColorspaceType 18 | , measureError :: MagickBooleanType 19 | , signature :: CSize 20 | , ditherMethod :: DitherMethod 21 | } 22 | deriving (Eq, Show) 23 | 24 | instance Storable QuantizeInfo where 25 | sizeOf _ = (#size QuantizeInfo) 26 | alignment _ = alignment (undefined :: CSize) 27 | peek ptr = do 28 | numberOfColors' <- (#peek QuantizeInfo, number_colors) ptr 29 | treeDepth' <- (#peek QuantizeInfo, tree_depth) ptr 30 | shouldDither' <- (#peek QuantizeInfo, dither) ptr 31 | colorspace' <- (#peek QuantizeInfo, colorspace) ptr 32 | measureError' <- (#peek QuantizeInfo, measure_error) ptr 33 | signature' <- (#peek QuantizeInfo, signature) ptr 34 | ditherMethod' <- (#peek QuantizeInfo, dither_method) ptr 35 | return QuantizeInfo { numberOfColors = numberOfColors' 36 | , treeDepth = treeDepth' 37 | , shouldDither = shouldDither' 38 | , colorspace = colorspace' 39 | , measureError = measureError' 40 | , signature = signature' 41 | , ditherMethod = ditherMethod' 42 | } 43 | poke = error "not yet implemented" 44 | 45 | -------------------------------------------------------------------------------- /src/Graphics/ImageMagick/MagickCore/Gem.hs: -------------------------------------------------------------------------------- 1 | module Graphics.ImageMagick.MagickCore.Gem 2 | ( convertHSBToRGB 3 | , convertHSLToRGB 4 | , convertHWBToRGB 5 | , convertRGBToHSB 6 | , convertRGBToHSL 7 | , convertRGBToHWB 8 | ) where 9 | 10 | import Foreign.Ptr (Ptr) 11 | import Foreign.Storable (Storable, peek) 12 | import Foreign.Marshal.Alloc (alloca) 13 | import Control.Monad.IO.Class 14 | import Control.Monad.Trans.Resource 15 | import Graphics.ImageMagick.MagickCore.Types 16 | import qualified Graphics.ImageMagick.MagickCore.FFI.Gem as F 17 | 18 | 19 | with3 :: (Storable a, Storable b, Storable c) => 20 | (Ptr a -> Ptr b -> Ptr c -> IO ()) 21 | -> IO (a, b, c) 22 | with3 f = alloca (\x -> alloca (\y -> alloca (\z -> do 23 | f x y z 24 | x' <- peek x 25 | y' <- peek y 26 | z' <- peek z 27 | return (x',y',z') 28 | ))) 29 | 30 | map3 :: (a -> b) -> (a, a, a) -> (b, b, b) 31 | map3 f (a,b,c) = (f a, f b, f c) 32 | 33 | 34 | convertHSBToRGB :: MonadResource m => Double -> Double -> Double -> m (Quantum, Quantum, Quantum) 35 | convertHSBToRGB d1 d2 d3 = liftIO $ with3 (F.convertHSBToRGB (realToFrac d1) (realToFrac d2) (realToFrac d3)) 36 | 37 | convertHSLToRGB :: MonadResource m => Double -> Double -> Double -> m (Quantum, Quantum, Quantum) 38 | convertHSLToRGB d1 d2 d3 = liftIO $ with3 (F.convertHSLToRGB (realToFrac d1) (realToFrac d2) (realToFrac d3)) 39 | 40 | convertHWBToRGB :: MonadResource m => Double -> Double -> Double -> m (Quantum, Quantum, Quantum) 41 | convertHWBToRGB d1 d2 d3 = liftIO $ with3 (F.convertHWBToRGB (realToFrac d1) (realToFrac d2) (realToFrac d3)) 42 | 43 | convertRGBToHSB :: MonadResource m => Quantum -> Quantum -> Quantum -> m (Double, Double, Double) 44 | convertRGBToHSB q1 q2 q3 = (liftIO $ with3 (F.convertRGBToHSB q1 q2 q3)) >>= return . (map3 realToFrac) 45 | 46 | convertRGBToHSL :: MonadResource m => Quantum -> Quantum -> Quantum -> m (Double, Double, Double) 47 | convertRGBToHSL q1 q2 q3 = liftIO $ with3 (F.convertRGBToHSL q1 q2 q3) >>= return . (map3 realToFrac) 48 | 49 | convertRGBToHWB :: MonadResource m => Quantum -> Quantum -> Quantum -> m (Double, Double, Double) 50 | convertRGBToHWB q1 q2 q3 = liftIO $ with3 (F.convertRGBToHSB q1 q2 q3) >>= return . (map3 realToFrac) 51 | 52 | -------------------------------------------------------------------------------- /src/Graphics/ImageMagick/MagickCore/Types/FFI/Statistic.hsc: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE ForeignFunctionInterface #-} 3 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 4 | 5 | module Graphics.ImageMagick.MagickCore.Types.FFI.Statistic 6 | where 7 | 8 | import Foreign.C.Types 9 | #include 10 | 11 | newtype MagickEvaluateOperator = MagickEvaluateOperator { unMagickEvaluateOperator :: CInt } 12 | deriving (Eq, Show) 13 | 14 | #{enum MagickEvaluateOperator, MagickEvaluateOperator 15 | , undefinedEvaluateOperator = UndefinedEvaluateOperator 16 | , addEvaluateOperator = AddEvaluateOperator 17 | , andEvaluateOperator = AndEvaluateOperator 18 | , divideEvaluateOperator = DivideEvaluateOperator 19 | , leftShiftEvaluateOperator = LeftShiftEvaluateOperator 20 | , maxEvaluateOperator = MaxEvaluateOperator 21 | , minEvaluateOperator = MinEvaluateOperator 22 | , multiplyEvaluateOperator = MultiplyEvaluateOperator 23 | , orEvaluateOperator = OrEvaluateOperator 24 | , rightShiftEvaluateOperator = RightShiftEvaluateOperator 25 | , setEvaluateOperator = SetEvaluateOperator 26 | , subtractEvaluateOperator = SubtractEvaluateOperator 27 | , xorEvaluateOperator = XorEvaluateOperator 28 | , powEvaluateOperator = PowEvaluateOperator 29 | , logEvaluateOperator = LogEvaluateOperator 30 | , thresholdEvaluateOperator = ThresholdEvaluateOperator 31 | , thresholdBlackEvaluateOperator = ThresholdBlackEvaluateOperator 32 | , thresholdWhiteEvaluateOperator = ThresholdWhiteEvaluateOperator 33 | , gaussianNoiseEvaluateOperator = GaussianNoiseEvaluateOperator 34 | , impulseNoiseEvaluateOperator = ImpulseNoiseEvaluateOperator 35 | , laplacianNoiseEvaluateOperator = LaplacianNoiseEvaluateOperator 36 | , multiplicativeNoiseEvaluateOperator = MultiplicativeNoiseEvaluateOperator 37 | , poissonNoiseEvaluateOperator = PoissonNoiseEvaluateOperator 38 | , uniformNoiseEvaluateOperator = UniformNoiseEvaluateOperator 39 | , cosineEvaluateOperator = CosineEvaluateOperator 40 | , sineEvaluateOperator = SineEvaluateOperator 41 | , addModulusEvaluateOperator = AddModulusEvaluateOperator 42 | , meanEvaluateOperator = MeanEvaluateOperator 43 | , absEvaluateOperator = AbsEvaluateOperator 44 | , exponentialEvaluateOperator = ExponentialEvaluateOperator 45 | , medianEvaluateOperator = MedianEvaluateOperator 46 | , sumEvaluateOperator = SumEvaluateOperator 47 | } 48 | 49 | -------------------------------------------------------------------------------- /examples/make_tile.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleContexts #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | {-# LANGUAGE FlexibleContexts #-} 4 | -- http://members.shaw.ca/el.supremo/MagickWand/make_tile.htm 5 | -- The program makes two tiles, one using the plasma: pseudo file and one using noise 6 | -- See: http://www.imagemagick.org/Usage/canvas/#plasma_seeded 7 | -- and: http://www.imagemagick.org/Usage/canvas/#random 8 | 9 | -- convert -size 100x100 plasma:red-yellow ( +clone -flop ) +append \ 10 | -- ( +clone -flip ) -append -resize 50% tile_plasma.png 11 | -- and 12 | -- convert -size 100x100 xc: +noise Random -virtual-pixel tile \ 13 | -- -blur 0x10 -normalize ( +clone -flop ) +append \ 14 | -- ( +clone -flip ) -append -resize 50% tile_random.png 15 | 16 | {- 17 | Basically this flops and flips the image and joins the four results together 18 | and then resizes the result by 50% so that it's the same size as the original. 19 | E.g. if the original image is "/", it creates the flop image "\" and then appends 20 | them side by side to give "/\". Then it takes this image and flips it which produces 21 | "\/" and then appends these one on top of the other to produce 22 | 23 | /\ 24 | \/ 25 | 26 | and finally, since this image is now twice the size of the original, it is resized to 50%. 27 | -} 28 | 29 | import Graphics.ImageMagick.MagickWand 30 | import Control.Monad.Trans.Resource 31 | import Control.Monad (void) 32 | 33 | -- make-tile creates a tileable image from an input image. 34 | -- ( +clone -flop ) +append ( +clone -flip ) -append -resize 50% 35 | makeTile mw outfile = localGenesis $ do 36 | (destroyMwc, mwc) <- cloneMagickWand mw 37 | flopImage mwc 38 | mw `addImage` mwc 39 | release destroyMwc 40 | 41 | mwc' <- mw `appendImages` False 42 | (destroyMwf, mwf) <- cloneMagickWand mwc 43 | flipImage mwf 44 | mwc `addImage` mwf 45 | release destroyMwf 46 | 47 | (_,mwf') <- mwc `appendImages` True 48 | 49 | w <- getImageWidth mwf' 50 | h <- getImageHeight mwf' 51 | -- 1 = Don't blur or sharpen image 52 | resizeImage mwf (w `div` 2) (h `div` 2) lanczosFilter 1 53 | mwf `writeImage` outfile 54 | 55 | main = do 56 | withMagickWandGenesis $ do 57 | (destroyMw, mw) <- magickWand 58 | setSize mw 100 100 59 | readImage mw "plasma:red-yellow" 60 | makeTile mw (Just "tile_plasma.png") 61 | release destroyMw 62 | 63 | (destroyMw', mw') <- magickWand 64 | setSize mw' 100 100 65 | mw `readImage` "xc:" 66 | mw `addNoiseImage` randomNoise 67 | void $ mw `setVirtualPixelMethod` tileVirtualPixelMethod 68 | blurImage mw 0 10 69 | normalizeImage mw 70 | makeTile mw (Just "tile_random.png") 71 | 72 | -------------------------------------------------------------------------------- /src/Graphics/ImageMagick/MagickWand/Types.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS -fno-warn-orphans #-} 2 | {-# LANGUAGE DeriveDataTypeable #-} 3 | {-# LANGUAGE FlexibleInstances #-} 4 | {-# LANGUAGE RankNTypes #-} 5 | {-# LANGUAGE ScopedTypeVariables #-} 6 | {-# LANGUAGE TypeFamilies #-} 7 | module Graphics.ImageMagick.MagickWand.Types 8 | ( PPixelIterator 9 | , PPixelWand 10 | , PPixelPacket 11 | , PMagickPixelPacket 12 | , PDrawingWand 13 | , PMagickWand 14 | , MagickWandException(..) 15 | -- * support for ImageMagick Exceptions 16 | , ExceptionCarrier(..) 17 | , module Graphics.ImageMagick.MagickCore.Types 18 | , Pixel(..) 19 | ) where 20 | 21 | import qualified Data.Vector.Storable as V 22 | import Foreign 23 | import Foreign.C.String 24 | import Graphics.ImageMagick.MagickCore.Exception 25 | import Graphics.ImageMagick.MagickCore.Types 26 | import Graphics.ImageMagick.MagickWand.FFI.DrawingWand as F 27 | import Graphics.ImageMagick.MagickWand.FFI.MagickWand as F 28 | import Graphics.ImageMagick.MagickWand.FFI.PixelIterator as F 29 | import Graphics.ImageMagick.MagickWand.FFI.PixelWand as F 30 | import Graphics.ImageMagick.MagickWand.FFI.Types 31 | 32 | type PPixelIterator = Ptr PixelIterator 33 | type PPixelWand = Ptr PixelWand 34 | type PMagickWand = Ptr MagickWand 35 | type PDrawingWand = Ptr DrawingWand 36 | type PMagickPixelPacket = ForeignPtr MagickPixelPacket 37 | type PPixelPacket = ForeignPtr PixelPacket 38 | 39 | constructException :: forall t. 40 | (t -> Ptr ExceptionType -> IO CString) 41 | -> t -> IO MagickWandException 42 | constructException f w = alloca $ \x -> do 43 | s <- peekCString =<< f w x 44 | x' <- peek x 45 | return $ MagickWandException (toSeverity x') x' s 46 | {-# INLINE constructException #-} 47 | 48 | instance ExceptionCarrier (Ptr MagickWand) where 49 | getException = constructException F.magickGetException 50 | 51 | instance ExceptionCarrier (Ptr PixelIterator) where 52 | getException = constructException F.pixelGetIteratorException 53 | 54 | instance ExceptionCarrier (Ptr PixelWand) where 55 | getException = constructException F.pixelGetException 56 | 57 | instance ExceptionCarrier (Ptr DrawingWand) where 58 | getException = constructException F.drawGetException 59 | 60 | class (Storable a) => Pixel a where 61 | pixelStorageType :: [a] -> StorageType 62 | withPixels :: [a] -> (Ptr a -> IO b) -> IO b 63 | withPixels xs f = V.unsafeWith (V.fromList xs) f 64 | 65 | instance Pixel Word8 where 66 | pixelStorageType = const charPixel 67 | 68 | instance Pixel Word16 where 69 | pixelStorageType = const shortPixel 70 | 71 | instance Pixel Word32 where 72 | pixelStorageType = const longPixel 73 | 74 | instance Pixel Word64 where 75 | pixelStorageType = const longPixel 76 | 77 | instance Pixel Float where 78 | pixelStorageType = const floatPixel 79 | 80 | instance Pixel Double where 81 | pixelStorageType = const doublePixel 82 | -------------------------------------------------------------------------------- /src/Graphics/ImageMagick/MagickCore/Types.hs: -------------------------------------------------------------------------------- 1 | module Graphics.ImageMagick.MagickCore.Types 2 | ( module Graphics.ImageMagick.MagickCore.Types.FFI.AlphaChannelType 3 | , module Graphics.ImageMagick.MagickCore.Types.FFI.CacheView 4 | , module Graphics.ImageMagick.MagickCore.Types.FFI.ChannelType 5 | , module Graphics.ImageMagick.MagickCore.Types.FFI.ColorspaceType 6 | , module Graphics.ImageMagick.MagickCore.Types.FFI.Composite 7 | , module Graphics.ImageMagick.MagickCore.Types.FFI.Compress 8 | , module Graphics.ImageMagick.MagickCore.Types.FFI.Constitute 9 | , module Graphics.ImageMagick.MagickCore.Types.FFI.Distort 10 | , module Graphics.ImageMagick.MagickCore.Types.FFI.DitherMethod 11 | , module Graphics.ImageMagick.MagickCore.Types.FFI.Exception 12 | , module Graphics.ImageMagick.MagickCore.Types.FFI.FilterTypes 13 | , module Graphics.ImageMagick.MagickCore.Types.FFI.Fx 14 | , module Graphics.ImageMagick.MagickCore.Types.FFI.Geometry 15 | , module Graphics.ImageMagick.MagickCore.Types.FFI.Image 16 | , module Graphics.ImageMagick.MagickCore.Types.FFI.Layer 17 | , module Graphics.ImageMagick.MagickCore.Types.FFI.Log 18 | , module Graphics.ImageMagick.MagickCore.Types.FFI.MagickFunction 19 | , module Graphics.ImageMagick.MagickCore.Types.FFI.PaintMethod 20 | , module Graphics.ImageMagick.MagickCore.Types.FFI.PixelPacket 21 | , module Graphics.ImageMagick.MagickCore.Types.FFI.Statistic 22 | , module Graphics.ImageMagick.MagickCore.Types.FFI.Types 23 | , module Graphics.ImageMagick.MagickCore.Types.MBits 24 | ) where 25 | 26 | import Graphics.ImageMagick.MagickCore.Types.FFI.AlphaChannelType 27 | import Graphics.ImageMagick.MagickCore.Types.FFI.CacheView 28 | import Graphics.ImageMagick.MagickCore.Types.FFI.ChannelType 29 | import Graphics.ImageMagick.MagickCore.Types.FFI.ColorspaceType 30 | import Graphics.ImageMagick.MagickCore.Types.FFI.Composite 31 | import Graphics.ImageMagick.MagickCore.Types.FFI.Compress 32 | import Graphics.ImageMagick.MagickCore.Types.FFI.Constitute 33 | import Graphics.ImageMagick.MagickCore.Types.FFI.Distort 34 | import Graphics.ImageMagick.MagickCore.Types.FFI.DitherMethod 35 | import Graphics.ImageMagick.MagickCore.Types.FFI.Exception 36 | import Graphics.ImageMagick.MagickCore.Types.FFI.FilterTypes 37 | import Graphics.ImageMagick.MagickCore.Types.FFI.Fx 38 | import Graphics.ImageMagick.MagickCore.Types.FFI.Geometry 39 | import Graphics.ImageMagick.MagickCore.Types.FFI.Image 40 | import Graphics.ImageMagick.MagickCore.Types.FFI.Layer 41 | import Graphics.ImageMagick.MagickCore.Types.FFI.Log 42 | import Graphics.ImageMagick.MagickCore.Types.FFI.MagickFunction 43 | import Graphics.ImageMagick.MagickCore.Types.FFI.PaintMethod 44 | import Graphics.ImageMagick.MagickCore.Types.FFI.PixelPacket 45 | import Graphics.ImageMagick.MagickCore.Types.FFI.Statistic 46 | import Graphics.ImageMagick.MagickCore.Types.FFI.Types 47 | import Graphics.ImageMagick.MagickCore.Types.MBits 48 | 49 | -------------------------------------------------------------------------------- /examples/modulate.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | {- 3 | From: http://www.imagemagick.org/discourse-server/viewtopic.php?f=1&t=12640 4 | 5 | Read the logo: image and use PixelIterators to produce two new images. 6 | Convert the image to the HSB and HSL colourspaces, cut the Lightness/Brightness 7 | by half and then write the images as logo_hsb.jpg and logo_hsl.jpg 8 | Note the colour distortion in the HSL result whereas the HSB image is what 9 | we'd expect to see when reducing an image's brightness by 50%. 10 | 11 | As with my other examples, there is no error checking in this code. 12 | If you adapt this to your own use, you should add error checking to ensure 13 | that, for example, MagickReadImage succeeds and that the width and height 14 | of the image in mw are reasonable values. 15 | -} 16 | import Control.Monad.IO.Class 17 | import Control.Monad 18 | import qualified Data.Vector.Storable as V 19 | import Graphics.ImageMagick.MagickWand 20 | 21 | main = withMagickWandGenesis $ do 22 | (_,mw) <- magickWand 23 | 24 | mw `readImage` "logo:" 25 | 26 | width <- getImageWidth mw 27 | height <- getImageHeight mw 28 | 29 | (_,mwl) <- magickWand 30 | (_,mwb) <- magickWand 31 | 32 | p <- pixelWand 33 | p `setColor` "none" 34 | -- Set the hsl and hsb images to the same size as the input image 35 | newImage mwl width height p 36 | newImage mwb width height p 37 | -- Even though we won't be reading these images they must be initialized 38 | -- to something TODO: fails to work 39 | -- readImage mwl "xs:none" 40 | -- readImage mwb "xs:none" 41 | 42 | -- Create iterators for each image 43 | (_,imw) <- pixelIterator mw 44 | (_,imwl) <- pixelIterator mwl 45 | (_,imwb) <- pixelIterator mwb 46 | 47 | it1 <- pixelIterateList imw 48 | it2 <- pixelIterateList imwl 49 | it3 <- pixelIterateList imwb 50 | mapM_ (action imwl imwb) $ zip3 it1 it2 it3 51 | 52 | -- write the results 53 | mwb `writeImage` (Just "logo_hsb.jpg") 54 | mwl `writeImage` (Just "logo_hsl.jpg") 55 | where 56 | action imwl imwb (pmw, pmwl, pmwb) = do 57 | V.zipWithM_ inner1 pmw pmwb 58 | V.zipWithM_ inner2 pmw pmwl 59 | -- Sync writes the pixels back to the magick wands 60 | pixelSyncIterator imwl 61 | pixelSyncIterator imwb 62 | inner1 xmw xmwb = localGenesis $ do 63 | -- Get the RGB quanta from the source image 64 | qr <- getRedQuantum xmw 65 | qg <- getGreenQuantum xmw 66 | qb <- getBlueQuantum xmw 67 | 68 | -- Convert the source quanta to HSB 69 | (bh,bs,bb) <- convertRGBToHSB qr qg qb 70 | (qr1,qg1,qb1) <- convertHSBToRGB bh bs (0.5*bb) 71 | -- Set the pixel in the HSB output image 72 | xmwb `setRedQuantum` qr1 73 | xmwb `setGreenQuantum` qg1 74 | xmwb `setBlueQuantum` qb1 75 | inner2 xmw xmwl = localGenesis $ do 76 | qr <- getRedQuantum xmw 77 | qg <- getGreenQuantum xmw 78 | qb <- getBlueQuantum xmw 79 | -- Convert the source quanta to HSL 80 | (lh,ls,ll) <- convertRGBToHSL qr qg qb 81 | (qr2,qg2,qb2) <- convertHSLToRGB lh ls (ll*0.5) 82 | -- Set the pixel in the HSL output image 83 | xmwl `setRedQuantum` qr2 84 | xmwl `setGreenQuantum` qg2 85 | xmwl `setBlueQuantum` qb2 86 | 87 | zipWith3M_ f a b c = V.zipWithM_ f (V.zipWith g a b) c 88 | where g a b = (a,b) 89 | f' f (a,b) c = f a b c 90 | -------------------------------------------------------------------------------- /src/Graphics/ImageMagick/MagickWand/FFI/Types.hsc: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP, ForeignFunctionInterface, NoMonomorphismRestriction, RankNTypes #-} 2 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 3 | 4 | module Graphics.ImageMagick.MagickWand.FFI.Types 5 | where 6 | 7 | #include 8 | 9 | import Control.Monad 10 | 11 | import Foreign 12 | import Foreign.C.Types 13 | 14 | data PixelIterator 15 | data MagickWand 16 | data PixelWand 17 | data DrawingWand 18 | data Image 19 | data PointInfo = PointInfo {piX, piY :: CDouble} 20 | deriving (Eq, Show) 21 | 22 | instance Storable PointInfo where 23 | sizeOf = const #size PointInfo 24 | alignment _ = 1 25 | poke p foo = do 26 | #{poke PointInfo, x} p $ piX foo 27 | #{poke PointInfo, y} p $ piY foo 28 | 29 | peek p = return PointInfo 30 | `ap` (#{peek PointInfo, x} p) 31 | `ap` (#{peek PointInfo, y} p) 32 | 33 | 34 | newtype MagickBooleanType = MagickBooleanType { unMagickBooleanType :: CInt} 35 | deriving (Eq, Show, Storable) 36 | 37 | #{enum MagickBooleanType, MagickBooleanType 38 | , mFalse = MagickFalse 39 | , mTrue = MagickTrue 40 | } 41 | 42 | newtype ClassType = ClassType { unClassType :: CInt} 43 | deriving (Eq, Show) 44 | 45 | #{enum ClassType, ClassType 46 | , undefinedClass = UndefinedClass 47 | , directClass = DirectClass 48 | , pseudoClass = PseudoClass 49 | } 50 | 51 | newtype LineCap = LineCap { unLineCap :: CInt } 52 | #{enum LineCap, LineCap 53 | , udefinedCap = UndefinedCap 54 | , buttCap = ButtCap 55 | , roundCap = RoundCap 56 | , squareCap = SquareCap 57 | } 58 | 59 | newtype LineJoin = LineJoin { unLineJoin :: CInt } 60 | #{enum LineJoin, LineJoin 61 | , undefinedJoin = UndefinedJoin 62 | , mitterJoin = MiterJoin 63 | , roundJoin = RoundJoin 64 | , bevelJoin = BevelJoin 65 | } 66 | 67 | newtype FillRule = FillRule { unFillRule :: CInt } 68 | #{enum FillRule, FillRule 69 | , undefinedRule = UndefinedRule 70 | , evenOddRule = EvenOddRule 71 | , nonZeroRule = NonZeroRule 72 | } 73 | 74 | newtype OrientationType = OrientationType { unOrientationType :: CInt } 75 | deriving (Eq, Show) 76 | #{enum OrientationType, OrientationType 77 | , undefinedOrientation = UndefinedOrientation 78 | , topLeftOrientation = TopLeftOrientation 79 | , topRightOrientation = TopRightOrientation 80 | , bottomRightOrientation = BottomRightOrientation 81 | , bottomLeftOrientation = BottomLeftOrientation 82 | , leftTopOrientation = LeftTopOrientation 83 | , rightTopOrientation = RightTopOrientation 84 | , rightBottomOrientation = RightBottomOrientation 85 | , leftBottomOrientation = LeftBottomOrientation 86 | } 87 | 88 | data MagickPixelPacket 89 | 90 | instance Storable MagickPixelPacket where 91 | sizeOf = const #size MagickPixelPacket 92 | alignment _ = 1 93 | peek = error "not yet implemented" 94 | poke = error "not yet implemented" 95 | 96 | getPixelRed, getPixelGreen, getPixelBlue, getPixelIndex 97 | :: Storable a => Ptr b -> IO a 98 | 99 | getPixelRed = #peek MagickPixelPacket, red 100 | getPixelGreen = #peek MagickPixelPacket, green 101 | getPixelBlue = #peek MagickPixelPacket, blue 102 | getPixelIndex = #peek MagickPixelPacket, index 103 | 104 | setPixelRed, setPixelGreen, setPixelBlue, setPixelIndex 105 | :: Storable a => Ptr b -> a -> IO () 106 | 107 | setPixelRed = #poke MagickPixelPacket, red 108 | setPixelGreen = #poke MagickPixelPacket, green 109 | setPixelBlue = #poke MagickPixelPacket, blue 110 | setPixelIndex = #poke MagickPixelPacket, index 111 | 112 | -------------------------------------------------------------------------------- /src/Graphics/ImageMagick/MagickCore/Types/FFI/Composite.hsc: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE ForeignFunctionInterface #-} 3 | module Graphics.ImageMagick.MagickCore.Types.FFI.Composite 4 | where 5 | 6 | import Foreign.C.Types 7 | #include 8 | 9 | newtype CompositeOperator = CompositeOperator { unCompositeOperator :: CInt } 10 | 11 | #{enum CompositeOperator, CompositeOperator, 12 | undefinedCompositeOp = UndefinedCompositeOp, 13 | noCompositeOp = NoCompositeOp, 14 | modulusAddCompositeOp = ModulusAddCompositeOp, 15 | atopCompositeOp = AtopCompositeOp, 16 | blendCompositeOp = BlendCompositeOp, 17 | bumpmapCompositeOp = BumpmapCompositeOp, 18 | changeMaskCompositeOp = ChangeMaskCompositeOp, 19 | clearCompositeOp = ClearCompositeOp, 20 | colorBurnCompositeOp = ColorBurnCompositeOp, 21 | colorDodgeCompositeOp = ColorDodgeCompositeOp, 22 | colorizeCompositeOp = ColorizeCompositeOp, 23 | copyBlackCompositeOp = CopyBlackCompositeOp, 24 | copyBlueCompositeOp = CopyBlueCompositeOp, 25 | copyCompositeOp = CopyCompositeOp, 26 | copyCyanCompositeOp = CopyCyanCompositeOp, 27 | copyGreenCompositeOp = CopyGreenCompositeOp, 28 | copyMagentaCompositeOp = CopyMagentaCompositeOp, 29 | copyOpacityCompositeOp = CopyOpacityCompositeOp, 30 | copyRedCompositeOp = CopyRedCompositeOp, 31 | copyYellowCompositeOp = CopyYellowCompositeOp, 32 | darkenCompositeOp = DarkenCompositeOp, 33 | dstAtopCompositeOp = DstAtopCompositeOp, 34 | dstCompositeOp = DstCompositeOp, 35 | dstInCompositeOp = DstInCompositeOp, 36 | dstOutCompositeOp = DstOutCompositeOp, 37 | dstOverCompositeOp = DstOverCompositeOp, 38 | differenceCompositeOp = DifferenceCompositeOp, 39 | displaceCompositeOp = DisplaceCompositeOp, 40 | dissolveCompositeOp = DissolveCompositeOp, 41 | exclusionCompositeOp = ExclusionCompositeOp, 42 | hardLightCompositeOp = HardLightCompositeOp, 43 | hueCompositeOp = HueCompositeOp, 44 | inCompositeOp = InCompositeOp, 45 | lightenCompositeOp = LightenCompositeOp, 46 | linearLightCompositeOp = LinearLightCompositeOp, 47 | luminizeCompositeOp = LuminizeCompositeOp, 48 | minusDstCompositeOp = MinusDstCompositeOp, 49 | modulateCompositeOp = ModulateCompositeOp, 50 | multiplyCompositeOp = MultiplyCompositeOp, 51 | outCompositeOp = OutCompositeOp, 52 | overCompositeOp = OverCompositeOp, 53 | overlayCompositeOp = OverlayCompositeOp, 54 | plusCompositeOp = PlusCompositeOp, 55 | replaceCompositeOp = ReplaceCompositeOp, 56 | saturateCompositeOp = SaturateCompositeOp, 57 | screenCompositeOp = ScreenCompositeOp, 58 | softLightCompositeOp = SoftLightCompositeOp, 59 | srcAtopCompositeOp = SrcAtopCompositeOp, 60 | srcCompositeOp = SrcCompositeOp, 61 | srcInCompositeOp = SrcInCompositeOp, 62 | srcOutCompositeOp = SrcOutCompositeOp, 63 | srcOverCompositeOp = SrcOverCompositeOp, 64 | modulusSubtractCompositeOp = ModulusSubtractCompositeOp, 65 | thresholdCompositeOp = ThresholdCompositeOp, 66 | xorCompositeOp = XorCompositeOp, 67 | divideDstCompositeOp = DivideDstCompositeOp, 68 | distortCompositeOp = DistortCompositeOp, 69 | blurCompositeOp = BlurCompositeOp, 70 | pegtopLightCompositeOp = PegtopLightCompositeOp, 71 | vividLightCompositeOp = VividLightCompositeOp, 72 | pinLightCompositeOp = PinLightCompositeOp, 73 | linearDodgeCompositeOp = LinearDodgeCompositeOp, 74 | linearBurnCompositeOp = LinearBurnCompositeOp, 75 | mathematicsCompositeOp = MathematicsCompositeOp, 76 | divideSrcCompositeOp = DivideSrcCompositeOp, 77 | minusSrcCompositeOp = MinusSrcCompositeOp, 78 | darkenIntensityCompositeOp = DarkenIntensityCompositeOp, 79 | lightenIntensityCompositeOp = LightenIntensityCompositeOp 80 | } 81 | 82 | -------------------------------------------------------------------------------- /examples/landscape_3d.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | -- | Example taken from: http://members.shaw.ca/el.supremo/MagickWand/landscape_3d.htm 3 | -- This is derived from a PHP script at: 4 | -- http://eclecticdjs.com/mike/tutorials/php/imagemagick/imagickpixeliterator/3D_landscape.php 5 | 6 | import Control.Applicative ((<$>)) 7 | import Control.Monad 8 | import Control.Monad.IO.Class (liftIO) 9 | import Data.IORef 10 | import Graphics.ImageMagick.MagickWand 11 | 12 | 13 | main :: IO () 14 | main = withMagickWandGenesis $ do 15 | -- input image 16 | -- The input image is at: "http://eclecticdjs.com/mike/temp/ball/fract6.jpg" 17 | let url = "fract6.jpg"; 18 | -- output image 19 | let file = "3d_fractal.jpg"; 20 | 21 | (_,image) <- magickWand 22 | pw <- pixelWand 23 | 24 | readImage image url 25 | -- scale it down 26 | -- w <- getImageWidth image 27 | -- h <- getImageHeight image 28 | 29 | pw `setColor` "transparent" 30 | shearImage image pw 45 0 31 | -- MessageBox(NULL,"B - Shear failed","",MB_OK); 32 | w0 <- getImageWidth image 33 | h0 <- getImageHeight image 34 | 35 | -- scale it to make it look like it is laying down 36 | scaleImage image w0 (h0 `div` 2) 37 | -- MessageBox(NULL,"C - Scale failed","",MB_OK); 38 | -- Get image stats 39 | w <- getImageWidth image 40 | h <- getImageHeight image 41 | 42 | -- Make a blank canvas to draw on 43 | (_,canvas) <- magickWand 44 | -- Use a colour from the input image 45 | getImagePixelColor image 0 0 pw 46 | newImage canvas w (h*2) pw 47 | 48 | let offset = h 49 | -- The original drawing method was to go along each row from top to bottom so that 50 | -- a line in the "front" (which is one lower down the picture) will be drawn over 51 | -- one behind it. 52 | -- The problem with this method is that every line is drawn even if it will be covered 53 | -- up by a line "in front" of it later on. 54 | -- The method used here goes up each column from left to right and only draws a line if 55 | -- it is longer than everything drawn so far in this column and will therefore be visible. 56 | -- With the new drawing method this takes 13 secs - the previous method took 59 secs 57 | -- loop through all points in image 58 | forM_ [0..(w-1)] $ \x -> localGenesis $ do 59 | -- The PHP version created, used and destroyed the drawingwand inside 60 | -- the inner loop but it is about 25% faster to do only the DrawLine 61 | -- inside the loop 62 | (_,line) <- drawingWand 63 | line_height <- liftIO $ newIORef 0 -- let line_height = 0 64 | forM_ [(h-1),(h-2)..0] $ \y -> do 65 | -- get (r,g,b) and grey value 66 | getImagePixelColor image x y pw 67 | -- 255* adjusts the rgb values to Q8 even if the IM being used is Q16 68 | r <- round <$> (255*) <$> getRed pw 69 | g <- round <$> (255*) <$> getGreen pw 70 | b <- round <$> (255*) <$> getBlue pw 71 | 72 | -- Calculate grayscale - a divisor of 10-25 seems to work well. 73 | -- grey = (r+g+b)/25; 74 | let grey = (r + g + b) `div` 15 75 | -- grey = (r+g+b)/10; 76 | -- Only draw a line if it will show "above" what's already been done 77 | current <- liftIO $ readIORef line_height 78 | when (current == 0 || current < grey) $ do 79 | line `setFillColor` pw 80 | line `setStrokeColor` pw 81 | -- Draw the part of the line that is visible 82 | let 83 | start_y = y + offset - current 84 | end_y = y - grey + offset 85 | drawLine line (fromIntegral x) (fromIntegral start_y) (fromIntegral x) (fromIntegral end_y) 86 | liftIO $ writeIORef line_height grey 87 | liftIO $ modifyIORef line_height (\n->n-1) 88 | 89 | -- Draw the lines on the image 90 | drawImage canvas line 91 | 92 | scaleImage canvas (w-h) (h*2) 93 | -- write canvas 94 | writeImage canvas (Just file) 95 | -------------------------------------------------------------------------------- /src/Graphics/ImageMagick/MagickCore/Types/FFI/Exception.hsc: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE ForeignFunctionInterface #-} 3 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 4 | 5 | module Graphics.ImageMagick.MagickCore.Types.FFI.Exception 6 | where 7 | 8 | import Foreign.Storable 9 | import Foreign.C.Types 10 | #include 11 | 12 | newtype ExceptionType = ExceptionType { unExceptionType :: CInt } 13 | deriving (Eq,Show,Storable) 14 | 15 | #{enum ExceptionType, ExceptionType 16 | , undefinedException = UndefinedException 17 | , warningException = WarningException 18 | , resourceLimitWarning = ResourceLimitWarning 19 | , typeWarning = TypeWarning 20 | , optionWarning = OptionWarning 21 | , delegateWarning = DelegateWarning 22 | , missingDelegateWarning = MissingDelegateWarning 23 | , corruptImageWarning = CorruptImageWarning 24 | , fileOpenWarning = FileOpenWarning 25 | , blobWarning = BlobWarning 26 | , streamWarning = StreamWarning 27 | , cacheWarning = CacheWarning 28 | , coderWarning = CoderWarning 29 | , filterWarning = FilterWarning 30 | , moduleWarning = ModuleWarning 31 | , drawWarning = DrawWarning 32 | , imageWarning = ImageWarning 33 | , wandWarning = WandWarning 34 | , randomWarning = RandomWarning 35 | , xServerWarning = XServerWarning 36 | , monitorWarning = MonitorWarning 37 | , registryWarning = RegistryWarning 38 | , configureWarning = ConfigureWarning 39 | , policyWarning = PolicyWarning 40 | , errorException = ErrorException 41 | , resourceLimitError = ResourceLimitError 42 | , typeError = TypeError 43 | , optionError = OptionError 44 | , delegateError = DelegateError 45 | , missingDelegateError = MissingDelegateError 46 | , corruptImageError = CorruptImageError 47 | , fileOpenError = FileOpenError 48 | , blobError = BlobError 49 | , streamError = StreamError 50 | , cacheError = CacheError 51 | , coderError = CoderError 52 | , filterError = FilterError 53 | , moduleError = ModuleError 54 | , drawError = DrawError 55 | , imageError = ImageError 56 | , wandError = WandError 57 | , randomError = RandomError 58 | , xServerError = XServerError 59 | , monitorError = MonitorError 60 | , registryError = RegistryError 61 | , configureError = ConfigureError 62 | , policyError = PolicyError 63 | , fatalErrorException = FatalErrorException 64 | , resourceLimitFatalError = ResourceLimitFatalError 65 | , typeFatalError = TypeFatalError 66 | , optionFatalError = OptionFatalError 67 | , delegateFatalError = DelegateFatalError 68 | , missingDelegateFatalError = MissingDelegateFatalError 69 | , corruptImageFatalError = CorruptImageFatalError 70 | , fileOpenFatalError = FileOpenFatalError 71 | , blobFatalError = BlobFatalError 72 | , streamFatalError = StreamFatalError 73 | , cacheFatalError = CacheFatalError 74 | , coderFatalError = CoderFatalError 75 | , filterFatalError = FilterFatalError 76 | , moduleFatalError = ModuleFatalError 77 | , drawFatalError = DrawFatalError 78 | , imageFatalError = ImageFatalError 79 | , wandFatalError = WandFatalError 80 | , randomFatalError = RandomFatalError 81 | , xServerFatalError = XServerFatalError 82 | , monitorFatalError = MonitorFatalError 83 | , registryFatalError = RegistryFatalError 84 | , configureFatalError = ConfigureFatalError 85 | , policyFatalError = PolicyFatalError 86 | } 87 | 88 | data ExceptionSeverity = Undefined | Warning | Error | FatalError 89 | deriving (Eq, Show) 90 | 91 | toSeverity :: ExceptionType -> ExceptionSeverity 92 | toSeverity x = go ((unExceptionType x) `div` 100) 93 | where 94 | go 3 = Warning 95 | go 4 = Error 96 | go 7 = FatalError 97 | go _ = Undefined 98 | -------------------------------------------------------------------------------- /src/Graphics/ImageMagick/MagickWand/PixelIterator.hs: -------------------------------------------------------------------------------- 1 | module Graphics.ImageMagick.MagickWand.PixelIterator 2 | ( pixelIterator 3 | , pixelRegionIterator 4 | , pixelGetNextIteratorRow 5 | , pixelSyncIterator 6 | , pixelResetIterator 7 | , pixelIterateList 8 | , pixelGetMagickColor -- TODO move to another file 9 | , pixelSetMagickColor -- TODO move to another file 10 | -- , clonePixelIterator 11 | -- , isPixelIterator 12 | -- , pixelGetCurrentIteratorRow 13 | -- , pixelGetIteratorRow 14 | -- , pixelGetNextIteratorRow 15 | -- , pixelGetPreviousIteratorRow 16 | -- , pixelSetFirstIteratorRow 17 | -- , pixelSetIteratorRow 18 | -- , pixelSetLastIteratorRow 19 | ) where 20 | 21 | import Control.Monad 22 | import Control.Monad.IO.Class 23 | import Control.Monad.Trans.Resource 24 | import Data.Vector.Storable (Vector) 25 | import qualified Data.Vector.Storable as V 26 | import Foreign hiding (void) 27 | import Foreign.C.Types (CSize) 28 | import System.IO.Unsafe (unsafeInterleaveIO) 29 | 30 | import qualified Graphics.ImageMagick.MagickWand.FFI.PixelIterator as F 31 | import qualified Graphics.ImageMagick.MagickWand.FFI.PixelWand as F 32 | import Graphics.ImageMagick.MagickWand.FFI.Types 33 | import Graphics.ImageMagick.MagickWand.Types 34 | import Graphics.ImageMagick.MagickWand.Utils 35 | 36 | 37 | pixelIterator :: (MonadResource m) => Ptr MagickWand -> m (ReleaseKey, PPixelIterator) 38 | pixelIterator w = allocate (F.newPixelIterator w) destroy 39 | where destroy = void . F.destroyPixelIterator 40 | 41 | pixelRegionIterator :: (MonadResource m) 42 | => Ptr MagickWand -> Int -> Int -> Int -> Int -> m (ReleaseKey, PPixelIterator) 43 | pixelRegionIterator w x y width height = allocate (F.newPixelRegionIterator w x' y' width' height') destroy 44 | where destroy = void . F.destroyPixelIterator 45 | x' = fromIntegral x 46 | y' = fromIntegral y 47 | width' = fromIntegral width 48 | height' = fromIntegral height 49 | 50 | pixelGetNextIteratorRow :: (MonadResource m) => PPixelIterator -> m (Maybe (Vector PPixelWand)) 51 | pixelGetNextIteratorRow p = do 52 | x <- allocate (createPixelWandVector (F.pixelGetNextIteratorRow p)) (const $ return ()) 53 | case x of 54 | (_, Just v) -> return (Just v) 55 | (_, Nothing) -> return Nothing 56 | 57 | pixelGetMagickColor :: (MonadIO m) => PPixelWand -> m PMagickPixelPacket 58 | pixelGetMagickColor w = liftIO $ do 59 | c <- mallocForeignPtr 60 | withForeignPtr c (F.pixelGetMagickColor w) 61 | return c 62 | 63 | pixelSetMagickColor :: (MonadResource m) => PPixelWand -> PMagickPixelPacket -> m () 64 | pixelSetMagickColor w c = liftIO $ withForeignPtr c (F.pixelSetMagickColor w) 65 | 66 | pixelSyncIterator :: (MonadResource m) => PPixelIterator -> m () 67 | pixelSyncIterator p = withException_ p $ F.pixelSyncIterator p 68 | 69 | pixelResetIterator :: (MonadResource m) => PPixelIterator -> m () 70 | pixelResetIterator = liftIO . F.pixelResetIterator 71 | 72 | -- | creates lazy list of pixel vectors 73 | pixelIterateList :: (MonadResource m) => PPixelIterator -> m [Vector PPixelWand] 74 | pixelIterateList it = pixelResetIterator it >> liftIO go 75 | where 76 | go :: IO [Vector PPixelWand] 77 | go = unsafeInterleaveIO $ do 78 | mv <- createPixelWandVector (F.pixelGetNextIteratorRow it) 79 | case mv of 80 | Just v -> go >>= return . (:) v 81 | Nothing -> return [] 82 | 83 | 84 | createPixelWandVector :: (Ptr CSize -> IO (Ptr PPixelWand)) -> IO (Maybe (Vector (PPixelWand))) 85 | createPixelWandVector f = alloca $ \x -> do 86 | ptr <- f x 87 | if ptr == nullPtr 88 | then return Nothing 89 | else do 90 | n <- fmap fromIntegral (peek x) 91 | fmap (Just . (\p -> V.unsafeFromForeignPtr0 p n)) (newForeignPtr_ ptr) 92 | 93 | -------------------------------------------------------------------------------- /examples/gel.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleContexts #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | {-# LANGUAGE ScopedTypeVariables #-} 4 | {-# LANGUAGE FlexibleContexts #-} 5 | -- | Example taken from: http://members.shaw.ca/el.supremo/MagickWand/gel.htm 6 | -- "Gel" Effects example 7 | -- http://www.imagemagick.org/Usage/advanced/#gel_effects 8 | 9 | import Control.Exception.Lifted 10 | import Control.Monad (void) 11 | import Graphics.ImageMagick.MagickWand 12 | import Prelude hiding (catch) 13 | 14 | 15 | main :: IO () 16 | main = 17 | withMagickWandGenesis $ do 18 | -- First step is to create the gel shape: 19 | {- 20 | convert -size 100x60 xc:none \ 21 | -fill red -draw 'circle 25,30 10,30' \ 22 | -draw 'circle 75,30 90,30' \ 23 | -draw 'rectangle 25,15 75,45' \ 24 | gel_shape.png 25 | -} 26 | localGenesis $ do 27 | -- Create a wand 28 | (_,mw) <- magickWand 29 | pw <- pixelWand 30 | (_,dw) <- drawingWand 31 | 32 | setSize mw 100 60 33 | readImage mw "xc:none" 34 | 35 | pw `setColor` "red" 36 | dw `setFillColor` pw 37 | drawCircle dw 25 30 10 30 38 | drawCircle dw 75 30 90 30 39 | drawRectangle dw 25 15 75 45 40 | 41 | -- Now we draw the Drawing wand on to the Magick Wand 42 | drawImage mw dw 43 | 44 | writeImage mw (Just "gel_shape.png") 45 | 46 | -- Next step is to create the gel highlight: 47 | {- 48 | convert gel_shape.png \ 49 | \( +clone -fx A +matte -blur 0x12 -shade 110x0 -normalize \ 50 | -sigmoidal-contrast 16,60% -evaluate multiply .5 \ 51 | -roll +5+10 +clone -compose Screen -composite \) \ 52 | -compose In -composite gel_highlight.png 53 | -} 54 | localGenesis $ do 55 | (_,mw) <- magickWand 56 | readImage mw "gel_shape.png" 57 | 58 | (_,mwc) <- cloneMagickWand mw 59 | (_,mwf) <- fxImage mwc "A" 60 | -- TODO: fails, should we ignore it? 61 | ignoreExceptions (mw `setImageAlphaChannel` deactivateAlphaChannel) 62 | 63 | blurImage mwf 0 12 64 | shadeImage mwf True 110 0 65 | 66 | normalizeImage mwf 67 | -- The last argument is specified as a percentage on the command line 68 | -- but is specified to the function as a percentage of the QuantumRange 69 | sigmoidalContrastImage mwf True 16 (0.6 * quantumRange) 70 | 71 | evaluateImage mwf multiplyEvaluateOperator 0.5 72 | rollImage mwf 5 10 73 | 74 | -- The +clone operation copies the original but only so that 75 | -- it can be used in the following composite operation, so we don't 76 | -- actually need to do a clone, just reference the original image. 77 | compositeImage mwf mw screenCompositeOp 0 0 78 | 79 | compositeImage mw mwf inCompositeOp 0 0 80 | writeImage mw (Just "gel_highlight.png") 81 | 82 | -- Now create the gel border 83 | {- 84 | convert gel_highlight.png \ 85 | \( +clone -fx A +matte -blur 0x2 -shade 0x90 -normalize \ 86 | -blur 0x2 -negate -evaluate multiply .4 -negate -roll -.5-1 \ 87 | +clone -compose Multiply -composite \) \ 88 | -compose In -composite gel_border.png 89 | 90 | -} 91 | localGenesis $ do 92 | (_,mw) <- magickWand 93 | readImage mw "gel_highlight.png" 94 | (_,mwc) <- cloneMagickWand mw 95 | (_,mwf) <- fxImage mwc "A" 96 | ignoreExceptions (mwf `setImageAlphaChannel` deactivateAlphaChannel) 97 | blurImage mwf 0 2 98 | shadeImage mwf True 0 90 99 | normalizeImage mwf 100 | blurImage mwf 0 2 101 | negateImage mwf False 102 | evaluateImage mwf multiplyEvaluateOperator 0.4 103 | negateImage mwf False 104 | rollImage mwf (-0.5) (-1) 105 | compositeImage mwf mw multiplyCompositeOp 0 0 106 | compositeImage mw mwf inCompositeOp 0 0 107 | writeImage mw (Just "gel_border.png") 108 | 109 | -- and finally the text and shadow effect 110 | {- 111 | convert gel_border.png \ 112 | -font Candice -pointsize 24 -fill white -stroke black \ 113 | -gravity Center -annotate 0 "Gel" -trim -repage 0x0+4+4 \ 114 | \( +clone -background navy -shadow 80x4+4+4 \) +swap \ 115 | -background none -flatten gel_button.png 116 | -} 117 | localGenesis $ do 118 | (_,mw) <- magickWand 119 | (_,dw) <- drawingWand 120 | pw <- pixelWand 121 | readImage mw "gel_border.png" 122 | dw `setFont` "Lucida-Handwriting-Italic" 123 | dw `setFontSize` 24 124 | pw `setColor` "white" 125 | dw `setFillColor` pw 126 | pw `setColor` "black" 127 | dw `setStrokeColor` pw 128 | dw `setGravity` centerGravity 129 | -- It is important to notice here that MagickAnnotateImage renders the text on 130 | -- to the MagickWand, NOT the DrawingWand. It only uses the DrawingWand for font 131 | -- and colour information etc. 132 | annotateImage mw dw 0 0 0 "Gel" 133 | trimImage mw 0 134 | resetImagePage mw (Just "0x0+4+4") 135 | (_,mwc) <- cloneMagickWand mw 136 | pw `setColor` "navy" 137 | mwc `setImageBackgroundColor` pw 138 | shadowImage mwc 80 4 4 4 139 | (_,mwf) <- magickWand 140 | addImage mwf mwc 141 | addImage mwf mw 142 | pw `setColor` "none" 143 | mwf `setImageBackgroundColor` pw 144 | (_,mw') <- mergeImageLayers mwf flattenLayer 145 | writeImage mw' (Just "gel_button.png") 146 | 147 | ignoreExceptions f = catch (void f) (\(_::MagickWandException) -> return ()) 148 | -------------------------------------------------------------------------------- /src/Graphics/ImageMagick/MagickWand/FFI/PixelIterator.hsc: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE ForeignFunctionInterface #-} 3 | 4 | module Graphics.ImageMagick.MagickWand.FFI.PixelIterator 5 | where 6 | 7 | import Foreign 8 | import Foreign.C.String 9 | import Foreign.C.Types 10 | 11 | import Graphics.ImageMagick.MagickCore.Types 12 | import Graphics.ImageMagick.MagickWand.FFI.Types 13 | 14 | #include 15 | 16 | -- | ClearPixelIterator() clear resources associated with a PixelIterator. 17 | foreign import ccall "ClearPixelIterator" clearPixelIterator 18 | :: Ptr PixelIterator -> IO () 19 | 20 | -- | ClonePixelIterator() makes an exact copy of the specified iterator. 21 | foreign import ccall "ClonePixelIterator" clonePixelIterator 22 | :: Ptr PixelIterator -> IO (Ptr PixelIterator) 23 | 24 | -- | DestroyPixelIterator() deallocates resources associated with a PixelIterator. 25 | foreign import ccall "DestroyPixelIterator" destroyPixelIterator 26 | :: Ptr PixelIterator -> IO (Ptr PixelIterator) 27 | 28 | -- | IsPixelIterator() returns MagickTrue if the iterator is verified as a pixel iterator. 29 | foreign import ccall "IsPixelIterator" isPixelIterator 30 | :: Ptr PixelIterator -> IO MagickBooleanType 31 | 32 | foreign import ccall "NewPixelIterator" newPixelIterator 33 | :: Ptr MagickWand -> IO (Ptr PixelIterator) 34 | 35 | -- | NewPixelRegionIterator() returns a new pixel iterator. 36 | foreign import ccall "NewPixelRegionIterator" newPixelRegionIterator 37 | :: Ptr MagickWand -> CSize -> CSize -> CSize -> CSize -> IO (Ptr PixelIterator) 38 | 39 | 40 | -- | PixelClearIteratorException() clear any exceptions associated with the iterator. 41 | foreign import ccall "PixelClearIteratorException" pixelClearIteratorException 42 | :: Ptr PixelIterator -> IO MagickBooleanType 43 | 44 | -- | PixelGetIteratorException() returns the severity, reason, and description of any 45 | -- error that occurs when using other methods in this API. 46 | foreign import ccall "PixelGetIteratorException" pixelGetIteratorException 47 | :: Ptr PixelIterator -> Ptr ExceptionType -> IO CString 48 | 49 | -- | PixelGetIteratorExceptionType() the exception type associated with the iterator. 50 | -- If no exception has occurred, UndefinedExceptionType is returned. 51 | foreign import ccall "PixelGetIteratorExceptionType" pixelGetIteratorExceptionType 52 | :: Ptr PixelIterator -> IO ExceptionType 53 | 54 | {- | PixelGetCurrentIteratorRow() returns the current row as an array of pixel wands from the pixel iterator. 55 | -} 56 | foreign import ccall "PixelGetCurrentIteratorRow" pixelGetCurrentIteratorRow 57 | :: Ptr PixelIterator -> CSize -> Ptr (Ptr PixelWand) 58 | 59 | -- | PixelGetIteratorRow() returns the current pixel iterator row. 60 | foreign import ccall "PixelGetIteratorRow" pixelGetIteratorRow 61 | :: Ptr PixelIterator -> IO () 62 | 63 | -- | PixelGetNextIteratorRow() returns the next row as an array of pixel wands from the pixel iterator. 64 | foreign import ccall "PixelGetNextIteratorRow" pixelGetNextIteratorRow 65 | :: Ptr PixelIterator -- ^ iterator 66 | -> Ptr CSize -- ^ number of pixel wands 67 | -> IO (Ptr (Ptr PixelWand)) 68 | 69 | {- 70 | PixelGetPreviousIteratorRow 71 | 72 | PixelGetPreviousIteratorRow() returns the previous row as an array of pixel wands from the pixel iterator. 73 | 74 | The format of the PixelGetPreviousIteratorRow method is: 75 | 76 | PixelWand **PixelGetPreviousIteratorRow(PixelIterator *iterator, 77 | size_t *number_wands) 78 | 79 | A description of each parameter follows: 80 | iterator 81 | 82 | the pixel iterator. 83 | number_wands 84 | 85 | the number of pixel wands. 86 | PixelSetFirstIteratorRow 87 | 88 | PixelSetFirstIteratorRow() sets the pixel iterator to the first pixel row. 89 | 90 | The format of the PixelSetFirstIteratorRow method is: 91 | 92 | void PixelSetFirstIteratorRow(PixelIterator *iterator) 93 | 94 | A description of each parameter follows: 95 | iterator 96 | 97 | the magick iterator. 98 | PixelSetIteratorRow 99 | 100 | PixelSetIteratorRow() set the pixel iterator row. 101 | 102 | The format of the PixelSetIteratorRow method is: 103 | 104 | MagickBooleanType PixelSetIteratorRow(PixelIterator *iterator, 105 | const ssize_t row) 106 | 107 | A description of each parameter follows: 108 | iterator 109 | 110 | the pixel iterator. 111 | PixelSetLastIteratorRow 112 | 113 | PixelSetLastIteratorRow() sets the pixel iterator to the last pixel row. 114 | 115 | The format of the PixelSetLastIteratorRow method is: 116 | 117 | void PixelSetLastIteratorRow(PixelIterator *iterator) 118 | 119 | A description of each parameter follows: 120 | iterator 121 | 122 | the magick iterator. 123 | -} 124 | 125 | foreign import ccall "PixelSyncIterator" pixelSyncIterator 126 | :: Ptr PixelIterator -> IO MagickBooleanType 127 | 128 | -- | PixelResetIterator() resets the pixel iterator. Use it in conjunction 129 | -- with PixelGetNextIteratorRow() to iterate over all the pixels in a pixel container. 130 | foreign import ccall "PixelResetIterator" pixelResetIterator 131 | :: Ptr PixelIterator -> IO () 132 | -------------------------------------------------------------------------------- /src/Graphics/ImageMagick/MagickWand/FFI/WandProperties.hsc: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE ForeignFunctionInterface #-} 3 | module Graphics.ImageMagick.MagickWand.FFI.WandProperties 4 | where 5 | 6 | import Foreign 7 | import Foreign.C.String 8 | import Foreign.C.Types 9 | 10 | import Graphics.ImageMagick.MagickWand.FFI.Types 11 | 12 | 13 | foreign import ccall "MagickDeleteOption" magickDeleteOption 14 | :: Ptr MagickWand 15 | -> CString -- ^ the key 16 | -> IO MagickBooleanType 17 | 18 | -- | MagickGetOption() returns a value associated with a wand 19 | -- and the specified key. Use MagickRelinquishMemory() to free 20 | -- the value when you are finished with it. 21 | foreign import ccall "MagickGetOption" magickGetOption 22 | :: Ptr MagickWand 23 | -> CString -- ^ the key 24 | -> IO CString 25 | 26 | -- | MagickSetOption() associates one or options with the wand 27 | -- (e.g. MagickSetOption(wand,"jpeg:perserve","yes")). 28 | foreign import ccall "MagickSetOption" magickSetOption 29 | :: Ptr MagickWand 30 | -> CString -- ^ the key 31 | -> CString -- ^ the value 32 | -> IO MagickBooleanType 33 | 34 | -- | MagickGetOptions() returns all the option names that match the 35 | -- specified pattern associated with a wand. Use MagickGetOption() 36 | -- to return the value of a particular option. Use MagickRelinquishMemory() 37 | -- to free the value when you are finished with it. 38 | foreign import ccall "MagickGetOptions" magickGetOptions 39 | :: Ptr MagickWand 40 | -> CString -- ^ the pattern 41 | -> Ptr CSize 42 | -> IO (Ptr CString) 43 | 44 | -- | MagickDeleteImageProperty() deletes a wand property. 45 | foreign import ccall "MagickDeleteImageProperty" magickDeleteImageProperty 46 | :: Ptr MagickWand 47 | -> CString -- ^ the property 48 | -> IO MagickBooleanType 49 | 50 | -- | MagickGetImageProperty() returns a value associated with the 51 | -- specified property. Use MagickRelinquishMemory() to free the value 52 | -- when you are finished with it. 53 | foreign import ccall "MagickGetImageProperty" magickGetImageProperty 54 | :: Ptr MagickWand 55 | -> CString -- ^ the property 56 | -> IO CString 57 | 58 | -- | MagickGetImageProperties() returns all the property names that 59 | -- match the specified pattern associated with a wand. Use 60 | -- MagickGetImageProperty() to return the value of a particular property. 61 | -- Use MagickRelinquishMemory() to free the value when you are finished 62 | -- with it. 63 | foreign import ccall "MagickGetImageProperties" magickGetImageProperties 64 | :: Ptr MagickWand 65 | -> CString -- ^ the pattern 66 | -> Ptr CSize 67 | -> IO (Ptr CString) 68 | 69 | -- | MagickSetImageProperty() associates a property with an image. 70 | foreign import ccall "MagickSetImageProperty" magickSetImageProperty 71 | :: Ptr MagickWand 72 | -> CString -- ^ the property 73 | -> CString -- ^ the value 74 | -> IO MagickBooleanType 75 | 76 | -- | MagickGetImageProfile() returns the named image profile. 77 | foreign import ccall "MagickGetImageProfile" magickGetImageProfile 78 | :: Ptr MagickWand 79 | -> CString -- ^ the profile name 80 | -> Ptr CSize -- ^ the profile length 81 | -> IO (Ptr Word8) 82 | 83 | -- | MagickRemoveImageProfile() removes the named image profile and 84 | -- returns it. 85 | foreign import ccall "MagickRemoveImageProfile" magickRemoveImageProfile 86 | :: Ptr MagickWand 87 | -> CString -- ^ the profile name 88 | -> Ptr CSize -- ^ the profile length 89 | -> IO (Ptr Word8) 90 | 91 | -- | MagickSetImageProfile() adds a named profile to the magick wand. 92 | -- If a profile with the same name already exists, it is replaced. 93 | -- This method differs from the MagickProfileImage() method in that 94 | -- it does not apply any CMS color profiles. 95 | foreign import ccall "MagickSetImageProfile" magickSetImageProfile 96 | :: Ptr MagickWand 97 | -> CString -- ^ the profile name 98 | -> Ptr Word8 -- ^ the profile 99 | -> CSize -- ^ the profile length 100 | -> IO MagickBooleanType 101 | 102 | -- | MagickGetImageProfiles() returns all the profile names that match 103 | -- the specified pattern associated with a wand. Use 104 | -- MagickGetImageProfile() to return the value of a particular property. 105 | -- Use MagickRelinquishMemory() to free the value when you are finished 106 | -- with it. 107 | foreign import ccall "MagickGetImageProfiles" magickGetImageProfiles 108 | :: Ptr MagickWand 109 | -> CString -- ^ the pattern 110 | -> Ptr CSize 111 | -> IO (Ptr CString) 112 | 113 | -- | MagickSetResolution() sets the image resolution. 114 | foreign import ccall "MagickSetImageResolution" magickSetImageResolution 115 | :: Ptr MagickWand 116 | -> CDouble -- ^ x resolution 117 | -> CDouble -- ^ y resolution 118 | -> IO MagickBooleanType 119 | 120 | -- | MagickGetResolution() gets the image resolution. 121 | foreign import ccall "MagickGetImageResolution" magickGetImageResolution 122 | :: Ptr MagickWand 123 | -> Ptr CDouble -- ^ x resolution 124 | -> Ptr CDouble -- ^ y resolution 125 | -> IO MagickBooleanType 126 | 127 | -- | MagickGetImageArtifacts() returns all the artifact names 128 | -- that match the specified pattern associated with a wand. 129 | -- Use MagickGetImageProperty() to return the value of a 130 | -- particular artifact. Use MagickRelinquishMemory() to free 131 | -- the value when you are finished with it. 132 | foreign import ccall "MagickGetImageArtifacts" magickGetImageArtifacts 133 | :: Ptr MagickWand 134 | -> CString -- ^ the pattern 135 | -> Ptr CSize 136 | -> IO (Ptr CString) 137 | -------------------------------------------------------------------------------- /examples/draw_shapes.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | -- | Example taken from: http://members.shaw.ca/el.supremo/MagickWand/draw_shapes.htm 3 | -- There's no equivalent convert command for this. It is a demo of MagickWand. 4 | -- Bits of this were pinched from 5 | -- http://www.imagemagick.org/api/MagickWand/drawtest_8c-source.html 6 | 7 | import Graphics.ImageMagick.MagickWand 8 | import Graphics.ImageMagick.MagickWand.FFI.Types 9 | 10 | 11 | main :: IO () 12 | main = 13 | withMagickWandGenesis $ do 14 | (_,w) <- magickWand 15 | (_,dw) <- drawingWand 16 | c <- pixelWand 17 | 18 | let diameter = 640 19 | radius = (fromIntegral diameter) / 2 20 | 21 | c `setColor` "white" 22 | newImage w diameter diameter c 23 | 24 | dw `setStrokeOpacity` 1 25 | -- circle and rectangle 26 | pushDrawingWand dw 27 | 28 | -- Hmmmm. Very weird. rgb(0,0,1) draws a black line around the edge 29 | -- of the circle as it should. But rgb(0,0,0) or black don't. 30 | -- AND if I remove the PixelSetColor then it draws a white boundary 31 | -- around the rectangle (and presumably around the circle too) 32 | c `setColor` "rgb(0,0,1)" 33 | 34 | dw `setStrokeColor` c 35 | dw `setStrokeWidth` 4 36 | dw `setStrokeAntialias` True 37 | c `setColor` "red" 38 | -- dw `setStrokeOpacity` 1 39 | dw `setFillColor` c 40 | 41 | drawCircle dw radius radius radius (radius * 2) 42 | drawRectangle dw 50 13 120 87 43 | popDrawingWand dw 44 | 45 | -- rounded rectangle 46 | pushDrawingWand dw 47 | let poly1 = [ 48 | PointInfo 378.1 81.72, PointInfo 381.1 79.56, PointInfo 384.3 78.12, PointInfo 387.6 77.33, 49 | PointInfo 391.1 77.11, PointInfo 394.6 77.62, PointInfo 397.8 78.77, PointInfo 400.9 80.57, 50 | PointInfo 403.6 83.02, PointInfo 523.9 216.8, PointInfo 526.2 219.7, PointInfo 527.6 223, 51 | PointInfo 528.4 226.4, PointInfo 528.6 229.8, PointInfo 528 233.3, PointInfo 526.9 236.5, 52 | PointInfo 525.1 239.5, PointInfo 522.6 242.2, PointInfo 495.9 266.3, PointInfo 493 268.5, 53 | PointInfo 489.7 269.9, PointInfo 486.4 270.8, PointInfo 482.9 270.9, PointInfo 479.5 270.4, 54 | PointInfo 476.2 269.3, PointInfo 473.2 267.5, PointInfo 470.4 265, PointInfo 350 131.2, 55 | PointInfo 347.8 128.3, PointInfo 346.4 125.1, PointInfo 345.6 121.7, PointInfo 345.4 118.2, 56 | PointInfo 346 114.8, PointInfo 347.1 111.5, PointInfo 348.9 108.5, PointInfo 351.4 105.8, 57 | PointInfo 378.1 81.72 58 | ] 59 | 60 | dw `setStrokeAntialias` True 61 | dw `setStrokeWidth` 2.016 62 | dw `setStrokeLineCap` roundCap 63 | dw `setStrokeLineJoin` roundJoin 64 | dw `setStrokeDashArray` [] 65 | c `setColor`{- "#000080" -} "rgb(0,0,128)" 66 | -- If strokecolor is removed completely then the circle is not there 67 | dw `setStrokeColor` c 68 | -- But now I've added strokeopacity - 1=circle there 0=circle not there 69 | -- If opacity is 1 the black edge around the rectangle is visible 70 | dw `setStrokeOpacity` 1 71 | -- No effect 72 | {- dw `setFillRule` evenOddRule -} 73 | -- this doesn't affect the circle 74 | c `setColor` "#c2c280" {- "rgb(194,194,128)" -} 75 | dw `setFillColor` c 76 | -- 1=circle there 0=circle there but rectangle fill disappears 77 | -- dw `setFillOpacity` False 78 | drawPolygon dw poly1 79 | -- dw `setFillOpacity` True 80 | popDrawingWand dw 81 | 82 | pushDrawingWand dw 83 | -- yellow polygon 84 | let poly2 = [ 85 | PointInfo 540 288, PointInfo 561.6 216, PointInfo 547.2 43.2, PointInfo 280.8 36, 86 | PointInfo 302.4 194.4, PointInfo 331.2 64.8, PointInfo 504 64.8, PointInfo 475.2 115.2, 87 | PointInfo 525.6 93.6, PointInfo 496.8 158.4, PointInfo 532.8 136.8, PointInfo 518.4 180, 88 | PointInfo 540 172.8, PointInfo 540 223.2, PointInfo 540 288 89 | ] 90 | dw `setStrokeAntialias` True 91 | dw `setStrokeWidth` 5.976 92 | dw `setStrokeLineCap` roundCap 93 | dw `setStrokeLineJoin` roundJoin 94 | dw `setStrokeDashArray` [] 95 | c `setColor` "#4000c2" 96 | dw `setStrokeColor` c 97 | dw `setFillRule` evenOddRule 98 | c `setColor` "#ffff00" 99 | dw `setFillColor` c 100 | drawPolygon dw poly2 101 | popDrawingWand dw 102 | 103 | -- rotated and translated ellipse 104 | -- The DrawEllipse function only draws the ellipse with 105 | -- the major and minor axes orthogonally aligned. This also 106 | -- applies to some of the other functions such as DrawRectangle. 107 | -- If you want an ellipse that has the major axis rotated, you 108 | -- have to rotate the coordinate system before the ellipse is 109 | -- drawn. And you'll also want the ellipse somewhere on the 110 | -- image rather than at the top left (where the 0,0 origin is 111 | -- located) so before drawing the ellipse we move the origin to 112 | -- wherever we want the centre of the ellipse to be and then 113 | -- rotate the coordinate system by the angle of rotation we wish 114 | -- to apply to the ellipse and *then* we draw the ellipse. 115 | -- NOTE that doing all this within `pushDrawingWand`/`popDrawingWand` 116 | -- means that the coordinate system will be restored after 117 | -- the `popDrawingWand` 118 | pushDrawingWand dw 119 | c `setColor` "rgb(0,0,1)" 120 | dw `setStrokeColor` c 121 | dw `setStrokeWidth` 2 122 | dw `setStrokeAntialias` True 123 | c `setColor` "orange" 124 | -- dw `setStrokeOpacity` 1 125 | dw `setFillColor` c 126 | -- Be careful of the order in which you meddle with the 127 | -- coordinate system! Rotating and then translating is 128 | -- not the same as translating then rotating 129 | translate dw (radius/2) (3 * radius/2) 130 | rotate dw (-30) 131 | drawEllipse dw 0 0 (radius/8) (3*radius/8) 0 360 132 | popDrawingWand dw 133 | 134 | -- A line from the centre of the circle 135 | -- to the top left edge of the image 136 | drawLine dw 0 0 radius radius 137 | 138 | drawImage w dw 139 | 140 | writeImage w (Just "chart_test.jpg") 141 | -------------------------------------------------------------------------------- /examples/wandtest.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | import Control.Monad (forM_, when) 3 | import Control.Monad.IO.Class (liftIO) 4 | import Control.Monad.Trans.Resource (release) 5 | import qualified Data.Text as T 6 | import Data.Vector.Storable (Vector, (!)) 7 | import qualified Data.Vector.Storable as V 8 | import Data.Word 9 | import Graphics.ImageMagick.MagickWand 10 | import System.Exit 11 | import Text.Printf (printf) 12 | 13 | exitWithMessage msg = liftIO $ do 14 | putStrLn msg 15 | exitFailure 16 | 17 | iterateWand magick_wand = magickIterate magick_wand $ \w -> do 18 | i <- getIteratorIndex w 19 | s <- getImageScene w 20 | liftIO $ putStrLn $ printf "index %2d scene %2d" i s 21 | 22 | 23 | main :: IO () 24 | main = withMagickWandGenesis $ do 25 | (_,magick_wand) <- magickWand 26 | setSize magick_wand 640 480 27 | size <- getSize magick_wand 28 | when (size /= (640,480)) $ exitWithMessage "Unexpected magick wand size" 29 | liftIO $ putStrLn "Reading images...\n" 30 | readImage magick_wand "sequence.miff" 31 | n <- getNumberImages magick_wand 32 | when (n /= 5) $ liftIO $ putStrLn $ printf "read %02d images; expected 5" n 33 | liftIO $ putStrLn "Iterate forward..." 34 | iterateWand magick_wand 35 | 36 | liftIO $ putStrLn "Iterate reverse..." 37 | magickIterateReverse magick_wand $ \w -> do 38 | i <- getIteratorIndex w 39 | s <- getImageScene w 40 | liftIO $ putStrLn $ printf "index %2d scene %2d" i s 41 | 42 | liftIO $ putStrLn "Remove scene 1..." 43 | setIteratorIndex magick_wand 1 44 | (clone_key,clone_wand) <- getImage magick_wand 45 | removeImage magick_wand 46 | iterateWand magick_wand 47 | 48 | liftIO $ putStrLn "Insert scene 1 back in sequence..." 49 | setIteratorIndex magick_wand 0 50 | addImage magick_wand clone_wand 51 | iterateWand magick_wand 52 | 53 | liftIO $ putStrLn "Set scene 2 to scene 1..." 54 | setIteratorIndex magick_wand 2 55 | setImage magick_wand clone_wand 56 | release clone_key 57 | iterateWand magick_wand 58 | 59 | liftIO $ putStrLn "Apply image processing options..." 60 | cropImage magick_wand 60 60 10 10 61 | resetIterator magick_wand 62 | background <- pixelWand 63 | background `setColor` "#000000" 64 | rotateImage magick_wand background 90.0 65 | border <- pixelWand 66 | background `setColor` "green" 67 | border `setColor` "black" 68 | floodfillPaintImage magick_wand compositeChannels background 69 | (0.01*quantumRange) border 0 0 False 70 | 71 | (drawing_key,drawing_wand) <- drawingWand 72 | pushDrawingWand drawing_wand 73 | rotate drawing_wand 45 74 | drawing_wand `setFontSize` 18 75 | fill <- pixelWand 76 | fill `setColor` "green" 77 | drawing_wand `setFillColor` fill 78 | -- ? fill=DestroyPixelWand(fill); 79 | drawAnnotation drawing_wand 15 5 "Magick" 80 | popDrawingWand drawing_wand 81 | setIteratorIndex magick_wand 1 82 | drawImage magick_wand drawing_wand 83 | annotateImage magick_wand drawing_wand 70 5 90 "Image" 84 | release drawing_key 85 | 86 | let primary_colors = [ 87 | 0, 0, 0, 88 | 0, 0, 255, 89 | 0, 255, 0, 90 | 0, 255, 255, 91 | 255, 255, 255, 92 | 255, 0, 0, 93 | 255, 0, 255, 94 | 255, 255, 0, 95 | 128, 128, 128 96 | ] :: [Word8] 97 | 98 | setIteratorIndex magick_wand 2 99 | importImagePixels magick_wand 10 10 3 3 "RGB" primary_colors 100 | pixels <- exportImagePixels magick_wand 10 10 3 3 "RGB" 101 | when (pixels /= primary_colors) $ exitWithMessage "Get pixels does not match set pixels" 102 | 103 | setIteratorIndex magick_wand 3 104 | resizeImage magick_wand 50 50 undefinedFilter 1.0 105 | magickIterate magick_wand $ \w -> do 106 | setImageDepth w 8 107 | setImageCompression w rleCompression 108 | 109 | resetIterator magick_wand 110 | setIteratorIndex magick_wand 4 111 | liftIO $ putStrLn "Utilitize pixel iterator to draw diagonal..." 112 | (iterator_key,iterator) <- pixelIterator magick_wand 113 | pixelRows <- pixelIterateList iterator 114 | forM_ (zip [0..] pixelRows) $ \(i, pixelRow) -> do 115 | pixelRow!i `setColor` "#224466" 116 | pixelSyncIterator iterator 117 | release iterator_key 118 | 119 | liftIO $ putStrLn "Write to wandtest_out.miff..." 120 | writeImages magick_wand "wandtest_out.miff" True 121 | liftIO $ putStrLn "Change image format from \"MIFF\" to \"GIF\"..." 122 | setImageFormat magick_wand "GIF" 123 | let wandDelay = 3 124 | newDelay = 100 * wandDelay 125 | liftIO $ putStrLn $ printf "Set delay between frames to %d seconds..." wandDelay 126 | setImageDelay magick_wand newDelay 127 | delay <- getImageDelay magick_wand 128 | when (delay /= newDelay) $ exitWithMessage "Get delay does not match set delay" 129 | liftIO $ putStrLn "Write to wandtest_out.gif..." 130 | writeImages magick_wand "wandtest_out.gif" True 131 | 132 | let customOption = "custom option" 133 | customOptionName = "wand:custom-option" 134 | liftIO $ putStrLn "Set, list, get, and delete wand option..." 135 | setOption magick_wand customOptionName customOption 136 | option <- getOption magick_wand customOptionName 137 | when (option /= customOption) $ exitWithMessage "Option does not match" 138 | options <- getOptions magick_wand "*" 139 | forM_ options $ \o -> liftIO $ putStrLn $ printf " %s" (T.unpack o) 140 | deleteOption magick_wand customOptionName 141 | 142 | let customPropertyName = "wand:custom-property" 143 | customProperty = "custom profile" 144 | liftIO $ putStrLn "Set, list, get, and delete wand property..." 145 | setImageProperty magick_wand customPropertyName customProperty 146 | property <- getImageProperty magick_wand customPropertyName 147 | when (property /= customProperty) $ exitWithMessage "Property does not match" 148 | properties <- getImageProperties magick_wand "*" 149 | forM_ properties $ \p -> liftIO $ putStrLn $ printf " %s" (T.unpack p) 150 | deleteImageProperty magick_wand customPropertyName 151 | 152 | let profileName = "sRGB" 153 | liftIO $ putStrLn "Set, list, get, and remove sRGB color profile..." 154 | setImageProfile magick_wand profileName sRGBProfile 155 | profile <- getImageProfile magick_wand profileName 156 | when (profile /= sRGBProfile) $ exitWithMessage "Profile does not match" 157 | profiles <- getImageProfiles magick_wand "*" 158 | forM_ profiles $ \p -> liftIO $ putStrLn $ printf " %s" (T.unpack p) 159 | removedProfile <- removeImageProfile magick_wand profileName 160 | when (removedProfile /= sRGBProfile) $ exitWithMessage "Profile does not match" 161 | liftIO $ putStrLn "Wand tests pass." 162 | 163 | -- only first 24 bytes from wandtest.c taken (no actual need for 60k profile) 164 | sRGBProfile :: Vector Word8 165 | sRGBProfile = V.fromList [ 166 | 0x00, 0x00, 0xee, 0x20, 0x00, 0x00, 0x00, 0x00, 0x04, 0x20, 0x00, 0x00, 167 | 0x73, 0x70, 0x61, 0x63, 0x52, 0x47, 0x42, 0x20, 0x4c, 0x61, 0x62, 0x20 168 | ] 169 | -------------------------------------------------------------------------------- /examples/3dlogo.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | -- http://members.shaw.ca/el.supremo/MagickWand/3dlogo.htm 3 | 4 | -- Better 3-D Logo Generation example 5 | -- http://www.imagemagick.org/Usage/advanced/#3d-logos-2 6 | 7 | import Graphics.ImageMagick.MagickWand 8 | 9 | 10 | main :: IO () 11 | main = do 12 | withMagickWandGenesis $ do 13 | localGenesis $ do 14 | {- 15 | convert -size 170x100 xc:black \ 16 | -fill white -draw 'circle 50,50 13,50' \ 17 | -draw 'circle 120,50 157,50' \ 18 | -draw 'rectangle 50,13 120,87' \ 19 | -fill black -draw 'circle 50,50 25,50' \ 20 | -draw 'circle 120,50 145,50' \ 21 | -draw 'rectangle 50,25 120,75' \ 22 | -fill white -draw 'circle 60,50 40,50' \ 23 | -draw 'circle 110,50 130,50' \ 24 | -draw 'rectangle 60,30 110,70' \ 25 | -gaussian 1x1 +matte logo_mask.png 26 | -} 27 | 28 | (_,mw) <- magickWand 29 | pw <- pixelWand 30 | (_,dw) <- drawingWand 31 | 32 | setSize mw 170 100 33 | mw `readImage` "xc:black" 34 | 35 | pw `setColor` "white" 36 | dw `setFillColor` pw 37 | 38 | drawCircle dw 50 50 13 50 39 | drawCircle dw 120 50 157 50 40 | drawRectangle dw 50 13 120 87 41 | 42 | pw `setColor` "black" 43 | 44 | dw `setFillColor` pw 45 | drawCircle dw 50 50 25 50 46 | drawCircle dw 50 50 25 50 47 | drawCircle dw 120 50 145 50 48 | drawRectangle dw 50 25 120 75 49 | 50 | pw `setColor` "white" 51 | dw `setFillColor` pw 52 | drawCircle dw 60 50 40 50 53 | drawCircle dw 110 50 130 50 54 | drawRectangle dw 60 30 110 70 55 | 56 | -- Now we draw the Drawing wand on to the Magick Wand 57 | mw `drawImage` dw 58 | 59 | gaussianBlurImage mw 1 1 60 | -- Turn the matte of == +matte 61 | mw `setImageMatte` False 62 | 63 | mw `writeImage` (Just "logo_mask.png") 64 | 65 | localGenesis $ do 66 | 67 | (_,mw) <- magickWand 68 | (_,mwc) <- magickWand 69 | pw <- pixelWand 70 | (_,dw) <- drawingWand 71 | {- 72 | convert ant_mask.png -fill red -draw 'color 0,0 reset' \ 73 | ant_mask.png +matte -compose CopyOpacity -composite \ 74 | -font Candice -pointsize 36 -fill white -stroke black \ 75 | -gravity Center -annotate 0 "Ant" \ 76 | ant.png 77 | -} 78 | 79 | mw `readImage` "logo_mask.png" 80 | 81 | pw `setColor` "red" 82 | dw `setFillColor` pw 83 | 84 | drawColor dw 0 0 resetMethod 85 | mw `drawImage` dw 86 | 87 | mwc `readImage` "logo_mask.png" 88 | mwc `setImageMatte` False 89 | 90 | compositeImage mw mwc copyOpacityCompositeOp 0 0 91 | 92 | -- Annotate gets all the font information from the drawingwand 93 | -- but draws the text on the magickwand 94 | -- I haven't got the Candice font so I'll use a pretty one 95 | -- that I know I have 96 | dw `setFont` "Lucida-Handwriting-Italic" 97 | dw `setFontSize` 36 98 | pw `setColor` "white" 99 | dw `setFillColor` pw 100 | 101 | pw `setColor` "black" 102 | dw `setStrokeColor` pw 103 | dw `setGravity` centerGravity 104 | annotateImage mw dw 0 0 0 "Ant" 105 | mw `writeImage` (Just "logo_ant.png") 106 | 107 | {- 108 | convert ant.png -fx A +matte -blur 0x6 -shade 110x30 -normalize \ 109 | ant.png -compose Overlay -composite \ 110 | ant.png -matte -compose Dst_In -composite \ 111 | ant_3D.png 112 | -} 113 | localGenesis $ do 114 | (_,mw) <- magickWand 115 | mw `readImage` "logo_ant.png" 116 | (_,mwf) <- fxImage mw "A" 117 | 118 | -- MagickSetImageMatte(mw,MagickFalse); 119 | -- +matte is the same as -alpha off 120 | -- mwf `setImageAlphaChannel` deactivateAlphaChannel 121 | blurImage mwf 0 6 122 | shadeImage mwf True 110 30 123 | normalizeImage mwf 124 | -- ant.png -compose Overlay -composite 125 | (_, mwc) <- magickWand 126 | mwc `readImage` "logo_ant.png" 127 | compositeImage mwf mwc overlayCompositeOp 0 0 128 | 129 | -- ant.png -matte -compose Dst_In -composite 130 | (_,mwc') <- magickWand 131 | mwc' `readImage` "logo_ant.png" 132 | -- -matte is the same as -alpha on 133 | -- I don't understand why the -matte in the command line 134 | -- does NOT operate on the image just read in (logo_ant.png in mwc) 135 | -- but on the image before it in the list 136 | -- It would appear that the -matte affects each wand currently in the 137 | -- command list because applying it to both wands gives the same result 138 | 139 | -- setImageAlphaChannel mwf setAlphaChannel 140 | -- setImageAlphaChannel mwc setAlphaChannel 141 | compositeImage mwf mwc' dstInCompositeOp 0 0 142 | 143 | writeImage mwf (Just "logo_ant_3D.png") 144 | 145 | 146 | {- Now for the shadow 147 | convert ant_3D.png \( +clone -background navy -shadow 80x4+6+6 \) +swap \ 148 | -background none -layers merge +repage ant_3D_shadowed.png 149 | -} 150 | localGenesis $ do 151 | pw <- pixelWand 152 | (_,mw) <- magickWand 153 | readImage mw "logo_ant_3D.png" 154 | 155 | (_,mwc) <- cloneMagickWand mw 156 | 157 | pw `setColor` "navy" 158 | mwc `setImageBackgroundColor` pw 159 | 160 | shadowImage mwc 80 4 6 6 161 | 162 | -- at this point 163 | -- mw = ant_3D.png 164 | -- mwc = +clone -background navy -shadow 80x4+6+6 165 | -- To do the +swap I create a new blank MagickWand and then 166 | -- put mwc and mw into it. ImageMagick probably doesn't do it 167 | -- this way but it works here and that's good enough for me! 168 | (_,mwf) <- magickWand 169 | mwf `addImage` mwc 170 | mwf `addImage` mw 171 | 172 | pw `setColor` "none" 173 | setImageBackgroundColor mwf pw 174 | (_,mwc') <- mergeImageLayers mwf mergeLayer 175 | mwc' `writeImage` (Just "logo_shadow_3D.png") 176 | 177 | 178 | {- 179 | and now for the fancy background 180 | convert ant_3D_shadowed.png \ 181 | \( +clone +repage +matte -fx 'rand()' -shade 120x30 \ 182 | -fill grey70 -colorize 60 \ 183 | -fill lavender -tint 100 \) -insert 0 \ 184 | -flatten ant_3D_bg.jpg 185 | -} 186 | localGenesis $ do 187 | pw <- pixelWand 188 | (_,mw) <- magickWand 189 | mw `readImage` "logo_shadow_3D.png" 190 | 191 | (_,mwc) <- cloneMagickWand mw 192 | -- +repage 193 | resetImagePage mwc Nothing 194 | -- +matte is the same as -alpha off 195 | -- setImageAlphaChannel mwc deactivateAlphaChannel 196 | (_, mwf) <- fxImage mwc "rand()" 197 | 198 | shadeImage mwf True 120 30 199 | setColor pw "grey70" 200 | -- It seems that this must be a separate pixelwand for Colorize to work! 201 | pwo <- pixelWand 202 | -- AHA .. this is how to do a 60% colorize 203 | pwo `setColor` "rgb(60%,60%,60%)" 204 | colorizeImage mwf pw pwo 205 | 206 | pw `setColor` "lavender" 207 | -- and this is a 100% tint 208 | pwo `setColor` "rgb(100%,100%,100%)" 209 | tintImage mwf pw pwo 210 | 211 | (_, mwc') <- magickWand 212 | mwc' `addImage` mwf 213 | mwc' `addImage` mwc 214 | 215 | (_, mwf') <- mergeImageLayers mwc flattenLayer 216 | mwf' `writeImage` (Just "logo_bg_3D.jpg") 217 | 218 | -------------------------------------------------------------------------------- /.github/workflows/haskell-ci.yml: -------------------------------------------------------------------------------- 1 | # This GitHub workflow config has been generated by a script via 2 | # 3 | # haskell-ci 'github' 'imagemagick.cabal' 4 | # 5 | # To regenerate the script (for example after adjusting tested-with) run 6 | # 7 | # haskell-ci regenerate 8 | # 9 | # For more information, see https://github.com/haskell-CI/haskell-ci 10 | # 11 | # version: 0.14.3 12 | # 13 | # REGENDATA ("0.14.3",["github","imagemagick.cabal"]) 14 | # 15 | name: Haskell-CI 16 | on: 17 | - push 18 | - pull_request 19 | jobs: 20 | linux: 21 | name: Haskell-CI - Linux - ${{ matrix.compiler }} 22 | runs-on: ubuntu-18.04 23 | timeout-minutes: 24 | 60 25 | container: 26 | image: buildpack-deps:bionic 27 | continue-on-error: ${{ matrix.allow-failure }} 28 | strategy: 29 | matrix: 30 | include: 31 | - compiler: ghc-9.2.2 32 | compilerKind: ghc 33 | compilerVersion: 9.2.2 34 | setup-method: ghcup 35 | allow-failure: false 36 | - compiler: ghc-8.10.7 37 | compilerKind: ghc 38 | compilerVersion: 8.10.7 39 | setup-method: ghcup 40 | allow-failure: false 41 | fail-fast: false 42 | steps: 43 | - name: apt 44 | run: | 45 | apt-get update 46 | apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5 47 | mkdir -p "$HOME/.ghcup/bin" 48 | curl -sL https://downloads.haskell.org/ghcup/0.1.17.5/x86_64-linux-ghcup-0.1.17.5 > "$HOME/.ghcup/bin/ghcup" 49 | chmod a+x "$HOME/.ghcup/bin/ghcup" 50 | "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" 51 | "$HOME/.ghcup/bin/ghcup" install cabal 3.6.2.0 52 | env: 53 | HCKIND: ${{ matrix.compilerKind }} 54 | HCNAME: ${{ matrix.compiler }} 55 | HCVER: ${{ matrix.compilerVersion }} 56 | - name: Set PATH and environment variables 57 | run: | 58 | echo "$HOME/.cabal/bin" >> $GITHUB_PATH 59 | echo "LANG=C.UTF-8" >> "$GITHUB_ENV" 60 | echo "CABAL_DIR=$HOME/.cabal" >> "$GITHUB_ENV" 61 | echo "CABAL_CONFIG=$HOME/.cabal/config" >> "$GITHUB_ENV" 62 | HCDIR=/opt/$HCKIND/$HCVER 63 | HC=$HOME/.ghcup/bin/$HCKIND-$HCVER 64 | echo "HC=$HC" >> "$GITHUB_ENV" 65 | echo "HCPKG=$HOME/.ghcup/bin/$HCKIND-pkg-$HCVER" >> "$GITHUB_ENV" 66 | echo "HADDOCK=$HOME/.ghcup/bin/haddock-$HCVER" >> "$GITHUB_ENV" 67 | echo "CABAL=$HOME/.ghcup/bin/cabal-3.6.2.0 -vnormal+nowrap" >> "$GITHUB_ENV" 68 | HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\d+)\.(\d+)\.(\d+)(\.(\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))') 69 | echo "HCNUMVER=$HCNUMVER" >> "$GITHUB_ENV" 70 | echo "ARG_TESTS=--enable-tests" >> "$GITHUB_ENV" 71 | echo "ARG_BENCH=--enable-benchmarks" >> "$GITHUB_ENV" 72 | echo "HEADHACKAGE=false" >> "$GITHUB_ENV" 73 | echo "ARG_COMPILER=--$HCKIND --with-compiler=$HC" >> "$GITHUB_ENV" 74 | echo "GHCJSARITH=0" >> "$GITHUB_ENV" 75 | env: 76 | HCKIND: ${{ matrix.compilerKind }} 77 | HCNAME: ${{ matrix.compiler }} 78 | HCVER: ${{ matrix.compilerVersion }} 79 | - name: env 80 | run: | 81 | env 82 | - name: write cabal config 83 | run: | 84 | mkdir -p $CABAL_DIR 85 | cat >> $CABAL_CONFIG <> $CABAL_CONFIG < cabal-plan.xz 118 | echo 'de73600b1836d3f55e32d80385acc055fd97f60eaa0ab68a755302685f5d81bc cabal-plan.xz' | sha256sum -c - 119 | xz -d < cabal-plan.xz > $HOME/.cabal/bin/cabal-plan 120 | rm -f cabal-plan.xz 121 | chmod a+x $HOME/.cabal/bin/cabal-plan 122 | cabal-plan --version 123 | - name: checkout 124 | uses: actions/checkout@v2 125 | with: 126 | path: source 127 | - name: initial cabal.project for sdist 128 | run: | 129 | touch cabal.project 130 | echo "packages: $GITHUB_WORKSPACE/source/." >> cabal.project 131 | cat cabal.project 132 | - name: sdist 133 | run: | 134 | mkdir -p sdist 135 | $CABAL sdist all --output-dir $GITHUB_WORKSPACE/sdist 136 | - name: unpack 137 | run: | 138 | mkdir -p unpacked 139 | find sdist -maxdepth 1 -type f -name '*.tar.gz' -exec tar -C $GITHUB_WORKSPACE/unpacked -xzvf {} \; 140 | - name: generate cabal.project 141 | run: | 142 | PKGDIR_imagemagick="$(find "$GITHUB_WORKSPACE/unpacked" -maxdepth 1 -type d -regex '.*/imagemagick-[0-9.]*')" 143 | echo "PKGDIR_imagemagick=${PKGDIR_imagemagick}" >> "$GITHUB_ENV" 144 | rm -f cabal.project cabal.project.local 145 | touch cabal.project 146 | touch cabal.project.local 147 | echo "packages: ${PKGDIR_imagemagick}" >> cabal.project 148 | echo "package imagemagick" >> cabal.project 149 | echo " ghc-options: -Werror=missing-methods" >> cabal.project 150 | cat >> cabal.project <> cabal.project.local 153 | cat cabal.project 154 | cat cabal.project.local 155 | - name: dump install plan 156 | run: | 157 | $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dry-run all 158 | cabal-plan 159 | - name: cache 160 | uses: actions/cache@v2 161 | with: 162 | key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }} 163 | path: ~/.cabal/store 164 | restore-keys: ${{ runner.os }}-${{ matrix.compiler }}- 165 | - name: install dependencies 166 | run: | 167 | $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --dependencies-only -j2 all 168 | $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dependencies-only -j2 all 169 | - name: build w/o tests 170 | run: | 171 | $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all 172 | - name: build 173 | run: | 174 | $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH all --write-ghc-environment-files=always 175 | - name: tests 176 | run: | 177 | $CABAL v2-test $ARG_COMPILER $ARG_TESTS $ARG_BENCH all --test-show-details=direct 178 | - name: cabal check 179 | run: | 180 | cd ${PKGDIR_imagemagick} || false 181 | ${CABAL} -vnormal check 182 | - name: haddock 183 | run: | 184 | $CABAL v2-haddock $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH all 185 | - name: unconstrained build 186 | run: | 187 | rm -f cabal.project.local 188 | $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all 189 | -------------------------------------------------------------------------------- /examples/affine.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | -- | Example taken from: http://members.shaw.ca/el.supremo/MagickWand/affine.htm 4 | {- 5 | Originally inspired by: 6 | http://www.imagemagick.org/discourse-server/viewtopic.php?f=2&t=12530 7 | The idea for these specific examples came from reading this: 8 | http://www.csl.mtu.edu/cs4611/www/HillLectureNotes/CS4611%202D%20Affine%20Transformation.htm 9 | When reading that (and other web pages about affine) keep in mind 10 | that IM's ordering of the affine matrix as described at: 11 | http://imagemagick.org/script/command-line-options.php#affine 12 | orders the affine values and their multiplication like this: 13 | [x y 1] |sx rx 0| 14 | |ry sy 0| 15 | |tx ty 1| 16 | 17 | Whereas the CS4611 web page uses this (which, if nothing else, is tidier): 18 | |sx ry tx| |x| 19 | |rx sy ty| |y| 20 | |0 0 1 | |1| 21 | 22 | My multiplication routine is written to conform to the way IM 23 | specifies things. 24 | 25 | ALSO, I think there are a couple of errors on the CS4611 page. 26 | 1. In the example of rotation about a point, it says that first 27 | translate by V, then rotate, then translate by -V. 28 | But the matrix representation of this does -V,rotate,V. 29 | 2. Reflection across the x-axis is not correct as shown. 30 | When a point (x,y) is reflected across the x-axis its 31 | new coordinate is (x,-y) - the matrix shown in the example 32 | actually reflects across the y-axis - i.e. it produces (-x,y). 33 | -} 34 | 35 | import Data.Fixed (mod') 36 | import Graphics.ImageMagick.MagickWand 37 | 38 | -- typesafe angle logic could be imported form AC-Angle package 39 | 40 | -- | Convert from degrees to radians. 41 | radians :: Double -> Double 42 | radians x = x / 180 * pi 43 | 44 | -- | Convert from radians to degrees. 45 | degrees :: Double -> Double 46 | degrees x = x * 180 / pi 47 | 48 | -- Set the affine array to translate by (x,y) 49 | -- Set the affine array to scale the image by sx,sy 50 | translate_affine :: (Floating x) => x -> x -> [x] 51 | translate_affine x y = 52 | [ 1, 0, 0, 53 | 1, x, y ] 54 | 55 | -- Set the affine array to scale the image by sx,sy 56 | scale_affine :: (Floating x) => x -> x -> [x] 57 | scale_affine sx sy = 58 | [ sx, 0, 0, 59 | sy, 0, 0 ] 60 | 61 | -- get the affine array to rotate image by 'degrees' clockwise 62 | rotate_affine :: Double -> [Double] 63 | rotate_affine angle = 64 | [ cos (radians (angle `mod'` 360)), sin (radians (angle `mod'` 360)), -sin (radians (angle `mod'` 360)), 65 | cos (radians (angle `mod'` 360)), 0, 0 ] 66 | 67 | -- Multiply two affine arrays and return the result. 68 | affine_multiply :: (Floating x) => [x] -> [x] -> [x] 69 | affine_multiply [a0,a1,a2,a3,a4,a5] [b0,b1,b2,b3,b4,b5] = 70 | [ a0*b0 + a1*b2, a0*b1 + a1*b3, 71 | a2*b0 + a3*b2, a2*b1 + a3*b3, 72 | a4*b0 + a5*b2 + b4, a4*b1 + a5*b3 + b5 ] 73 | affine_multiply _ _ = error "incorrect list sizes" 74 | 75 | main :: IO () 76 | main = withMagickWandGenesis $ do 77 | -- Remember that these operations are done with respect to the 78 | -- origin of the image which is the TOP LEFT CORNER. 79 | localGenesis $ do 80 | -- Example 1. 81 | -- Rotate logo: by 90 degrees (about the origin), scale by 50 percent and 82 | -- then move the image 240 in the x direction 83 | -- TODO: fix problem with 'leaky' pixel 84 | (_,mw) <- magickWand 85 | readImage mw "logo:" 86 | -- Set up the affine matrices 87 | -- rotate 90 degrees clockwise 88 | let 89 | r = rotate_affine 90 90 | -- scale by .5 in x and y 91 | s = scale_affine 0.5 0.5 92 | -- translate to (240,0) 93 | t = translate_affine 240 0 94 | -- now multiply them - note the order in 95 | -- which they are specified - in particular beware that 96 | -- temp = r*s is NOT necessarily the same as temp = s*r 97 | 98 | --first do the rotation and scaling 99 | -- temp = r*s 100 | temp = r `affine_multiply` s 101 | -- now the translation 102 | -- result = temp*t; 103 | result = temp `affine_multiply` t 104 | 105 | -- and then apply the result to the image 106 | distortImage mw affineProjectionDistortion result False 107 | 108 | writeImage mw (Just "logo_affine_1.jpg") 109 | 110 | localGenesis $ do 111 | -- Example 2 112 | -- Rotate logo: 30 degrees around the point (300,100) 113 | -- Since rotation is done around the origin, we must translate 114 | -- the point (300,100) up to the origin, do the rotation, and 115 | -- then translate back again 116 | (_,mw) <- magickWand 117 | readImage mw "logo:" 118 | 119 | let 120 | -- Initialize the required affines 121 | -- translate (300,100) to origin 122 | t1 = translate_affine (-300) (-100) 123 | -- rotate clockwise by 30 degrees 124 | r = rotate_affine 30 125 | -- translate back again 126 | t2 = translate_affine 300 100 127 | -- Now multiply the affine sequence 128 | -- temp = t1*r 129 | temp = t1 `affine_multiply` r 130 | -- result = temp*t2; 131 | result = temp `affine_multiply` t2 132 | 133 | distortImage mw affineProjectionDistortion result False 134 | 135 | writeImage mw (Just "logo_affine_2.jpg") 136 | 137 | localGenesis $ do 138 | -- Example 3 139 | -- Reflect the image about a line passing through the origin. 140 | -- If the line makes an angle of D degrees with the horizontal 141 | -- then this can be done by rotating the image by -D degrees so 142 | -- that the line is now (in effect) the x axis, reflect the image 143 | -- across the x axis, and then rotate everything back again. 144 | -- In this example, rather than just picking an arbitrary angle, 145 | -- let's say that we want the "logo:" image to be reflected across 146 | -- it's own major diagonal. Although we know the logo: image is 147 | -- 640x480 let's also generalize the code slightly so that it 148 | -- will still work if the name of the input image is changed. 149 | -- If the image has a width "w" and height "h", then the angle between 150 | -- the x-axis and the major diagonal is atan(h/w) (NOTE that this 151 | -- result is in RADIANS!) 152 | -- For this example I will also retain the original dimensions of the 153 | -- image so that anything that is reflected outside the borders of the 154 | -- input image is lost 155 | (_,mw) <- magickWand 156 | readImage mw "logo:" 157 | w <- getImageWidth mw 158 | h <- getImageHeight mw 159 | 160 | let 161 | -- Just convert the radians to degrees. This way I don't have 162 | -- to write a function which sets up an affine rotation for an 163 | -- argument specified in radians rather than degrees. 164 | -- You can always change this. 165 | angle_degrees = degrees(atan(realToFrac(h) / realToFrac(w))) 166 | -- Initialize the required affines 167 | -- Rotate diagonal to the x axis 168 | r1 = rotate_affine (-angle_degrees) 169 | -- Reflection affine (about x-axis) 170 | -- In this case there isn't a specific function to set the 171 | -- affine array (like there is for rotation and scaling) 172 | -- so use the function which sets an arbitrary affine 173 | reflect = [ 1, 0, 0, 174 | -1, 0, 0 ] 175 | -- rotate image back again 176 | r2 = rotate_affine angle_degrees 177 | -- temp = r1*reflect 178 | temp = r1 `affine_multiply` reflect 179 | -- result = temp*r2; 180 | result = temp `affine_multiply` r2 181 | 182 | distortImage mw affineProjectionDistortion result False 183 | 184 | writeImage mw (Just "logo_affine_3.jpg") 185 | 186 | localGenesis $ do 187 | -- Example 4 188 | -- Create a rotated gradient 189 | -- See: http:--www.imagemagick.org/discourse-server/viewtopic.php?f=1&t=12707 190 | -- The affine in this one is essentially the same as the one in Example 2 but 191 | -- this example has a different use for the result 192 | let 193 | -- Dimensions of the final rectangle 194 | w = 600 :: Int 195 | h = 100 :: Int 196 | -- angle of clockwise rotation 197 | theta = 15 -- degrees 198 | -- Convert theta to radians 199 | rad_theta = radians theta 200 | -- Compute the dimensions of the rectangular gradient 201 | -- Don't let the rotation make the gradient rectangle any smaller 202 | -- than the required output (using `max`) 203 | gw = max w $ round (fromIntegral w * cos rad_theta + fromIntegral h * sin rad_theta + 0.5) 204 | gh = max h $ round (fromIntegral w * sin rad_theta + fromIntegral h * cos rad_theta + 0.5) 205 | 206 | (_,mw) <- magickWand 207 | setSize mw gw gh 208 | readImage mw "gradient:white-black" 209 | 210 | let 211 | -- Initialize the required affines 212 | -- translate centre of gradient to origin 213 | t1 = translate_affine (- fromIntegral gw / 2) (- fromIntegral gh / 2) 214 | -- rotate clockwise by theta degrees 215 | r = rotate_affine(theta) 216 | -- translate back again 217 | t2 = translate_affine (fromIntegral gw / 2) (fromIntegral gh / 2) 218 | -- Now multiply the affine sequences 219 | -- temp = t1*r 220 | temp = t1 `affine_multiply` r 221 | -- result = temp*t2; 222 | result = temp `affine_multiply` t2 223 | 224 | distortImage mw affineProjectionDistortion result False 225 | -- Get the size of the distorted image and crop out the middle 226 | nw <- getImageWidth mw 227 | nh <- getImageHeight mw 228 | cropImage mw w h ((nw - w) `div` 2) ((nh - h) `div` 2) 229 | writeImage mw (Just "rotgrad_2.png") 230 | 231 | 232 | 233 | -------------------------------------------------------------------------------- /src/Graphics/ImageMagick/MagickWand/PixelWand.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | module Graphics.ImageMagick.MagickWand.PixelWand 3 | ( pixelWand 4 | -- , clearPixelWand 5 | -- , cloneWand 6 | -- , cloneWands 7 | , isPixelWandSimilar 8 | -- , isPixelWand 9 | , setColorCount, getColorCount 10 | -- ** Literal names 11 | , setColor 12 | , getColorAsString, getColorAsNormalizedString 13 | -- HSL 14 | , getHSL, setHSL 15 | , getMagickColor, setMagickColor 16 | , setColorFromWand 17 | , getQuantumColor, setQuantumColor 18 | -- ** Color parts 19 | -- Index 20 | , getIndex, setIndex 21 | -- Fuzz 22 | , getFuzz, setFuzz 23 | -- Alpha 24 | , getOpacity, getOpacityQuantum, setOpacity, setOpacityQuantum 25 | , getAlpha, getAlphaQuantum, setAlpha, setAlphaQuantum 26 | -- RGB 27 | , getRed, getRedQuantum, setRed, setRedQuantum 28 | , getBlue, getBlueQuantum, setBlue, setBlueQuantum 29 | , getGreen, getGreenQuantum, setGreen, setGreenQuantum 30 | -- CMYK 31 | , getCyan, getCyanQuantum, setCyan, setCyanQuantum 32 | , getMagenta, getMagentaQuantum, setMagenta, setMagentaQuantum 33 | , getYellow, getYellowQuantum, setYellow, setYellowQuantum 34 | , getBlack, getBlackQuantum, setBlack, setBlackQuantum 35 | ) where 36 | 37 | import Control.Monad (void) 38 | import Control.Monad.IO.Class 39 | import Control.Monad.Trans.Resource 40 | import Data.ByteString (ByteString, 41 | packCString, 42 | useAsCString) 43 | import Foreign hiding (void) 44 | import Foreign.C.Types (CDouble) 45 | 46 | import qualified Graphics.ImageMagick.MagickWand.FFI.PixelWand as F 47 | import Graphics.ImageMagick.MagickWand.Types 48 | import Graphics.ImageMagick.MagickWand.Utils 49 | 50 | pixelWand :: (MonadResource m) => m PPixelWand 51 | pixelWand = fmap snd (allocate F.newPixelWand destroy) 52 | where destroy = void . F.destroyPixelWand 53 | 54 | setColor :: (MonadResource m) => PPixelWand -> ByteString -> m () 55 | setColor p s = withException_ p $ useAsCString s (F.pixelSetColor p) 56 | 57 | 58 | getMagickColor :: (MonadResource m) => PPixelWand -> m PMagickPixelPacket 59 | getMagickColor w = liftIO $ do 60 | p <- mallocForeignPtr 61 | withForeignPtr p (F.pixelGetMagickColor w) 62 | return p 63 | 64 | setMagickColor :: (MonadResource m) => PPixelWand -> PMagickPixelPacket -> m () 65 | setMagickColor w p = liftIO $ withForeignPtr p (F.pixelSetMagickColor w) 66 | 67 | setColorCount :: (MonadResource m) => PPixelWand -> Int -> m () 68 | setColorCount w i = liftIO $ F.pixelSetColorCount w (fromIntegral i) 69 | 70 | getColorCount :: (MonadResource m) => PPixelWand -> m Int 71 | getColorCount w = liftIO (F.pixelGetColorCount w) >>= return . fromIntegral 72 | 73 | getColorAsString :: (MonadResource m) => PPixelWand -> m ByteString 74 | getColorAsString w = liftIO $ F.pixelGetColorAsString w >>= packCString 75 | 76 | getColorAsNormalizedString :: (MonadResource m) => PPixelWand -> m ByteString 77 | getColorAsNormalizedString w = liftIO $ F.pixelGetColorAsNormalizedString w >>= packCString 78 | 79 | getHSL :: (MonadResource m) => PPixelWand -> m (Double, Double, Double) 80 | getHSL w = liftIO $ fmap (map3 realToFrac) (with3 (F.pixelGetHSL w)) 81 | 82 | setHSL :: (MonadResource m) => PPixelWand -> Double -> Double -> Double -> m () 83 | setHSL w h s l = liftIO $ F.pixelSetHSL w (realToFrac h) (realToFrac s) (realToFrac l) 84 | 85 | setColorFromWand :: (MonadResource m) => PPixelWand -> PPixelWand -> m () 86 | setColorFromWand = (liftIO .). F.pixelSetColorFromWand 87 | 88 | getIndex :: (MonadResource m) => PPixelWand -> m IndexPacket 89 | getIndex = liftIO . F.pixelGetIndex 90 | 91 | setIndex :: (MonadResource m) => PPixelWand -> IndexPacket -> m () 92 | setIndex w i = liftIO $ F.pixelSetIndex w i 93 | 94 | getQuantumColor :: (MonadResource m) => PPixelWand -> m PPixelPacket 95 | getQuantumColor w = liftIO $ do 96 | p <- mallocForeignPtr 97 | withForeignPtr p (F.pixelGetQuantumColor w) 98 | return p 99 | 100 | setQuantumColor :: (MonadResource m) => PPixelWand -> PPixelPacket -> m () 101 | setQuantumColor w p = liftIO $ withForeignPtr p (F.pixelSetQuantumColor w) 102 | 103 | getFuzz :: (MonadResource m) => PPixelWand -> m Double 104 | getFuzz = liftIO . ((fmap realToFrac) . F.pixelGetFuzz) 105 | 106 | setFuzz :: (MonadResource m) => PPixelWand -> Double -> m () 107 | setFuzz w i = liftIO $ F.pixelSetFuzz w (realToFrac i) 108 | 109 | isPixelWandSimilar :: (MonadResource m) => PPixelWand -> PPixelWand -> Double -> m Bool 110 | isPixelWandSimilar pw1 pw2 fuzz = fromMBool $ F.isPixelWandSimilar pw1 pw2 (realToFrac fuzz) 111 | 112 | setRedQuantum :: (MonadResource m) => PPixelWand -> Quantum -> m () 113 | setRedQuantum = (liftIO .) . F.pixelSetRedQuantum 114 | 115 | getRed :: (MonadResource m) => PPixelWand -> m Double 116 | getRed = (fmap realToFrac) . liftIO . F.pixelGetRed 117 | 118 | setRed :: (MonadResource m) => PPixelWand -> Double -> m () 119 | setRed = (liftIO .) . (. realToFrac) . F.pixelSetRed 120 | 121 | getRedQuantum :: (MonadResource m) => PPixelWand -> m Quantum 122 | getRedQuantum = liftIO . F.pixelGetRedQuantum 123 | 124 | setGreenQuantum :: (MonadResource m) => PPixelWand -> Quantum -> m () 125 | setGreenQuantum = (liftIO .) . F.pixelSetGreenQuantum 126 | 127 | getGreen :: (MonadResource m) => PPixelWand -> m Double 128 | getGreen = (fmap realToFrac) . liftIO . F.pixelGetGreen 129 | 130 | setGreen :: (MonadResource m) => PPixelWand -> Double -> m () 131 | setGreen = (liftIO .) . (. realToFrac) . F.pixelSetGreen 132 | 133 | getGreenQuantum :: (MonadResource m) => PPixelWand -> m Quantum 134 | getGreenQuantum = liftIO . F.pixelGetGreenQuantum 135 | 136 | setBlueQuantum :: (MonadResource m) => PPixelWand -> Quantum -> m () 137 | setBlueQuantum = (liftIO .) . F.pixelSetBlueQuantum 138 | 139 | getBlue :: (MonadResource m) => PPixelWand -> m Double 140 | getBlue = (fmap realToFrac) . liftIO . F.pixelGetBlue 141 | 142 | setBlue :: (MonadResource m) => PPixelWand -> Double -> m () 143 | setBlue = (liftIO .) . (. realToFrac) . F.pixelSetBlue 144 | 145 | getBlueQuantum :: (MonadResource m) => PPixelWand -> m Quantum 146 | getBlueQuantum = liftIO . F.pixelGetBlueQuantum 147 | 148 | setAlphaQuantum :: (MonadResource m) => PPixelWand -> Quantum -> m () 149 | setAlphaQuantum = (liftIO .) . F.pixelSetAlphaQuantum 150 | 151 | getAlphaQuantum :: (MonadResource m) => PPixelWand -> m Quantum 152 | getAlphaQuantum = liftIO . F.pixelGetAlphaQuantum 153 | 154 | setAlpha :: (MonadResource m) => PPixelWand -> Double -> m () 155 | setAlpha = (liftIO .) . (. realToFrac) . F.pixelSetAlpha 156 | 157 | getAlpha :: (MonadResource m) => PPixelWand -> m Double 158 | getAlpha = (fmap realToFrac) . liftIO . F.pixelGetAlpha 159 | 160 | setOpacityQuantum :: (MonadResource m) => PPixelWand -> Quantum -> m () 161 | setOpacityQuantum = (liftIO .) . F.pixelSetOpacityQuantum 162 | 163 | getOpacityQuantum :: (MonadResource m) => PPixelWand -> m Quantum 164 | getOpacityQuantum = liftIO . F.pixelGetOpacityQuantum 165 | 166 | setOpacity :: (MonadResource m) => PPixelWand -> Double -> m () 167 | setOpacity = (liftIO .) . (. realToFrac) . F.pixelSetOpacity 168 | 169 | getOpacity :: (MonadResource m) => PPixelWand -> m Double 170 | getOpacity = (fmap realToFrac) . liftIO . F.pixelGetOpacity 171 | 172 | setBlackQuantum :: (MonadResource m) => PPixelWand -> Quantum -> m () 173 | setBlackQuantum = (liftIO .) . F.pixelSetBlackQuantum 174 | 175 | getBlackQuantum :: (MonadResource m) => PPixelWand -> m Quantum 176 | getBlackQuantum = liftIO . F.pixelGetBlackQuantum 177 | 178 | setBlack :: (MonadResource m) => PPixelWand -> Double -> m () 179 | setBlack = (liftIO .) . (. realToFrac) . F.pixelSetBlack 180 | 181 | getBlack :: (MonadResource m) => PPixelWand -> m Double 182 | getBlack = (fmap realToFrac) . liftIO . F.pixelGetBlack 183 | 184 | setCyanQuantum :: (MonadResource m) => PPixelWand -> Quantum -> m () 185 | setCyanQuantum = (liftIO .) . F.pixelSetCyanQuantum 186 | 187 | getCyanQuantum :: (MonadResource m) => PPixelWand -> m Quantum 188 | getCyanQuantum = liftIO . F.pixelGetCyanQuantum 189 | 190 | setCyan :: (MonadResource m) => PPixelWand -> Double -> m () 191 | setCyan = (liftIO .) . (. realToFrac) . F.pixelSetCyan 192 | 193 | getCyan :: (MonadResource m) => PPixelWand -> m Double 194 | getCyan = (fmap realToFrac) . liftIO . F.pixelGetCyan 195 | 196 | setMagentaQuantum :: (MonadResource m) => PPixelWand -> Quantum -> m () 197 | setMagentaQuantum = (liftIO .) . F.pixelSetMagentaQuantum 198 | 199 | getMagentaQuantum :: (MonadResource m) => PPixelWand -> m Quantum 200 | getMagentaQuantum = liftIO . F.pixelGetMagentaQuantum 201 | 202 | setMagenta :: (MonadResource m) => PPixelWand -> Double -> m () 203 | setMagenta = (liftIO .) . (. realToFrac) . F.pixelSetMagenta 204 | 205 | getMagenta :: (MonadResource m) => PPixelWand -> m Double 206 | getMagenta = (fmap realToFrac) . liftIO . F.pixelGetMagenta 207 | 208 | setYellowQuantum :: (MonadResource m) => PPixelWand -> Quantum -> m () 209 | setYellowQuantum = (liftIO .) . F.pixelSetYellowQuantum 210 | 211 | getYellowQuantum :: (MonadResource m) => PPixelWand -> m Quantum 212 | getYellowQuantum = liftIO . F.pixelGetYellowQuantum 213 | 214 | setYellow :: (MonadResource m) => PPixelWand -> Double -> m () 215 | setYellow = (liftIO .) . (. realToFrac) . F.pixelSetYellow 216 | 217 | getYellow :: (MonadResource m) => PPixelWand -> m Double 218 | getYellow = (fmap realToFrac) . liftIO . F.pixelGetYellow 219 | 220 | --- 221 | with3 :: 222 | (Ptr CDouble -> Ptr CDouble -> Ptr CDouble -> IO ()) 223 | -> IO (CDouble, CDouble, CDouble) 224 | with3 f = alloca (\x -> alloca (\y -> alloca (\z -> do 225 | _ <- f x y z 226 | x' <- peek x 227 | y' <- peek y 228 | z' <- peek z 229 | return (x',y',z') 230 | ))) 231 | 232 | map3 :: (a -> b) -> (a, a, a) -> (b, b, b) 233 | map3 f (a,b,c) = (f a, f b, f c) 234 | -------------------------------------------------------------------------------- /examples/text_effects.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleContexts #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | -- | Example taken from: http://members.shaw.ca/el.supremo/MagickWand/text_effects.htm 4 | {- There's no equivalent convert command for this. It is a demo of MagickWand. 5 | See this forum thread for the genesis of these effects 6 | http://www.imagemagick.org/discourse-server/viewtopic.php?f=6&t=11586 7 | and Anthony's Text Effects page at: 8 | http://www.imagemagick.org/Usage/fonts/ 9 | -} 10 | 11 | import Control.Monad (when) 12 | import Control.Monad.IO.Class (MonadIO) 13 | import Control.Monad.Trans.Resource 14 | import Data.ByteString (ByteString) 15 | import Data.Text (Text) 16 | import qualified Data.Text as T 17 | import Graphics.ImageMagick.MagickCore.Types 18 | import Graphics.ImageMagick.MagickWand 19 | 20 | -- see http://www.imagemagick.org/Usage/#font about using fonts with IM 21 | font :: ByteString 22 | font = "VerdanaBI" 23 | 24 | -- Text effect 1 - shadow effect using MagickShadowImage 25 | -- This is derived from Anthony's Soft Shadow effect 26 | -- convert -size 300x100 xc:none -font Candice -pointsize 72 \ 27 | -- -fill white -stroke black -annotate +25+65 'Anthony' \ 28 | -- \( +clone -background navy -shadow 70x4+5+5 \) +swap \ 29 | -- -background lightblue -flatten -trim +repage font_shadow_soft.jpg 30 | 31 | -- NOTE - if an image has a transparent background, adding a border of any colour other 32 | -- than "none" will remove all the transparency and replace it with the border's colour 33 | textEffect1 :: (MonadResource m) => PMagickWand -> PDrawingWand -> PPixelWand -> m () 34 | textEffect1 w dw pw = do 35 | pw `setColor` "none" 36 | -- Create a new transparent image 37 | newImage w 350 100 pw 38 | -- Set up a 72 point white font 39 | pw `setColor` "white" 40 | dw `setFillColor` pw 41 | dw `setFont` font 42 | dw `setFontSize` 72 43 | -- Add a black outline to the text 44 | pw `setColor` "black" 45 | dw `setStrokeColor` pw 46 | -- Turn antialias on - not sure this makes a difference 47 | dw `setTextAntialias` True 48 | -- Now draw the text 49 | drawAnnotation dw 25 65 "Magick" 50 | -- Draw the image on to the magick_wand 51 | drawImage w dw 52 | 53 | -- Trim the image down to include only the text 54 | trimImage w 0 55 | -- equivalent to the command line +repage 56 | resetImagePage w Nothing 57 | 58 | -- Make a copy of the text image 59 | (_,cloneW) <- cloneMagickWand w 60 | -- Set the background colour to blue for the shadow 61 | pw `setColor` "blue" 62 | w `setImageBackgroundColor` pw 63 | 64 | -- Opacity is a real number indicating (apparently) percentage 65 | shadowImage w 70 4 5 5 66 | 67 | -- Composite the text on top of the shadow 68 | compositeImage w cloneW overCompositeOp 5 5 69 | 70 | (_,w') <- magickWand 71 | -- Create a new image the same size as the text image and put a solid colour 72 | -- as its background 73 | pw `setColor` "rgb(125,215,255)" 74 | width <- getImageWidth w 75 | height <- getImageHeight w 76 | newImage w' width height pw 77 | -- Now composite the shadowed text over the plain background 78 | compositeImage w' w overCompositeOp 0 0 79 | -- and write the result 80 | writeImage w' (Just "text_shadow.png") 81 | 82 | 83 | -- Given a pattern name (which MUST have a leading #) and a pattern file, 84 | -- set up a pattern URL for later reference in the specified drawing wand 85 | -- Currently only used in Text Effect 2 86 | setTilePattern :: (MonadResource m) => PDrawingWand -> Text -> FilePath -> m () 87 | setTilePattern dw patternName patternFile = do 88 | (_,w) <- magickWand 89 | readImage w (T.pack patternFile) 90 | -- Read the tile's width and height 91 | width <- getImageWidth w 92 | height <- getImageHeight w 93 | 94 | pushPattern dw (T.tail patternName) 0 0 (realToFrac width) (realToFrac height) 95 | drawComposite dw srcOverCompositeOp 0 0 0 0 w 96 | popPattern dw 97 | dw `setFillPatternURL` patternName 98 | 99 | 100 | -- Text effect 2 - tiled text using the builtin checkerboard pattern 101 | -- Anthony's Tiled Font effect 102 | -- convert -size 320x100 xc:lightblue -font Candice -pointsize 72 \ 103 | -- -tile pattern:checkerboard -annotate +28+68 'Anthony' \ 104 | -- font_tile.jpg 105 | textEffect2 :: (MonadResource m) => PMagickWand -> PDrawingWand -> PPixelWand -> m () 106 | textEffect2 w dw pw = do 107 | setTilePattern dw "#check" "pattern:checkerboard" 108 | 109 | pw `setColor` "lightblue" 110 | -- Create a new transparent image 111 | newImage w 320 100 pw 112 | 113 | -- Set up a 72 point font 114 | dw `setFont` font 115 | dw `setFontSize` 72 116 | -- Now draw the text 117 | drawAnnotation dw 28 68 "Magick" 118 | -- Draw the image on to the magick_wand 119 | drawImage w dw 120 | -- Trim the image 121 | trimImage w 0 122 | -- Add a transparent border 123 | pw `setColor` "lightblue" 124 | borderImage w pw 5 5 125 | -- and write it 126 | writeImage w (Just "text_pattern.png") 127 | 128 | -- Text effect 3 - arc font (similar to http://www.imagemagick.org/Usage/fonts/#arc) 129 | -- convert -size 320x100 xc:lightblue -font Candice -pointsize 72 \ 130 | -- -annotate +25+65 'Anthony' -distort Arc 120 \ 131 | -- -trim +repage -bordercolor lightblue -border 10 font_arc.jpg 132 | textEffect3 :: (MonadResource m) => PMagickWand -> PDrawingWand -> PPixelWand -> m () 133 | textEffect3 w dw pw = do 134 | -- Create a 320x100 lightblue canvas 135 | pw `setColor` "lightblue" 136 | newImage w 320 100 pw 137 | 138 | -- Set up a 72 point font 139 | dw `setFont` font 140 | dw `setFontSize` 72 141 | -- Now draw the text 142 | drawAnnotation dw 25 65 "Magick" 143 | -- Draw the image on to the magick_wand 144 | drawImage w dw 145 | 146 | let dargs = [120] 147 | distortImage w arcDistortion dargs False 148 | -- Trim the image 149 | trimImage w 0 150 | -- Add the border 151 | pw `setColor` "lightblue" 152 | borderImage w pw 10 10 153 | 154 | -- and write it 155 | writeImage w (Just "text_arc.png") 156 | 157 | 158 | -- Text effect 4 - bevelled font http://www.imagemagick.org/Usage/fonts/#bevel 159 | -- convert -size 320x100 xc:black -font Candice -pointsize 72 \ 160 | -- -fill white -annotate +25+65 'Anthony' \ 161 | -- -shade 140x60 font_beveled.jpg 162 | textEffect4 :: (MonadResource m) => PMagickWand -> PDrawingWand -> PPixelWand -> m () 163 | textEffect4 w dw pw = do 164 | let colorize = False 165 | -- Create a 320x100 canvas 166 | pw `setColor` "gray" 167 | newImage w 320 100 pw 168 | -- Set up a 72 point font 169 | dw `setFont` font 170 | dw `setFontSize` 72 171 | -- Set up a 72 point white font 172 | pw `setColor` "white" 173 | dw `setFillColor` pw 174 | -- Now draw the text 175 | drawAnnotation dw 25 65 "Magick" 176 | -- Draw the image on to the magick_wand 177 | drawImage w dw 178 | -- the "gray" parameter must be true to get the effect shown on Anthony's page 179 | shadeImage w True 140 60 180 | 181 | when colorize $ do 182 | pw `setColor` "yellow" 183 | dw `setFillColor` pw 184 | pw' <- pixelWand 185 | pw' `setColor` "gold" 186 | colorizeImage w pw pw' 187 | 188 | -- and write it 189 | writeImage w (Just "text_bevel.png") 190 | 191 | 192 | -- Text effect 5 and 6 - Plain text and then Barrel distortion 193 | textEffects5_6 :: (MonadResource m) => PMagickWand -> PDrawingWand -> PPixelWand -> m () 194 | textEffects5_6 w dw pw = do 195 | -- Create a 320x100 transparent canvas 196 | pw `setColor` "none" 197 | newImage w 320 100 pw 198 | 199 | -- Set up a 72 point font 200 | dw `setFont` font 201 | dw `setFontSize` 72 202 | -- Now draw the text 203 | drawAnnotation dw 25 65 "Magick" 204 | -- Draw the image on to the magick_wand 205 | drawImage w dw 206 | writeImage w (Just"text_plain.png") 207 | 208 | -- Trim the image 209 | trimImage w 0 210 | -- Add the border 211 | pw `setColor` "none" 212 | borderImage w pw 10 10 213 | -- MagickSetImageMatte(magick_wand,MagickTrue); 214 | -- MagickSetImageVirtualPixelMethod(magick_wand,TransparentVirtualPixelMethod); 215 | -- d_args[0] = 0.1;d_args[1] = -0.25;d_args[2] = -0.25; [3] += .1 216 | -- The first value should be positive. If it is negative the image is *really* distorted 217 | -- d_args[0] = 0.0; 218 | -- d_args[1] = 0.0; 219 | -- d_args[2] = 0.5; 220 | -- d_args[3] should normally be chosen such the sum of all 4 values is 1 221 | -- so that the result is the same size as the original 222 | -- You can override the sum with a different value 223 | -- If the sum is greater than 1 the resulting image will be smaller than the original 224 | -- d_args[3] = 1 - (d_args[0] + d_args[1] + d_args[2]); 225 | -- Make the result image smaller so that it isn't as likely 226 | -- to overflow the edges 227 | -- d_args[3] += 0.1; 228 | -- 0.0,0.0,0.5,0.5,0.0,0.0,-0.5,1.9 229 | -- d_args[3] = 0.5; 230 | -- d_args[4] = 0.0; 231 | -- d_args[5] = 0.0; 232 | -- d_args[6] = -0.5; 233 | -- d_args[7] = 1.9; 234 | 235 | let d_args = [0, 0, 0.5, 1 - (0 + 0 + 0.5), 0, 0, -0.5, 1.9] 236 | -- DON'T FORGET to set the correct number of arguments here 237 | distortImage w barrelDistortion d_args True 238 | -- MagickResetImagePage(magick_wand,""); 239 | -- Trim the image again 240 | trimImage w 0 241 | -- Add the border 242 | pw `setColor` "none" 243 | borderImage w pw 10 10 244 | -- and write it 245 | writeImage w (Just "text_barrel.png") 246 | 247 | -- Text effect 7 - Polar distortion 248 | textEffect7 :: (MonadResource m) => PMagickWand -> PDrawingWand -> PPixelWand -> m () 249 | textEffect7 w dw pw = do 250 | -- Create a 320x200 transparent canvas 251 | pw `setColor` "none" 252 | newImage w 320 200 pw 253 | 254 | -- Set up a 72 point font 255 | dw `setFont` font 256 | dw `setFontSize` 72 257 | -- Now draw the text 258 | drawAnnotation dw 25 65 "Magick" 259 | -- Draw the image on to the magick_wand 260 | drawImage w dw 261 | 262 | distortImage w polarDistortion [0] True 263 | -- MagickResetImagePage(magick_wand,""); 264 | -- Trim the image again 265 | trimImage w 0 266 | -- Add the border 267 | pw `setColor` "none" 268 | borderImage w pw 10 10 269 | -- and write it 270 | writeImage w (Just "text_polar.png") 271 | 272 | -- Text effect 8 - Shepard's distortion 273 | textEffect8 :: (MonadResource m) => PMagickWand -> PDrawingWand -> PPixelWand -> m () 274 | textEffect8 w dw pw = do 275 | -- Create a 320x200 transparent canvas 276 | pw `setColor` "none" 277 | newImage w 640 480 pw 278 | 279 | -- Set up a 72 point font 280 | dw `setFont` font 281 | dw `setFontSize` 72 282 | -- Now draw the text 283 | drawAnnotation dw 50 240 "Magick Rocks" 284 | -- Draw the image on to the magick_wand 285 | drawImage w dw 286 | let d_args = [ 150.0, 190.0, 100.0, 290.0, 500.0, 200.0, 430.0, 130.0 ] 287 | distortImage w shepardsDistortion d_args True 288 | 289 | -- Trim the image 290 | trimImage w 0 291 | -- Add the border 292 | pw `setColor` "none" 293 | borderImage w pw 10 10 294 | -- and write it 295 | writeImage w (Just "text_shepards.png") 296 | 297 | runEffect :: (MonadIO m, MonadThrow m, MonadBaseControl IO m) => 298 | (PMagickWand -> PDrawingWand -> PPixelWand -> ResourceT m ()) -> m () 299 | runEffect e = localGenesis $ do 300 | (_,w) <- magickWand 301 | (_,dw) <- drawingWand 302 | pw <- pixelWand 303 | e w dw pw 304 | 305 | main :: IO () 306 | main = withMagickWandGenesis $ do 307 | runEffect textEffect1 308 | runEffect textEffect2 309 | runEffect textEffect3 310 | runEffect textEffect4 311 | runEffect textEffects5_6 312 | runEffect textEffect7 313 | runEffect textEffect8 314 | -------------------------------------------------------------------------------- /src/Graphics/ImageMagick/MagickWand/FFI/PixelWand.hsc: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE ForeignFunctionInterface #-} 3 | 4 | module Graphics.ImageMagick.MagickWand.FFI.PixelWand 5 | where 6 | 7 | import Foreign 8 | import Foreign.C.String 9 | import Foreign.C.Types 10 | 11 | import Graphics.ImageMagick.MagickCore.Types 12 | import Graphics.ImageMagick.MagickWand.FFI.Types 13 | 14 | #include 15 | 16 | -- | DestroyPixelWand() deallocates resources associated with a PixelWand. 17 | 18 | foreign import ccall "DestroyPixelWand" destroyPixelWand 19 | :: Ptr PixelWand -> IO (Ptr PixelWand) 20 | 21 | foreign import ccall "DestroyPixelWands" destroyPixelWands 22 | :: Ptr PixelWand -> CSize -> IO () 23 | 24 | foreign import ccall "IsPixelWand" isPixelWand 25 | :: Ptr PixelWand -> IO MagickBooleanType 26 | 27 | -- | PixelGetMagickColor() gets the magick color of the pixel wand. 28 | foreign import ccall "PixelGetMagickColor" pixelGetMagickColor 29 | :: Ptr PixelWand -> Ptr MagickPixelPacket -> IO () 30 | 31 | -- | PixelSetMagickColor() sets the color of the pixel wand. 32 | foreign import ccall "PixelSetMagickColor" pixelSetMagickColor 33 | :: Ptr PixelWand -> Ptr MagickPixelPacket -> IO () 34 | 35 | foreign import ccall "ClearPixelWand" clearPixelWand 36 | :: Ptr PixelWand -> IO () 37 | 38 | foreign import ccall "ClonePixelWand" clonePixelWand 39 | :: Ptr PixelWand -> IO (Ptr PixelWand) 40 | 41 | -- | NewPixelWand() returns a new pixel wand. 42 | foreign import ccall "NewPixelWand" newPixelWand 43 | :: IO (Ptr PixelWand) 44 | 45 | -- | NewPixelWands() returns an array of pixel wands. 46 | foreign import ccall "NewPixelWands" newPixelWands 47 | :: CSize -> IO (Ptr (Ptr PixelWand)) 48 | 49 | -- | PixelSetColor() sets the color of the pixel wand with a string (e.g. "blue", "#0000ff", "rgb(0,0,255)", "cmyk(100,100,100,10)", etc.). 50 | foreign import ccall "PixelSetColor" pixelSetColor 51 | :: Ptr PixelWand -> CString -> IO MagickBooleanType 52 | 53 | -- | PixelClearException() clear any exceptions associated with the iterator. 54 | foreign import ccall "PixelClearException" pixelClearException 55 | :: Ptr PixelWand -> IO MagickBooleanType 56 | 57 | -- | PixelGetException() returns the severity, reason, and description of any 58 | -- error that occurs when using other methods in this API. 59 | foreign import ccall "PixelGetException" pixelGetException 60 | :: Ptr PixelWand -> Ptr ExceptionType -> IO CString 61 | 62 | -- | PixelGetExceptionType() the exception type associated with the wand. 63 | -- If no exception has occurred, UndefinedExceptionType is returned. 64 | foreign import ccall "PixelGetExceptionType" pixelGetExceptionType 65 | :: Ptr PixelWand -> IO ExceptionType 66 | 67 | -- | PixelGetColorAsString() returnsd the color of the pixel wand as a string. 68 | foreign import ccall "PixelGetColorAsString" pixelGetColorAsString 69 | :: Ptr PixelWand -> IO CString 70 | 71 | -- | PixelGetColorAsNormalizedString() returns the normalized color of the pixel wand as a string. 72 | foreign import ccall "PixelGetColorAsNormalizedString" pixelGetColorAsNormalizedString 73 | :: Ptr PixelWand -> IO CString 74 | 75 | -- | PixelGetRed) returns the normalized red color of the pixel wand. 76 | foreign import ccall "PixelSetRed" pixelSetRed 77 | :: Ptr PixelWand -> CDouble -> IO () 78 | 79 | -- | PixelSetRedQuantum() sets the red color of the pixel wand. 80 | foreign import ccall "PixelSetRedQuantum" pixelSetRedQuantum 81 | :: Ptr PixelWand -> Quantum -> IO () 82 | 83 | -- | PixelGetRed) returns the normalized red color of the pixel wand. 84 | foreign import ccall "PixelGetRed" pixelGetRed 85 | :: Ptr PixelWand -> IO CDouble 86 | 87 | -- | PixelGetRedQuantum() returns the red color of the pixel wand. 88 | foreign import ccall "PixelGetRedQuantum" pixelGetRedQuantum 89 | :: Ptr PixelWand -> IO Quantum 90 | 91 | -- | PixelGetGreen) returns the normalized green color of the pixel wand. 92 | foreign import ccall "PixelGetGreen" pixelGetGreen 93 | :: Ptr PixelWand -> IO CDouble 94 | 95 | -- | PixelGetGreenQuantum() returns the green color of the pixel wand. 96 | foreign import ccall "PixelGetGreenQuantum" pixelGetGreenQuantum 97 | :: Ptr PixelWand -> IO Quantum 98 | 99 | -- | PixelSetGreen() sets the green color of the pixel wand. 100 | foreign import ccall "PixelSetGreen" pixelSetGreen 101 | :: Ptr PixelWand -> CDouble -> IO () 102 | 103 | -- | PixelSetGreenQuantum() sets the green color of the pixel wand. 104 | foreign import ccall "PixelSetGreenQuantum" pixelSetGreenQuantum 105 | :: Ptr PixelWand -> Quantum -> IO () 106 | 107 | -- | PixelGetBlue() returns the normalized blue color of the pixel wand. 108 | foreign import ccall "PixelGetBlue" pixelGetBlue 109 | :: Ptr PixelWand -> IO CDouble 110 | 111 | foreign import ccall "PixelSetBlue" pixelSetBlue 112 | :: Ptr PixelWand -> CDouble -> IO () 113 | 114 | -- | PixelGetBlueQuantum() returns the blue color of the pixel wand. 115 | foreign import ccall "PixelGetBlueQuantum" pixelGetBlueQuantum 116 | :: Ptr PixelWand -> IO Quantum 117 | 118 | -- | PixelSetBlueQuantum() sets the blue color of the pixel wand. 119 | foreign import ccall "PixelSetBlueQuantum" pixelSetBlueQuantum 120 | :: Ptr PixelWand -> Quantum -> IO () 121 | 122 | -- | IsPixelWandSimilar() returns MagickTrue if the distance between 123 | -- two colors is less than the specified distance. 124 | foreign import ccall "IsPixelWandSimilar" isPixelWandSimilar 125 | :: Ptr PixelWand -> Ptr PixelWand 126 | -> CDouble -- ^ any two colors that are less than or equal to this distance squared are consider similar 127 | -> IO MagickBooleanType 128 | 129 | -- | PixelGetCyan) returns the normalized blue color of the pixel wand. 130 | foreign import ccall "PixelGetCyan" pixelGetCyan 131 | :: Ptr PixelWand -> IO CDouble 132 | 133 | foreign import ccall "PixelSetCyan" pixelSetCyan 134 | :: Ptr PixelWand -> CDouble -> IO () 135 | 136 | -- | PixelGetCyanQuantum() returns the blue color of the pixel wand. 137 | foreign import ccall "PixelGetCyanQuantum" pixelGetCyanQuantum 138 | :: Ptr PixelWand -> IO Quantum 139 | 140 | -- | PixelSetCyanQuantum() sets the blue color of the pixel wand. 141 | foreign import ccall "PixelSetCyanQuantum" pixelSetCyanQuantum 142 | :: Ptr PixelWand -> Quantum -> IO () 143 | 144 | -- | PixelGetMagenta) returns the normalized blue color of the pixel wand. 145 | foreign import ccall "PixelGetMagenta" pixelGetMagenta 146 | :: Ptr PixelWand -> IO CDouble 147 | 148 | foreign import ccall "PixelSetMagenta" pixelSetMagenta 149 | :: Ptr PixelWand -> CDouble -> IO () 150 | 151 | -- | PixelGetMagentaQuantum() returns the blue color of the pixel wand. 152 | foreign import ccall "PixelGetMagentaQuantum" pixelGetMagentaQuantum 153 | :: Ptr PixelWand -> IO Quantum 154 | 155 | -- | PixelSetMagentaQuantum() sets the blue color of the pixel wand. 156 | foreign import ccall "PixelSetMagentaQuantum" pixelSetMagentaQuantum 157 | :: Ptr PixelWand -> Quantum -> IO () 158 | 159 | -- | PixelGetYellow) returns the normalized blue color of the pixel wand. 160 | foreign import ccall "PixelGetYellow" pixelGetYellow 161 | :: Ptr PixelWand -> IO CDouble 162 | 163 | foreign import ccall "PixelSetYellow" pixelSetYellow 164 | :: Ptr PixelWand -> CDouble -> IO () 165 | 166 | -- | PixelGetYellowQuantum() returns the blue color of the pixel wand. 167 | foreign import ccall "PixelGetYellowQuantum" pixelGetYellowQuantum 168 | :: Ptr PixelWand -> IO Quantum 169 | 170 | -- | PixelSetYellowQuantum() sets the blue color of the pixel wand. 171 | foreign import ccall "PixelSetYellowQuantum" pixelSetYellowQuantum 172 | :: Ptr PixelWand -> Quantum -> IO () 173 | 174 | -- | PixelGetBlack) returns the normalized blue color of the pixel wand. 175 | foreign import ccall "PixelGetBlack" pixelGetBlack 176 | :: Ptr PixelWand -> IO CDouble 177 | 178 | foreign import ccall "PixelSetBlack" pixelSetBlack 179 | :: Ptr PixelWand -> CDouble -> IO () 180 | 181 | -- | PixelGetBlackQuantum() returns the blue color of the pixel wand. 182 | foreign import ccall "PixelGetBlackQuantum" pixelGetBlackQuantum 183 | :: Ptr PixelWand -> IO Quantum 184 | 185 | -- | PixelSetBlackQuantum() sets the blue color of the pixel wand. 186 | foreign import ccall "PixelSetBlackQuantum" pixelSetBlackQuantum 187 | :: Ptr PixelWand -> Quantum -> IO () 188 | 189 | -- | PixelGetAlpha) returns the normalized blue color of the pixel wand. 190 | foreign import ccall "PixelGetAlpha" pixelGetAlpha 191 | :: Ptr PixelWand -> IO CDouble 192 | 193 | -- | PixelGetAlphaQuantum() returns the blue color of the pixel wand. 194 | foreign import ccall "PixelGetAlphaQuantum" pixelGetAlphaQuantum 195 | :: Ptr PixelWand -> IO Quantum 196 | 197 | -- | PixelSetAlphaQuantum() sets the blue color of the pixel wand. 198 | foreign import ccall "PixelSetAlphaQuantum" pixelSetAlphaQuantum 199 | :: Ptr PixelWand -> Quantum -> IO () 200 | 201 | foreign import ccall "PixelSetAlpha" pixelSetAlpha 202 | :: Ptr PixelWand -> CDouble -> IO () 203 | 204 | -- | PixelGetOpacity) returns the normalized blue color of the pixel wand. 205 | foreign import ccall "PixelGetOpacity" pixelGetOpacity 206 | :: Ptr PixelWand -> IO CDouble 207 | 208 | -- | PixelGetOpacityQuantum() returns the blue color of the pixel wand. 209 | foreign import ccall "PixelGetOpacityQuantum" pixelGetOpacityQuantum 210 | :: Ptr PixelWand -> IO Quantum 211 | 212 | -- | PixelSetOpacityQuantum() sets the blue color of the pixel wand. 213 | foreign import ccall "PixelSetOpacityQuantum" pixelSetOpacityQuantum 214 | :: Ptr PixelWand -> Quantum -> IO () 215 | 216 | foreign import ccall "PixelSetOpacity" pixelSetOpacity 217 | :: Ptr PixelWand -> CDouble -> IO () 218 | 219 | 220 | 221 | -- | PixelGetColorCount() returns the color count associated with this color. 222 | foreign import ccall "PixelGetColorCount" pixelGetColorCount 223 | :: Ptr PixelWand -> IO CSize 224 | 225 | -- | PixelSetColorCount() sets the color count of the pixel wand. 226 | foreign import ccall "PixelSetColorCount" pixelSetColorCount 227 | :: Ptr PixelWand -> CSize -> IO () 228 | 229 | -- PixelGetHSL() returns the normalized HSL color of the pixel wand. 230 | foreign import ccall "PixelGetHSL" pixelGetHSL 231 | :: Ptr PixelWand -> Ptr CDouble -> Ptr CDouble -> Ptr CDouble -> IO () 232 | 233 | -- | PixelSetHSL() sets the normalized HSL color of the pixel wand. 234 | foreign import ccall "PixelSetHSL" pixelSetHSL 235 | :: Ptr PixelWand -> CDouble -> CDouble -> CDouble -> IO () 236 | 237 | 238 | -- | PixelSetColorFromWand() sets the color of the pixel wand. 239 | foreign import ccall "PixelSetColorFromWand" pixelSetColorFromWand 240 | :: Ptr PixelWand -> Ptr PixelWand -> IO () 241 | 242 | 243 | -- | PixelGetIndex() returns the colormap index from the pixel wand. 244 | foreign import ccall "PixelGetIndex" pixelGetIndex 245 | :: Ptr PixelWand -> IO IndexPacket 246 | 247 | 248 | -- | PixelSetIndex() sets the colormap index of the pixel wand. 249 | foreign import ccall "PixelSetColor" pixelSetIndex 250 | :: Ptr PixelWand -> IndexPacket -> IO () 251 | 252 | -- | PixelGetQuantumColor() gets the color of the pixel wand as a PixelPacket. 253 | foreign import ccall "PixelGetQuantumColor" pixelGetQuantumColor 254 | :: Ptr PixelWand -> Ptr PixelPacket -> IO () 255 | 256 | -- | PixelGetQuantumColor() gets the color of the pixel wand as a PixelPacket. 257 | foreign import ccall "PixelSetQuantumColor" pixelSetQuantumColor 258 | :: Ptr PixelWand -> Ptr PixelPacket -> IO () 259 | 260 | -- | PixelGetFuzz() returns the normalized fuzz value of the pixel wand. 261 | foreign import ccall "PixelGetFuzz" pixelGetFuzz 262 | :: Ptr PixelWand -> IO CDouble 263 | 264 | -- | PixelSetFuzz() sets the fuzz value of the pixel wand. 265 | foreign import ccall "PixelSetFuzz" pixelSetFuzz 266 | :: Ptr PixelWand -> CDouble -> IO () 267 | 268 | {- 269 | ClonePixelWands() makes an exact copy of the specified wands. 270 | 271 | The format of the ClonePixelWands method is: 272 | 273 | PixelWand **ClonePixelWands(const PixelWand **wands, 274 | const size_t number_wands) 275 | 276 | -} 277 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Before we get to the text of the license, lets just review what the license says in simple terms: 2 | 3 | It allows you to: 4 | 5 | * freely download and use ImageMagick software, in whole or in part, for personal, company internal, or commercial purposes; 6 | * use ImageMagick software in packages or distributions that you create; 7 | * link against a library under a different license; 8 | * link code under a different license against a library under this license; 9 | * merge code into a work under a different license; 10 | * extend patent grants to any code using code under this license; 11 | * and extend patent protection. 12 | 13 | It forbids you to: 14 | 15 | * redistribute any piece of ImageMagick-originated software without proper attribution; 16 | * use any marks owned by ImageMagick Studio LLC in any way that might state or imply that ImageMagick Studio LLC endorses your distribution; 17 | * use any marks owned by ImageMagick Studio LLC in any way that might state or imply that you created the ImageMagick software in question. 18 | 19 | It requires you to: 20 | 21 | * include a copy of the license in any redistribution you may make that includes ImageMagick software; 22 | * provide clear attribution to ImageMagick Studio LLC for any distributions that include ImageMagick software. 23 | 24 | It does not require you to: 25 | 26 | * include the source of the ImageMagick software itself, or of any modifications you may have made to it, in any redistribution you may assemble that includes it; 27 | * submit changes that you make to the software back to the ImageMagick Studio LLC (though such feedback is encouraged). 28 | 29 | A few other clarifications include: 30 | 31 | * ImageMagick is freely available without charge; 32 | * you may include ImageMagick on a DVD as long as you comply with the terms of the license; 33 | * you can give modified code away for free or sell it under the terms of the ImageMagick license or distribute the result under a different license, but you need to acknowledge the use of the ImageMagick software; 34 | * the license is compatible with the GPL V3. 35 | * when exporting the ImageMagick software, review its export classification. 36 | 37 | Terms and Conditions for Use, Reproduction, and Distribution 38 | 39 | The legally binding and authoritative terms and conditions for use, reproduction, and distribution of ImageMagick follow: 40 | 41 | Copyright 1999-2012 ImageMagick Studio LLC, a non-profit organization dedicated to making software imaging solutions freely available. 42 | 43 | 1. Definitions. 44 | 45 | License shall mean the terms and conditions for use, reproduction, and distribution as defined by Sections 1 through 9 of this document. 46 | 47 | Licensor shall mean the copyright owner or entity authorized by the copyright owner that is granting the License. 48 | 49 | Legal Entity shall mean the union of the acting entity and all other entities that control, are controlled by, or are under common control with that entity. For the purposes of this definition, control means (i) the power, direct or indirect, to cause the direction or management of such entity, whether by contract or otherwise, or (ii) ownership of fifty percent (50%) or more of the outstanding shares, or (iii) beneficial ownership of such entity. 50 | 51 | You (or Your) shall mean an individual or Legal Entity exercising permissions granted by this License. 52 | 53 | Source form shall mean the preferred form for making modifications, including but not limited to software source code, documentation source, and configuration files. 54 | 55 | Object form shall mean any form resulting from mechanical transformation or translation of a Source form, including but not limited to compiled object code, generated documentation, and conversions to other media types. 56 | 57 | Work shall mean the work of authorship, whether in Source or Object form, made available under the License, as indicated by a copyright notice that is included in or attached to the work (an example is provided in the Appendix below). 58 | 59 | Derivative Works shall mean any work, whether in Source or Object form, that is based on (or derived from) the Work and for which the editorial revisions, annotations, elaborations, or other modifications represent, as a whole, an original work of authorship. For the purposes of this License, Derivative Works shall not include works that remain separable from, or merely link (or bind by name) to the interfaces of, the Work and Derivative Works thereof. 60 | 61 | Contribution shall mean any work of authorship, including the original version of the Work and any modifications or additions to that Work or Derivative Works thereof, that is intentionally submitted to Licensor for inclusion in the Work by the copyright owner or by an individual or Legal Entity authorized to submit on behalf of the copyright owner. For the purposes of this definition, "submitted" means any form of electronic, verbal, or written communication sent to the Licensor or its representatives, including but not limited to communication on electronic mailing lists, source code control systems, and issue tracking systems that are managed by, or on behalf of, the Licensor for the purpose of discussing and improving the Work, but excluding communication that is conspicuously marked or otherwise designated in writing by the copyright owner as Not a Contribution. 62 | 63 | Contributor shall mean Licensor and any individual or Legal Entity on behalf of whom a Contribution has been received by Licensor and subsequently incorporated within the Work. 64 | 65 | 2. Grant of Copyright License. Subject to the terms and conditions of this License, each Contributor hereby grants to You a perpetual, worldwide, non-exclusive, no-charge, royalty-free, irrevocable copyright license to reproduce, prepare Derivative Works of, publicly display, publicly perform, sublicense, and distribute the Work and such Derivative Works in Source or Object form. 66 | 67 | 3. Grant of Patent License. Subject to the terms and conditions of this License, each Contributor hereby grants to You a perpetual, worldwide, non-exclusive, no-charge, royalty-free, irrevocable patent license to make, have made, use, offer to sell, sell, import, and otherwise transfer the Work, where such license applies only to those patent claims licensable by such Contributor that are necessarily infringed by their Contribution(s) alone or by combination of their Contribution(s) with the Work to which such Contribution(s) was submitted. If You institute patent litigation against any entity (including a cross-claim or counterclaim in a lawsuit) alleging that the Work or a Contribution incorporated within the Work constitutes direct or contributory patent infringement, then any patent licenses granted to You under this License for that Work shall terminate as of the date such litigation is filed. 68 | 69 | 4. Redistribution. You may reproduce and distribute copies of the Work or Derivative Works thereof in any medium, with or without modifications, and in Source or Object form, provided that You meet the following conditions: 70 | 71 | * You must give any other recipients of the Work or Derivative Works a copy of this License; and 72 | * You must cause any modified files to carry prominent notices stating that You changed the files; and 73 | * You must retain, in the Source form of any Derivative Works that You distribute, all copyright, patent, trademark, and attribution notices from the Source form of the Work, excluding those notices that do not pertain to any part of the Derivative Works; and 74 | * If the Work includes a "NOTICE" text file as part of its distribution, then any Derivative Works that You distribute must include a readable copy of the attribution notices contained within such NOTICE file, excluding those notices that do not pertain to any part of the Derivative Works, in at least one of the following places: within a NOTICE text file distributed as part of the Derivative Works; within the Source form or documentation, if provided along with the Derivative Works; or, within a display generated by the Derivative Works, if and wherever such third-party notices normally appear. The contents of the NOTICE file are for informational purposes only and do not modify the License. You may add Your own attribution notices within Derivative Works that You distribute, alongside or as an addendum to the NOTICE text from the Work, provided that such additional attribution notices cannot be construed as modifying the License. 75 | You may add Your own copyright statement to Your modifications and may provide additional or different license terms and conditions for use, reproduction, or distribution of Your modifications, or for any such Derivative Works as a whole, provided Your use, reproduction, and distribution of the Work otherwise complies with the conditions stated in this License. 76 | 77 | 5. Submission of Contributions. Unless You explicitly state otherwise, any Contribution intentionally submitted for inclusion in the Work by You to the Licensor shall be under the terms and conditions of this License, without any additional terms or conditions. Notwithstanding the above, nothing herein shall supersede or modify the terms of any separate license agreement you may have executed with Licensor regarding such Contributions. 78 | 79 | 6. Trademarks. This License does not grant permission to use the trade names, trademarks, service marks, or product names of the Licensor, except as required for reasonable and customary use in describing the origin of the Work and reproducing the content of the NOTICE file. 80 | 81 | 7. Disclaimer of Warranty. Unless required by applicable law or agreed to in writing, Licensor provides the Work (and each Contributor provides its Contributions) on an AS IS BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied, including, without limitation, any warranties or conditions of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A PARTICULAR PURPOSE. You are solely responsible for determining the appropriateness of using or redistributing the Work and assume any risks associated with Your exercise of permissions under this License. 82 | 83 | 8. Limitation of Liability. In no event and under no legal theory, whether in tort (including negligence), contract, or otherwise, unless required by applicable law (such as deliberate and grossly negligent acts) or agreed to in writing, shall any Contributor be liable to You for damages, including any direct, indirect, special, incidental, or consequential damages of any character arising as a result of this License or out of the use or inability to use the Work (including but not limited to damages for loss of goodwill, work stoppage, computer failure or malfunction, or any and all other commercial damages or losses), even if such Contributor has been advised of the possibility of such damages. 84 | 85 | 9. Accepting Warranty or Additional Liability. While redistributing the Work or Derivative Works thereof, You may choose to offer, and charge a fee for, acceptance of support, warranty, indemnity, or other liability obligations and/or rights consistent with this License. However, in accepting such obligations, You may act only on Your own behalf and on Your sole responsibility, not on behalf of any other Contributor, and only if You agree to indemnify, defend, and hold each Contributor harmless for any liability incurred by, or claims asserted against, such Contributor by reason of your accepting any such warranty or additional liability. 86 | 87 | How to Apply the License to your Work 88 | 89 | To apply the ImageMagick License to your work, attach the following boilerplate notice, with the fields enclosed by brackets "[]" replaced with your own identifying information (don't include the brackets). The text should be enclosed in the appropriate comment syntax for the file format. We also recommend that a file or class name and description of purpose be included on the same "printed page" as the copyright notice for easier identification within third-party archives. 90 | 91 | Copyright [yyyy] [name of copyright owner] 92 | 93 | Licensed under the ImageMagick License (the "License"); you may not use 94 | this file except in compliance with the License. You may obtain a copy 95 | of the License at 96 | 97 | http://www.imagemagick.org/script/license.php 98 | 99 | Unless required by applicable law or agreed to in writing, software 100 | distributed under the License is distributed on an "AS IS" BASIS, WITHOUT 101 | WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the 102 | License for the specific language governing permissions and limitations 103 | under the License. 104 | -------------------------------------------------------------------------------- /src/Graphics/ImageMagick/MagickWand/FFI/DrawingWand.hsc: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE ForeignFunctionInterface #-} 3 | module Graphics.ImageMagick.MagickWand.FFI.DrawingWand 4 | where 5 | 6 | import Foreign 7 | import Foreign.C.String 8 | import Foreign.C.Types 9 | 10 | import Graphics.ImageMagick.MagickCore.Types 11 | import Graphics.ImageMagick.MagickWand.FFI.Types 12 | 13 | #include 14 | 15 | -- | NewDrawingWand() returns a drawing wand required for all other methods in the API. 16 | foreign import ccall "NewDrawingWand" newDrawingWand 17 | :: IO (Ptr DrawingWand) 18 | 19 | -- | DestroyDrawingWand() frees all resources associated with the drawing wand. 20 | -- Once the drawing wand has been freed, it should not be used and further unless it re-allocated. 21 | foreign import ccall "DestroyDrawingWand" destroyDrawingWand 22 | :: Ptr DrawingWand -> IO (Ptr DrawingWand) 23 | 24 | -- | PixelGetException() returns the severity, reason, and description of any 25 | -- error that occurs when using other methods in this API. 26 | foreign import ccall "DrawGetException" drawGetException 27 | :: Ptr DrawingWand -> Ptr ExceptionType -> IO CString 28 | 29 | -- | DrawGetFillColor() returns the fill color used for drawing filled objects. 30 | foreign import ccall "DrawGetFillColor" drawGetFillColor 31 | :: Ptr DrawingWand -> Ptr PixelWand -> IO () 32 | 33 | -- | DrawSetFillColor() sets the fill color to be used for drawing filled objects. 34 | foreign import ccall "DrawSetFillColor" drawSetFillColor 35 | :: Ptr DrawingWand -> Ptr PixelWand -> IO () 36 | 37 | -- | DrawSetFillPatternURL() sets the URL to use as a fill pattern 38 | -- for filling objects. Only local URLs ("#identifier") are supported 39 | -- at this time. These local URLs are normally created by defining a named 40 | -- fill pattern with DrawPushPattern/DrawPopPattern. 41 | foreign import ccall "DrawSetFillPatternURL" drawSetFillPatternURL 42 | :: Ptr DrawingWand -> CString -> IO MagickBooleanType 43 | 44 | -- | DrawSetFillRule() sets the fill rule to use while drawing polygons. 45 | foreign import ccall "DrawSetFillRule" drawSetFillRule 46 | :: Ptr DrawingWand -> FillRule -> IO () 47 | 48 | -- | DrawSetFont() sets the fully-sepecified font to use when annotating with text. 49 | foreign import ccall "DrawSetFont" drawSetFont 50 | :: Ptr DrawingWand -> CString -> IO () 51 | 52 | -- | DrawSetFontSize() sets the font pointsize to use when annotating with text. 53 | foreign import ccall "DrawSetFontSize" drawSetFontSize 54 | :: Ptr DrawingWand -> CDouble -> IO () 55 | 56 | -- | DrawSetGravity() sets the text placement gravity to use when annotating with text. 57 | foreign import ccall "DrawSetGravity" drawSetGravity 58 | :: Ptr DrawingWand -> GravityType -> IO () 59 | 60 | -- | DrawSetStrokeAntialias() controls whether stroked outlines are antialiased. 61 | -- Stroked outlines are antialiased by default. When antialiasing is disabled 62 | -- stroked pixels are thresholded to determine if the stroke color or 63 | -- underlying canvas color should be used. 64 | foreign import ccall "DrawSetStrokeAntialias" drawSetStrokeAntialias 65 | :: Ptr DrawingWand 66 | -> MagickBooleanType -- ^ stroke_antialias 67 | -> IO () 68 | 69 | -- | DrawSetStrokeColor() sets the color used for stroking object outlines. 70 | foreign import ccall "DrawSetStrokeColor" drawSetStrokeColor 71 | :: Ptr DrawingWand 72 | -> Ptr PixelWand -- ^ stroke_wand 73 | -> IO () 74 | 75 | -- | DrawSetStrokeDashArray() specifies the pattern of dashes and gaps used to 76 | -- stroke paths. The stroke dash array represents an array of numbers that 77 | -- specify the lengths of alternating dashes and gaps in pixels. If an odd 78 | -- number of values is provided, then the list of values is repeated to yield 79 | -- an even number of values. To remove an existing dash array, pass a zero 80 | -- number_elements argument and null dash_array. A typical stroke dash array 81 | -- might contain the members 5 3 2. 82 | foreign import ccall "DrawSetStrokeDashArray" drawSetStrokeDashArray 83 | :: Ptr DrawingWand 84 | -> CSize -- ^ number of elements in dash array 85 | -> Ptr CDouble -- ^ dash array values 86 | -> IO () 87 | 88 | -- | DrawSetStrokeLineCap() specifies the shape to be used at the end 89 | -- of open subpaths when they are stroked. Values of LineCap are UndefinedCap, 90 | -- ButtCap, RoundCap, and SquareCap. 91 | foreign import ccall "DrawSetStrokeLineCap" drawSetStrokeLineCap 92 | :: Ptr DrawingWand 93 | -> LineCap -- ^ linecap 94 | -> IO () 95 | 96 | -- | DrawSetStrokeLineJoin() specifies the shape to be used at the corners 97 | -- of paths (or other vector shapes) when they are stroked. 98 | -- Values of LineJoin are UndefinedJoin, MiterJoin, RoundJoin, and BevelJoin. 99 | foreign import ccall "DrawSetStrokeLineJoin" drawSetStrokeLineJoin 100 | :: Ptr DrawingWand 101 | -> LineJoin -- ^ linejoin 102 | -> IO () 103 | 104 | -- | DrawSetStrokeOpacity() specifies the opacity of stroked object outlines. 105 | foreign import ccall "DrawSetStrokeOpacity" drawSetStrokeOpacity 106 | :: Ptr DrawingWand 107 | -> CDouble -- ^ stroke_opacity 108 | -> IO () 109 | 110 | -- | DrawSetStrokeOpacity() specifies the opacity of stroked object outlines. 111 | foreign import ccall "DrawSetTextAntialias" drawSetTextAntialias 112 | :: Ptr DrawingWand 113 | -> MagickBooleanType -- ^ antialias boolean. Set to false (0) to disable antialiasing. 114 | -> IO () 115 | 116 | -- | DrawSetStrokeWidth() sets the width of the stroke used to draw object outlines. 117 | foreign import ccall "DrawSetStrokeWidth" drawSetStrokeWidth 118 | :: Ptr DrawingWand 119 | -> CDouble -- ^ stroke_width 120 | -> IO () 121 | 122 | -- | DrawAnnotation() draws text on the image. 123 | foreign import ccall "DrawAnnotation" drawAnnotation 124 | :: Ptr DrawingWand 125 | -> CDouble -- ^ x ordinate to left of text 126 | -> CDouble -- ^ y ordinate to text baseline 127 | -> CString -- ^ text to draw 128 | -> IO () 129 | 130 | -- | DrawCircle() draws a circle on the image. 131 | foreign import ccall "DrawCircle" drawCircle 132 | :: Ptr DrawingWand 133 | -> CDouble -- ^ origin x ordinate 134 | -> CDouble -- ^ origin y ordinate 135 | -> CDouble -- ^ perimeter x ordinate 136 | -> CDouble -- ^ perimeter y ordinate 137 | -> IO () 138 | 139 | -- | DrawComposite() composites an image onto the current image, using 140 | -- the specified composition operator, specified position, and at the specified size. 141 | foreign import ccall "DrawComposite" drawComposite 142 | :: Ptr DrawingWand 143 | -> CompositeOperator -- ^ composition operator 144 | -> CDouble -- ^ x ordinate of top left corner 145 | -> CDouble -- ^ y ordinate of top left corner 146 | -> CDouble -- ^ width to resize image to prior to compositing, specify zero to use existing width 147 | -> CDouble -- ^ height to resize image to prior to compositing, specify zero to use existing height 148 | -> Ptr MagickWand -- ^ image to composite is obtained from this wand 149 | -> IO MagickBooleanType 150 | 151 | 152 | -- | DrawEllipse() draws an ellipse on the image. 153 | foreign import ccall "DrawEllipse" drawEllipse 154 | :: Ptr DrawingWand 155 | -> CDouble -- ^ origin x ordinate 156 | -> CDouble -- ^ origin y ordinate 157 | -> CDouble -- ^ radius in x 158 | -> CDouble -- ^ radius in y 159 | -> CDouble -- ^ starting rotation in degrees 160 | -> CDouble -- ^ ending rotation in degrees 161 | -> IO () 162 | 163 | -- | DrawLine() draws a line on the image using the current stroke color, 164 | -- stroke opacity, and stroke width. 165 | foreign import ccall "DrawLine" drawLine 166 | :: Ptr DrawingWand 167 | -> CDouble -- ^ starting x ordinate 168 | -> CDouble -- ^ starting y ordinate 169 | -> CDouble -- ^ ending x ordinate 170 | -> CDouble -- ^ ending y ordinate 171 | -> IO () 172 | 173 | -- | DrawPolygon() draws a polygon using the current stroke, stroke width, 174 | -- and fill color or texture, using the specified array of coordinates. 175 | foreign import ccall "DrawPolygon" drawPolygon 176 | :: Ptr DrawingWand 177 | -> CSize -- ^ number of coordinates 178 | -> Ptr PointInfo -- ^ coordinate array 179 | -> IO () 180 | 181 | -- | DrawRectangle() draws a rectangle given two coordinates 182 | -- and using the current stroke, stroke width, and fill settings. 183 | foreign import ccall "DrawRectangle" drawRectangle 184 | :: Ptr DrawingWand 185 | -> CDouble -- ^ x ordinate of first coordinate 186 | -> CDouble -- ^ y ordinate of first coordinate 187 | -> CDouble -- ^ x ordinate of second coordinate 188 | -> CDouble -- ^ y ordinate of second coordinate 189 | -> IO () 190 | 191 | -- | DrawRoundRectangle() draws a rounted rectangle given two coordinates, 192 | -- x & y corner radiuses and using the current stroke, stroke width, and fill settings. 193 | foreign import ccall "DrawRoundRectangle" drawRoundRectangle 194 | :: Ptr DrawingWand 195 | -> CDouble -- ^ x ordinate of first coordinate 196 | -> CDouble -- ^ y ordinate of first coordinate 197 | -> CDouble -- ^ x ordinate of second coordinate 198 | -> CDouble -- ^ y ordinate of second coordinate 199 | -> CDouble -- ^ radius of corner in horizontal direction 200 | -> CDouble -- ^ radius of corner in vertical direction 201 | -> IO () 202 | 203 | -- | PushDrawingWand() clones the current drawing wand to create a new drawing wand. 204 | -- The original drawing wand(s) may be returned to by invoking PopDrawingWand(). 205 | -- The drawing wands are stored on a drawing wand stack. For every Pop there must 206 | -- have already been an equivalent Push. 207 | foreign import ccall "PushDrawingWand" pushDrawingWand 208 | :: Ptr DrawingWand 209 | -> IO MagickBooleanType 210 | 211 | -- | PopDrawingWand() destroys the current drawing wand and returns to the 212 | -- previously pushed drawing wand. Multiple drawing wands may exist. 213 | -- It is an error to attempt to pop more drawing wands than have been pushed, 214 | -- and it is proper form to pop all drawing wands which have been pushed. 215 | foreign import ccall "PopDrawingWand" popDrawingWand 216 | :: Ptr DrawingWand 217 | -> IO MagickBooleanType 218 | 219 | -- | DrawRotate() applies the specified rotation to the current coordinate space. 220 | foreign import ccall "DrawRotate" drawRotate 221 | :: Ptr DrawingWand 222 | -> CDouble -- ^ degrees of rotation 223 | -> IO () 224 | 225 | -- | DrawTranslate() applies a translation to the current coordinate system 226 | -- which moves the coordinate system origin to the specified coordinate. 227 | foreign import ccall "DrawTranslate" drawTranslate 228 | :: Ptr DrawingWand 229 | -> CDouble -- ^ new x ordinate for coordinate system origin 230 | -> CDouble -- ^ new y ordinate for coordinate system origin 231 | -> IO () 232 | 233 | -- | DrawPushPattern() indicates that subsequent commands up to 234 | -- a DrawPopPattern() command comprise the definition of a named pattern. 235 | -- The pattern space is assigned top left corner coordinates, a width and height, 236 | -- and becomes its own drawing space. Anything which can be drawn may be used 237 | -- in a pattern definition. Named patterns may be used as stroke or brush definitions. 238 | foreign import ccall "DrawPushPattern" drawPushPattern 239 | :: Ptr DrawingWand 240 | -> CString -- ^ pattern identification for later reference 241 | -> CDouble -- x ordinate of top left corner 242 | -> CDouble -- y ordinate of top left corner 243 | -> CDouble -- width of pattern space 244 | -> CDouble -- height of pattern space 245 | -> IO MagickBooleanType 246 | 247 | -- | DrawPopPattern() terminates a pattern definition. 248 | foreign import ccall "DrawPopPattern" drawPopPattern 249 | :: Ptr DrawingWand 250 | -> IO MagickBooleanType 251 | 252 | 253 | -- | DrawColor() draws color on image using the current fill color, starting at 254 | -- specified position, and using specified paint method. The available paint methods are: 255 | -- 256 | -- PointMethod: Recolors the target pixel 257 | -- ReplaceMethod: Recolor any pixel that matches the target pixel. 258 | -- FloodfillMethod: Recolors target pixels and matching neighbors. 259 | -- ResetMethod: Recolor all pixels. 260 | foreign import ccall "DrawColor" drawColor 261 | :: Ptr DrawingWand 262 | -> CDouble 263 | -> CDouble 264 | -> PaintMethod 265 | -> IO () 266 | 267 | -- | DrawPoint() draws a point using the current fill color. 268 | foreign import ccall "DrawPoint" drawPoint 269 | :: Ptr DrawingWand 270 | -> CDouble -- ^ target x coordinate 271 | -> CDouble -- ^ target y coordinate 272 | -> IO () 273 | --------------------------------------------------------------------------------