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)