Attributes.hs

-----------------------------------------------------------------------------
-- |
-- Module      :  Graphics.Rendering.Diagrams.Attributes
-- Copyright   :  (c) Brent Yorgey 2008
-- License     :  BSD-style (see LICENSE)
-- Maintainer  :  byorgey@gmail.com
-- Stability   :  experimental
-- Portability :  portable
--
-- Attributes which can be added as annotations to a 'Diagram',
-- implemented via instances of 'AttrClass'.
--
-----------------------------------------------------------------------------
module Graphics.Rendering.Diagrams.Attributes
  ( defaultAttributes
  , fillColor, fc
  , lineColor, lc
  , lineWidth, lw
  , lineCap, C.LineCap(..)
  , lineJoin, C.LineJoin(..)
  , dashing

  , typeface, tf

  , stretch, scale, scaleX, scaleY
  , translate, translateX, translateY
  , rotate, rotateR

  ) where

import Graphics.Rendering.Diagrams.Types

import qualified Graphics.Rendering.Cairo as C


-- Fill color ----------------------

-- | Specify the default fill color for a 'Diagram'.
newtype Fill = Fill SomeColor
instance AttrClass Fill where
  renderAttr (Fill (SomeColor f)) = return (setEnvFillColor f)

-- | Draw a diagram using the given fill color.  Note that the new
--   color only applies to parts of the diagram which are not
--   otherwise colored; subdiagrams which already have an explicit
--   fill color will not be affected.  The default fill color is
--   completely transparent.
fillColor :: Color c => c -> Diagram -> Diagram
fillColor = Ann . Attr . Fill . SomeColor

-- | 'fc' is provided as a convenient short synonym for 'fillColor'.
fc :: Color c => c -> Diagram -> Diagram
fc = fillColor

-- Stroke color ----------------------

-- | Specify the default stroke color for a 'Diagram'.
newtype Stroke = Stroke SomeColor
instance AttrClass Stroke where
  renderAttr (Stroke (SomeColor sc)) = return (setEnvStrokeColor sc)

-- | Draw a diagram using the given color for lines.   Note that the new
--   color only applies to parts of the diagram which are not
--   otherwise colored; subdiagrams which already have an explicit
--   line color will not be affected.  The default line color is black.
lineColor :: Color c => c -> Diagram -> Diagram
lineColor = Ann . Attr . Stroke . SomeColor

-- | 'lc' is provided as a convenient short synonym for 'lineColor'.
lc :: Color c => c -> Diagram -> Diagram
lc = lineColor


-- Stroke width ------------------------------

-- | The stroke width to be used in drawing lines or shape outlines.
--   Note that the stroke width is measured in /device coordinates/,
--   so a stroke width of a certain size will look the same under any
--   uniform scaling.  Under non-uniform (i.e. different in the x and
--   y axes) scaling, however, strokes may look distorted.
newtype StrokeWidth = StrokeWidth Double  deriving (Eq, Show, Read)
instance AttrClass StrokeWidth where
  renderAttr (StrokeWidth w) = return (setEnvStrokeWidth w)

-- | Draw shape outlines and lines with the given width.  Note that
--   the line width is invariant under uniform scaling, although under
--   non-uniform scaling (scaling by different amounts in the x and y
--   axes) lines can become distorted.  The default line width is 1.
lineWidth :: Double -> Diagram -> Diagram
lineWidth = Ann . Attr . StrokeWidth

-- | 'lw' is provided as a convenient short synonym for 'lineWidth'.
lw :: Double -> Diagram -> Diagram
lw = lineWidth

-- Fonts -----------------------------

-- | Set the typeface for a text diagram
newtype Typeface = Typeface String deriving (Eq, Show, Read)
instance AttrClass Typeface where
  renderAttr (Typeface fontname) = c $ C.selectFontFace fontname C.FontSlantNormal C.FontWeightNormal >> return id

-- | Change the default typeface to one named.
typeface :: String -> Diagram -> Diagram
typeface fontname = Ann (Attr (Typeface fontname))

-- | Convenience function to change the typeface.
tf :: String -> Diagram -> Diagram
tf = typeface

-- Rotate ----------------------------

-- | Rotate a diagram clockwise through a certain number of radians.
newtype Rotate = Rotate Double  deriving (Eq, Show, Read)
instance AttrClass Rotate where
  renderAttr (Rotate d) = c $ C.rotate d >> return id

