imagemagick-0.0.1: examples/gel.hs

{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
-- | Example taken from: http://members.shaw.ca/el.supremo/MagickWand/gel.htm
-- "Gel" Effects example
-- http://www.imagemagick.org/Usage/advanced/#gel_effects

import           Control.Exception.Lifted
import           Control.Monad                   (void)
import           Graphics.ImageMagick.MagickWand
import           Prelude                         hiding (catch)


main :: IO ()
main =
  withMagickWandGenesis $ do
  -- First step is to create the gel shape:
  {-
convert -size 100x60 xc:none \
          -fill red -draw 'circle    25,30  10,30' \
                    -draw 'circle    75,30  90,30' \
                    -draw 'rectangle 25,15  75,45' \
          gel_shape.png
-}
  localGenesis $ do
    -- Create a wand
    (_,mw) <- magickWand
    pw <- pixelWand
    (_,dw) <- drawingWand

    setSize mw 100 60
    readImage mw "xc:none"

    pw `setColor` "red"
    dw `setFillColor` pw
    drawCircle dw 25 30 10 30
    drawCircle dw 75 30 90 30
    drawRectangle dw 25 15 75 45

    -- Now we draw the Drawing wand on to the Magick Wand
    drawImage mw dw

    writeImage mw (Just "gel_shape.png")

  -- Next step is to create the gel highlight:
{-
convert gel_shape.png \
            \( +clone -fx A +matte  -blur 0x12  -shade 110x0 -normalize \
               -sigmoidal-contrast 16,60% -evaluate multiply .5 \
               -roll +5+10 +clone -compose Screen -composite \) \
            -compose In  -composite  gel_highlight.png
-}
  localGenesis $ do
    (_,mw) <- magickWand
    readImage mw "gel_shape.png"

    (_,mwc) <- cloneMagickWand mw
    (_,mwf) <- fxImage mwc "A"
    -- TODO: fails, should we ignore it?
    ignoreExceptions (mw `setImageAlphaChannel` deactivateAlphaChannel)

    blurImage mwf 0 12
    shadeImage mwf True 110 0

    normalizeImage mwf
    -- The last argument is specified as a percentage on the command line
    -- but is specified to the function as a percentage of the QuantumRange
    sigmoidalContrastImage mwf True 16 (0.6 * quantumRange)

    evaluateImage mwf multiplyEvaluateOperator 0.5
    rollImage mwf 5 10

    -- The +clone operation copies the original but only so that
    -- it can be used in the following composite operation, so we don't
    -- actually need to do a clone, just reference the original image.
    compositeImage mwf mw screenCompositeOp 0 0

    compositeImage mw mwf inCompositeOp 0 0
    writeImage mw (Just "gel_highlight.png")

  -- Now create the gel border
{-
convert gel_highlight.png \
            \( +clone -fx A  +matte -blur 0x2  -shade 0x90 -normalize \
               -blur 0x2  -negate -evaluate multiply .4 -negate -roll -.5-1 \
               +clone  -compose Multiply -composite \) \
            -compose In  -composite  gel_border.png

-}
  localGenesis $ do
    (_,mw) <- magickWand
    readImage mw "gel_highlight.png"
    (_,mwc) <- cloneMagickWand mw
    (_,mwf) <- fxImage mwc "A"
    ignoreExceptions (mwf `setImageAlphaChannel` deactivateAlphaChannel)
    blurImage mwf 0 2
    shadeImage mwf True 0 90
    normalizeImage mwf
    blurImage mwf 0 2
    negateImage mwf False
    evaluateImage mwf multiplyEvaluateOperator 0.4
    negateImage mwf False
    rollImage mwf (-0.5) (-1)
    compositeImage mwf mw multiplyCompositeOp 0 0
    compositeImage mw mwf inCompositeOp 0 0
    writeImage mw (Just "gel_border.png")

  -- and finally the text and shadow effect
{-
  convert gel_border.png \
      -font Candice  -pointsize 24  -fill white  -stroke black \
      -gravity Center  -annotate 0 "Gel"  -trim -repage 0x0+4+4 \
      \( +clone -background navy -shadow 80x4+4+4 \) +swap \
      -background none  -flatten    gel_button.png
-}
  localGenesis $ do
    (_,mw) <- magickWand
    (_,dw) <- drawingWand
    pw <- pixelWand
    readImage mw "gel_border.png"
    dw `setFont` "Lucida-Handwriting-Italic"
    dw `setFontSize` 24
    pw `setColor` "white"
    dw `setFillColor` pw
    pw `setColor` "black"
    dw `setStrokeColor` pw
    dw `setGravity` centerGravity
    -- It is important to notice here that MagickAnnotateImage renders the text on
    -- to the MagickWand, NOT the DrawingWand. It only uses the DrawingWand for font
    -- and colour information etc.
    annotateImage mw dw 0 0 0 "Gel"
    trimImage mw 0
    resetImagePage mw (Just "0x0+4+4")
    (_,mwc) <- cloneMagickWand mw
    pw `setColor` "navy"
    mwc `setImageBackgroundColor` pw
    shadowImage mwc 80 4 4 4
    (_,mwf) <- magickWand
    addImage mwf mwc
    addImage mwf mw
    pw `setColor` "none"
    mwf `setImageBackgroundColor` pw
    (_,mw') <- mergeImageLayers mwf flattenLayer
    writeImage mw' (Just "gel_button.png")

ignoreExceptions f = catch (void f) (\(_::MagickWandException) -> return ())