imagemagick-0.0.2: Graphics/ImageMagick/MagickWand/DrawingWand.hs
module Graphics.ImageMagick.MagickWand.DrawingWand
( drawingWand
, getFillColor
, setFillColor
, setFillPatternURL
, setFillRule
, setFont
, setFontSize
, setGravity
, setStrokeAntialias
, setStrokeColor
, setStrokeDashArray
, setStrokeLineCap
, setStrokeLineJoin
, setStrokeOpacity
, setStrokeWidth
, setTextAntialias
, drawAnnotation
, drawCircle
, drawComposite
, drawEllipse
, drawLine
, drawPoint
, drawPolygon
, drawRectangle
, drawRoundRectangle
, drawColor
, pushDrawingWand
, popDrawingWand
, rotate
, translate
, pushPattern
, popPattern
-- , clearDrawingWand
-- , cloneDrawingWand
-- , destroyDrawingWand
-- , drawAffine
-- , drawAnnotation
-- , drawArc
-- , drawBezier
-- , drawCircle
-- , drawClearException
-- , drawComposite
-- , drawColor
-- , drawComment
-- , drawEllipse
-- , drawGetBorderColor
-- , drawGetClipPath
-- , drawGetClipRule
-- , drawGetClipUnits
-- , drawGetException
-- , drawGetExceptionType
-- , drawGetFillOpacity
-- , drawGetFillRule
-- , drawGetFont
-- , drawGetFontFamily
-- , drawGetFontResolution
-- , drawGetFontSize
-- , drawGetFontStretch
-- , drawGetFontStyle
-- , drawGetFontWeight
-- , drawGetGravity
-- , drawGetOpacity
-- , drawGetStrokeAntialias
-- , drawGetStrokeColor
-- , drawGetStrokeDashArray
-- , drawGetStrokeDashOffset
-- , drawGetStrokeLineJoin
-- , drawGetStrokeMiterLimit
-- , drawGetStrokeOpacity
-- , drawGetStrokeWidth
-- , drawGetTextAlignment
-- , drawGetTextAntialias
-- , drawGetTextDecoration
-- , drawGetTextEncoding
-- , drawGetTextKerning
-- , drawGetTextInterlineSpacing
-- , drawGetTextInterwordSpacing
-- , drawGetVectorGraphics
-- , drawGetTextUnderColor
-- , drawLine
-- , drawMatte
-- , drawPathClose
-- , drawPathCurveToAbsolute
-- , drawPathCurveToRelative
-- , drawPathCurveToQuadraticBezierAbsolute
-- , drawPathCurveToQuadraticBezierRelative
-- , drawPathCurveToQuadraticBezierSmoothAbsolute
-- , drawPathCurveToQuadraticBezierSmoothRelative
-- , drawPathCurveToSmoothAbsolute
-- , drawPathCurveToSmoothRelative
-- , drawPathEllipticArcAbsolute
-- , drawPathEllipticArcRelative
-- , drawPathFinish
-- , drawPathLineToAbsolute
-- , drawPathLineToRelative
-- , drawPathLineToHorizontalAbsolute
-- , drawPathLineToHorizontalRelative
-- , drawPathLineToVerticalAbsolute
-- , drawPathLineToVerticalRelative
-- , drawPathMoveToAbsolute
-- , drawPathMoveToRelative
-- , drawPathStart
-- , drawPoint
-- , drawPolygon
-- , drawPolyline
-- , drawPopClipPath
-- , drawPopDefs
-- , drawPopPattern
-- , drawPushClipPath
-- , drawPushDefs
-- , drawPushPattern
-- , drawRectangle
-- , drawResetVectorGraphics
-- , drawRotate
-- , drawRoundRectangle
-- , drawScale
-- , drawSetBorderColor
-- , drawSetClipPath
-- , drawSetClipRule
-- , drawSetClipUnits
-- , drawSetFillColor
-- , drawSetFillOpacity
-- , drawSetFontResolution
-- , drawSetOpacity
-- , drawSetFillPatternURL
-- , drawSetFillRule
-- , drawSetFontFamily
-- , drawSetFontSize
-- , drawSetFontStretch
-- , drawSetFontStyle
-- , drawSetFontWeight
-- , drawSetGravity
-- , drawSetStrokeColor
-- , drawSetStrokePatternURL
-- , drawSetStrokeAntialias
-- , drawSetStrokeDashArray
-- , drawSetStrokeDashOffset
-- , drawSetStrokeLineCap
-- , drawSetStrokeLineJoin
-- , drawSetStrokeMiterLimit
-- , drawSetStrokeOpacity
-- , drawSetStrokeWidth
-- , drawSetTextAlignment
-- , drawSetTextAntialias
-- , drawSetTextDecoration
-- , drawSetTextEncoding
-- , drawSetTextKerning
-- , drawSetTextInterlineSpacing
-- , drawSetTextInterwordSpacing
-- , drawSetTextUnderColor
-- , drawSetVectorGraphics
-- , drawSkewX
-- , drawSkewY
-- , drawTranslate
-- , drawSetViewbox
-- , isDrawingWand
-- , newDrawingWand
-- , peekDrawingWand
-- , popDrawingWand
-- , pushDrawingWand]
) where
import Control.Monad.IO.Class
import Control.Monad.Trans.Resource
import Data.ByteString (ByteString, useAsCString)
import Data.Text (Text)
import Data.Text.Encoding (encodeUtf8)
import Foreign hiding (rotate)
import Foreign.C.Types ()
import Graphics.ImageMagick.MagickCore.Types
import qualified Graphics.ImageMagick.MagickWand.FFI.DrawingWand as F
import Graphics.ImageMagick.MagickWand.FFI.Types
import Graphics.ImageMagick.MagickWand.Types
import Graphics.ImageMagick.MagickWand.Utils
drawingWand :: (MonadResource m) => m (ReleaseKey, PDrawingWand)
drawingWand = allocate (F.newDrawingWand) (void . F.destroyDrawingWand)
-- | returns the fill color used for drawing filled objects.
getFillColor :: (MonadResource m) => PDrawingWand -> PPixelWand -> m ()
getFillColor = (liftIO .). F.drawGetFillColor
-- | DrawSetFillColor() sets the fill color to be used for drawing filled objects.
setFillColor :: (MonadResource m) => PDrawingWand -> PPixelWand -> m ()
setFillColor = (liftIO .). F.drawSetFillColor
-- | Sets the URL to use as a fill pattern
-- for filling objects. Only local URLs ("#identifier") are supported
-- at this time. These local URLs are normally created by defining a named
-- fill pattern with `pushPattern`/`popPattern`.
setFillPatternURL :: (MonadResource m) => PDrawingWand -> Text -> m ()
setFillPatternURL dw url = withException_ dw $! useAsCString (encodeUtf8 url) (F.drawSetFillPatternURL dw)
-- | Sets the fill rule to use while drawing polygons.
setFillRule :: (MonadResource m) => PDrawingWand -> FillRule -> m ()
setFillRule = (liftIO .). F.drawSetFillRule
-- | Sets the fully-sepecified font to use when annotating with text.
setFont :: (MonadResource m) => PDrawingWand -> ByteString -> m ()
setFont dw s = liftIO $ useAsCString s (F.drawSetFont dw)
-- | Sets the font pointsize to use when annotating with text.
setFontSize :: (MonadResource m) => PDrawingWand -> Double -> m ()
setFontSize dw size = liftIO $ F.drawSetFontSize dw (realToFrac size)
-- | Sets the text placement gravity to use when annotating with text.
setGravity :: (MonadResource m) => PDrawingWand -> GravityType -> m ()
setGravity = (liftIO .). F.drawSetGravity
setStrokeAntialias :: (MonadResource m) => PDrawingWand -> Bool -> m ()
setStrokeAntialias dw antialias = liftIO $ F.drawSetStrokeAntialias dw (toMBool antialias)
-- | sets the color used for stroking object outlines.
setStrokeColor :: (MonadResource m) => PDrawingWand -> PPixelWand -> m ()
setStrokeColor = (liftIO .). F.drawSetStrokeColor
-- | Specifies the pattern of dashes and gaps used to
-- stroke paths. The stroke dash array represents an array of numbers that
-- specify the lengths of alternating dashes and gaps in pixels. If an odd
-- number of values is provided, then the list of values is repeated to yield
-- an even number of values. To remove an existing dash array, pass an emtpy list.
-- A typical stroke dash array might contain the members 5 3 2.
setStrokeDashArray :: (MonadResource m) => PDrawingWand -> [Double] -> m ()
setStrokeDashArray dw [] = liftIO $ F.drawSetStrokeDashArray dw 0 nullPtr
setStrokeDashArray dw dashes = liftIO $ withArray (map realToFrac dashes) $ \arr ->
F.drawSetStrokeDashArray dw (fromIntegral $ length dashes) arr
-- | Specifies the shape to be used at the end of open subpaths
-- when they are stroked. Values of `LineCap` are `undefinedCap`,
-- `buttCap, `roundCap` and `squareCap`.
setStrokeLineCap :: (MonadResource m) => PDrawingWand -> LineCap -> m ()
setStrokeLineCap = (liftIO .). F.drawSetStrokeLineCap
-- | Specifies the shape to be used at the corners of paths
-- (or other vector shapes) when they are stroked.
-- Values of `LineJoin` are `undefinedJoin`, `miterJoin`, `roundJoin` and `bevelJoin`.
setStrokeLineJoin :: (MonadResource m) => PDrawingWand -> LineJoin -> m ()
setStrokeLineJoin = (liftIO .). F.drawSetStrokeLineJoin
-- | specifies the opacity of stroked object outlines.
setStrokeOpacity :: (MonadResource m) => PDrawingWand -> Double -> m ()
setStrokeOpacity dw op = liftIO $ F.drawSetStrokeOpacity dw (realToFrac op)
-- | sets the width of the stroke used to draw object outlines.
setStrokeWidth :: (MonadResource m) => PDrawingWand -> Double -> m ()
setStrokeWidth dw width = liftIO $ F.drawSetStrokeWidth dw (realToFrac width)
-- | Controls whether text is antialiased. Text is antialiased by default.
setTextAntialias :: (MonadResource m) => PDrawingWand -> Bool -> m ()
setTextAntialias dw antialias = liftIO $ F.drawSetTextAntialias dw (toMBool antialias)
-- | Draws text on the image.
drawAnnotation :: (MonadResource m) => PDrawingWand
-> Double -- ^ x ordinate to left of text
-> Double -- ^ y ordinate to text baseline
-> Text -- ^ text to draw
-> m ()
drawAnnotation dw x y txt = liftIO $ useAsCString (encodeUtf8 txt)
(\cstr -> F.drawAnnotation dw (realToFrac x) (realToFrac y) cstr)
-- | Draws a circle on the image.
drawCircle :: (MonadResource m) => PDrawingWand
-> Double -- ^ origin x ordinate
-> Double -- ^ origin y ordinate
-> Double -- ^ perimeter x ordinate
-> Double -- ^ perimeter y ordinate
-> m ()
drawCircle dw ox oy px py = liftIO $ F.drawCircle dw (realToFrac ox) (realToFrac oy)
(realToFrac px) (realToFrac py)
-- | Composites an image onto the current image, using the specified
-- composition operator, specified position, and at the specified size.
drawComposite :: (MonadResource m) => PDrawingWand
-> CompositeOperator -- ^ composition operator
-> Double -- ^ x ordinate of top left corner
-> Double -- ^ y ordinate of top left corner
-> Double -- ^ width to resize image to prior to compositing, specify zero to use existing width
-> Double -- ^ height to resize image to prior to compositing, specify zero to use existing height
-> PMagickWand -- ^ image to composite is obtained from this wand
-> m ()
drawComposite dw compose x y w h dw' = withException_ dw $! F.drawComposite dw compose
(realToFrac x) (realToFrac y)
(realToFrac w) (realToFrac h) dw'
-- | Draws an ellipse on the image.
drawEllipse :: (MonadResource m) => PDrawingWand
-> Double -- ^ origin x ordinate
-> Double -- ^ origin y ordinate
-> Double -- ^ radius in x
-> Double -- ^ radius in y
-> Double -- ^ starting rotation in degrees
-> Double -- ^ ending rotation in degrees
-> m ()
drawEllipse dw ox oy rx ry start end = liftIO $ F.drawEllipse dw (realToFrac ox) (realToFrac oy)
(realToFrac rx) (realToFrac ry)
(realToFrac start) (realToFrac end)
-- | Draws a line on the image using the current stroke color,
-- stroke opacity, and stroke width.
drawLine :: (MonadResource m) => PDrawingWand
-> Double -- ^ starting x ordinate
-> Double -- ^ starting y ordinate
-> Double -- ^ ending x ordinate
-> Double -- ^ ending y ordinate
-> m ()
drawLine dw sx sy ex ey = liftIO $ F.drawLine dw (realToFrac sx) (realToFrac sy)
(realToFrac ex) (realToFrac ey)
-- | Draws a polygon using the current stroke, stroke width,
-- and fill color or texture, using the specified array of coordinates.
drawPolygon :: (MonadResource m) => PDrawingWand
-> [PointInfo] -- ^ coordinates
-> m ()
drawPolygon dw points = liftIO $ withArrayLen points $ \len arr ->
F.drawPolygon dw (fromIntegral len) arr
-- | Draws a rectangle given two coordinates
-- and using the current stroke, stroke width, and fill settings.
drawRectangle :: (MonadResource m) => PDrawingWand
-> Double -- ^ x ordinate of first coordinate
-> Double -- ^ y ordinate of first coordinate
-> Double -- ^ x ordinate of second coordinate
-> Double -- ^ y ordinate of second coordinate
-> m ()
drawRectangle dw x1 y1 x2 y2 = liftIO $ F.drawRectangle dw (realToFrac x1) (realToFrac y1)
(realToFrac x2) (realToFrac y2)
-- | DrawRoundRectangle() draws a rounted rectangle given two coordinates,
-- x & y corner radiuses and using the current stroke, stroke width, and fill settings.
drawRoundRectangle :: (MonadResource m) => PDrawingWand
-> Double -- ^ x ordinate of first coordinate
-> Double -- ^ y ordinate of first coordinate
-> Double -- ^ x ordinate of second coordinate
-> Double -- ^ y ordinate of second coordinate
-> Double -- ^ radius of corner in horizontal direction
-> Double -- ^ radius of corner in vertical direction
-> m ()
drawRoundRectangle p x1 y1 x2 y2 rx ry = liftIO $ F.drawRoundRectangle p (realToFrac x1)
(realToFrac y1)
(realToFrac x2)
(realToFrac y2)
(realToFrac rx)
(realToFrac ry)
-- | Clones the current drawing wand to create a new drawing wand.
-- The original drawing wand(s) may be returned to by invoking `popDrawingWand`.
-- The drawing wands are stored on a drawing wand stack. For every Pop there must
-- have already been an equivalent Push.
pushDrawingWand :: (MonadResource m) => PDrawingWand -> m ()
pushDrawingWand dw = withException_ dw $ F.pushDrawingWand dw
-- | Destroys the current drawing wand and returns to the
-- previously pushed drawing wand. Multiple drawing wands may exist.
-- It is an error to attempt to pop more drawing wands than have been pushed,
-- and it is proper form to pop all drawing wands which have been pushed.
popDrawingWand :: (MonadResource m) => PDrawingWand -> m ()
popDrawingWand dw = withException_ dw $ F.popDrawingWand dw
-- | Applies the specified rotation to the current coordinate space.
rotate :: (MonadResource m) => PDrawingWand -> Double -> m ()
rotate dw degrees = liftIO $ F.drawRotate dw (realToFrac degrees)
-- | Applies a translation to the current coordinate system
-- which moves the coordinate system origin to the specified coordinate.
translate :: (MonadResource m) => PDrawingWand -> Double -> Double -> m ()
translate dw x y = liftIO $ F.drawTranslate dw (realToFrac x) (realToFrac y)
-- | Indicates that subsequent commands up to a `popPattern` command comprise
-- the definition of a named pattern. The pattern space is assigned top left
-- corner coordinates, a width and height, and becomes its own drawing space.
-- Anything which can be drawn may be used in a pattern definition.
-- Named patterns may be used as stroke or brush definitions.
pushPattern :: (MonadResource m) => PDrawingWand
-> Text -- ^ pattern identification for later reference
-> Double -- x ordinate of top left corner
-> Double -- y ordinate of top left corner
-> Double -- width of pattern space
-> Double -- height of pattern space
-> m ()
pushPattern dw name x y w h = withException_ dw $!
useAsCString (encodeUtf8 name) (\cstr ->
F.drawPushPattern dw cstr
(realToFrac x) (realToFrac y)
(realToFrac w) (realToFrac h))
-- | Terminates a pattern definition.
popPattern :: (MonadResource m) => PDrawingWand -> m ()
popPattern dw = withException_ dw $! F.drawPopPattern dw
-- | DrawColor() draws color on image using the current fill color, starting at
-- specified position, and using specified paint method. The available paint methods are:
--
-- PointMethod: Recolors the target pixel
-- ReplaceMethod: Recolor any pixel that matches the target pixel.
-- FloodfillMethod: Recolors target pixels and matching neighbors.
-- ResetMethod: Recolor all pixels.
drawColor :: (MonadResource m) => PDrawingWand -> Double -> Double -> PaintMethod -> m ()
drawColor p x t m = liftIO $ F.drawColor p (realToFrac x) (realToFrac t) m
-- | Draws a point using the current fill color.
drawPoint :: (MonadResource m) => PDrawingWand -> Double -> Double -> m ()
drawPoint dw x y = liftIO $ F.drawPoint dw (realToFrac x) (realToFrac y)