-- | @rotateR r@ rotates a diagram clockwise by @r@ radians.
rotateR :: Double -> Diagram -> Diagram
rotateR r = Ann (Attr (Rotate r))

-- | @rotate f@ rotates a diagram clockwise by fraction @f@ of a
--   complete revolution.  @rotate f@ is equivalent to @rotateR
--   (2*pi*f)@.
rotate :: Double -> Diagram -> Diagram
rotate f = rotateR (2*pi*f)


-- Translate ---------------------------

-- | Translate a diagram by the given offset.
newtype Translate = Translate Point  deriving (Eq, Show, Read)
instance AttrClass Translate where
  renderAttr (Translate (x,y)) = c $ C.translate x y >> return id

-- | Translate a diagram by the given relative offsets in the x and y
--   directions.  Note that the positive x-axis is to the right, while
--   the positive y-axis points downwards.
translate :: Double -> Double -> Diagram -> Diagram
translate 0  0  = id
translate dx dy = Ann (Attr (Translate (dx,dy)))

-- | Translate a diagram along the x-axis only.  @translateX x@ is
--   equivalent to @translate x 0@.
translateX :: Double -> Diagram -> Diagram
translateX dx = translate dx 0

-- | Translate a diagram along the y-axis only.  @translateY y@ is
--   equivalent to @translate 0 y@.
translateY :: Double -> Diagram -> Diagram
translateY dy = translate 0 dy



-- Scale --------------------------------

-- | Scale a diagram by the given scaling factors in the x and y axes,
--   respectively.
newtype Scale = Scale Point  deriving (Eq, Show, Read)
instance AttrClass Scale where
  attrSize (Scale k) s = k .*. s
  renderAttr (Scale (x,y)) = c $ C.scale x y >> return id

-- | Stretch a diagram by a separate scaling factor for each axis.
--   @stretch w h@ scales by a factor of @w@ in the x direction and
--   a factor of @h@ in the y direction.
stretch :: Double -> Double -> Diagram -> Diagram
stretch sx sy = Ann (Attr (Scale (sx,sy)))

-- | Scale by the same scaling factor in both dimensions, so the diagram
--   retains its aspect ratio.
scale :: Double -> Diagram -> Diagram
scale 1 = id
scale s = stretch s s

-- | Scale a diagram along the x-axis only.  @scaleX s@ is equivalent
--   to @stretch s 1@.
scaleX :: Double -> Diagram -> Diagram
scaleX sx = stretch sx 1

-- | Scale a diagram along the y-axis only.  @scaleY s@ is equivalent
--   to @stretch 1 s@.
scaleY :: Double -> Diagram -> Diagram
scaleY sy = stretch 1 sy


-- Stroke styles ----------------------------------

newtype LCap = LCap C.LineCap
instance AttrClass LCap where
  renderAttr (LCap lcap) = c $ C.setLineCap lcap >> return id

-- | Set the line cap style.  Valid values for 'LineCap' are
--   @LineCapButt@, @LineCapRound@, and @LineCapSquare@.
lineCap :: C.LineCap -> Diagram -> Diagram
lineCap = Ann . Attr . LCap

newtype LJoin = LJoin C.LineJoin
instance AttrClass LJoin where
  renderAttr (LJoin lj) = c $ C.setLineJoin lj >> return id

-- | Set the line join style.  Valid values for 'LineJoin' are
--   @LineJoinMiter@, @LineJoinRound@, and @LineJoinBevel@.
lineJoin :: C.LineJoin -> Diagram -> Diagram
lineJoin = Ann . Attr . LJoin

data Dashing = Dashing [Double] Double
instance AttrClass Dashing where
  renderAttr (Dashing ds offs) = c $ C.setDash ds offs >> return id

-- | Set the line dashing pattern.
dashing :: [Double]  -- ^ a list specifying alternate lengths of on
                     --   and off portions of the stroke.  The empty
                     --   list indicates no dashing.
        -> Double    -- ^ an offset into the dash pattern at which the
                     --   stroke should start
        -> Diagram -> Diagram
dashing ds offs = Ann (Attr (Dashing ds offs))

-- | Apply all the default attributes to a 'Diagram'.
defaultAttributes :: Diagram -> Diagram
defaultAttributes =
  case defaultDiaRenderEnv of
    (DREnv (SomeColor fillC) (SomeColor strokeC) strokeW) ->
      lc strokeC .
      lw strokeW .
      lineCap C.LineCapButt .
      lineJoin C.LineJoinMiter .
      dashing [] 0 .
      fc fillC