    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Graphics.Rendering.Chart.Drawing
    -- Copyright   :  (c) Tim Docker 2006, 2014
    -- License     :  BSD-style (see chart/COPYRIGHT)
    --
    -- This module contains basic types and functions used for drawing.
    --
    -- Note that Template Haskell is used to derive accessor functions
    -- (see 'Control.Lens') for each field of the following data types:
    --
    --    * 'PointStyle'
    --
    -- These accessors are not shown in this API documentation.  They have
    -- the same name as the field, but with the trailing underscore
    -- dropped. Hence for data field @f_::F@ in type @D@, they have type
    --
    -- @
    --   f :: Control.Lens.Lens' D F
    -- @
    --

    {-# LANGUAGE TemplateHaskell #-}

    module Graphics.Rendering.Chart.Drawing
      ( -- * Point Types and Drawing
        PointShape(..)
      , PointStyle(..)
      , drawPoint

      -- * Alignments and Paths
      , alignPath
      , alignFillPath
      , alignStrokePath
      , alignFillPoints
      , alignStrokePoints

      , alignFillPoint
      , alignStrokePoint

      , strokePointPath
      , fillPointPath

      -- * Transformation and Style Helpers
      , withRotation
      , withTranslation
      , withScale
      , withScaleX, withScaleY
      , withPointStyle
      , withDefaultStyle

      -- * Text Drawing
      , drawTextA
      , drawTextR
      , drawTextsR
      , textDrawRect
      , textDimension

      -- * Style Helpers
      , defaultColorSeq

      , solidLine
      , dashedLine

      , filledCircles
      , hollowCircles
      , filledPolygon
      , hollowPolygon
      , plusses
      , exes
      , stars
      , arrows

      , solidFillStyle

      -- * Backend and general Types
      , module Graphics.Rendering.Chart.Backend

      -- * Accessors
      , point_color
      , point_border_color
      , point_border_width
      , point_radius
      , point_shape
    ) where

    import Data.Default.Class
    -- lens < 4 includes Control.Lens.Zipper.moveTo which clashes
    -- with Graphics.Rendering.Chart.Geometry.moveTo (so you get
    -- -Wall notices). This would suggest a 'hiding (moveTo)' in
    -- the import, but it's been removed in lens-4.0 and I don't
    -- feel it's worth the use of conditional compilation. This does
    -- lead to the qualified Geometry import below.
    import Control.Lens
    import Data.Colour
    import Data.Colour.Names
    import Data.List (unfoldr)
    import Data.Monoid

    import Graphics.Rendering.Chart.Backend
    import Graphics.Rendering.Chart.Geometry hiding (moveTo)
    import qualified Graphics.Rendering.Chart.Geometry as G

    -- -----------------------------------------------------------------------
    -- Transformation helpers
    -- -----------------------------------------------------------------------

    -- | Apply a local rotation. The angle is given in radians.
    withRotation :: Double -> ChartBackend a -> ChartBackend a
    withRotation angle = withTransform (rotate angle 1)

    -- | Apply a local translation.
    withTranslation :: Point -> ChartBackend a -> ChartBackend a
    withTranslation p = withTransform (translate (pointToVec p) 1)

    -- | Apply a local scale.
    withScale :: Vector -> ChartBackend a -> ChartBackend a
    withScale v = withTransform (scale v 1)

    -- | Apply a local scale on the x-axis.
    withScaleX :: Double -> ChartBackend a -> ChartBackend a
    withScaleX x = withScale (Vector x 1)

    -- | Apply a local scale on the y-axis.
    withScaleY :: Double -> ChartBackend a -> ChartBackend a
    withScaleY y = withScale (Vector 1 y)

    -- | Changes the 'LineStyle' and 'FillStyle' to comply with
    --   the given 'PointStyle'.
    withPointStyle :: PointStyle -> ChartBackend a -> ChartBackend a
    withPointStyle (PointStyle cl bcl bw _ _) m =
      withLineStyle (def { _line_color = bcl, _line_width = bw }) $
        withFillStyle (solidFillStyle cl) m

    withDefaultStyle :: ChartBackend a -> ChartBackend a
    withDefaultStyle = withLineStyle def . withFillStyle def . withFontStyle def

    -- -----------------------------------------------------------------------
    -- Alignment Helpers
    -- -----------------------------------------------------------------------

    -- | Align the path by applying the given function on all points.
    alignPath :: (Point -> Point) -> Path -> Path
    alignPath f = foldPath (G.moveTo . f)
                           (lineTo . f)
                           (arc . f)
                           (arcNeg . f)
                           close

    -- | Align the path using the environment's alignment function for points.
    --   This is generally useful when stroking.
    --   See 'alignPath' and 'getPointAlignFn'.
    alignStrokePath :: Path -> ChartBackend Path
    alignStrokePath p = do
      f <- getPointAlignFn
      return $ alignPath f p

    -- | Align the path using the environment's alignment function for coordinates.
    --   This is generally useful when filling.
    --   See 'alignPath' and 'getCoordAlignFn'.
    alignFillPath :: Path -> ChartBackend Path
    alignFillPath p = do
      f <- getCoordAlignFn
      return $ alignPath f p

    -- | The points will be aligned by the 'getPointAlignFn', so that
    --   when drawing bitmaps, 1 pixel wide lines will be centred on the
    --   pixels.
    alignStrokePoints :: [Point] -> ChartBackend [Point]
    alignStrokePoints p = do
      f <- getPointAlignFn
      return $ fmap f p

    -- | The points will be aligned by the 'getCoordAlignFn', so that
    --   when drawing bitmaps, the edges of the region will fall between
    --   pixels.
    alignFillPoints :: [Point] -> ChartBackend [Point]
    alignFillPoints p = do
      f <- getCoordAlignFn
      return $ fmap f p

    -- | Align the point using the environment's alignment function for points.
    --   See 'getPointAlignFn'.
    alignStrokePoint :: Point -> ChartBackend Point
    alignStrokePoint p = do
        alignfn <- getPointAlignFn
        return (alignfn p)

    -- | Align the point using the environment's alignment function for coordinates.
    --   See 'getCoordAlignFn'.
    alignFillPoint :: Point -> ChartBackend Point
    alignFillPoint p = do
        alignfn <- getCoordAlignFn
        return (alignfn p)

    -- | Create a path by connecting all points with a line.
    --   The path is not closed.
    stepPath :: [Point] -> Path
    stepPath (p:ps) = G.moveTo p
                   <> mconcat (map lineTo ps)
    stepPath [] = mempty

    -- | Draw lines between the specified points.
    strokePointPath :: [Point] -> ChartBackend ()
    strokePointPath pts = strokePath $ stepPath pts

    -- | Fill the region with the given corners.
    fillPointPath :: [Point] -> ChartBackend ()
    fillPointPath pts = fillPath $ stepPath pts

    -- -----------------------------------------------------------------------
    -- Text Drawing
    -- -----------------------------------------------------------------------

    -- | Draw a line of text that is aligned at a different anchor point.
    --   See 'drawText'.
    drawTextA :: HTextAnchor -> VTextAnchor -> Point -> String -> ChartBackend ()
    drawTextA hta vta = drawTextR hta vta 0

    {-
       The following is useful for checking out the bounding-box
       calculation. At present it looks okay for PNG/Cairo but
       is a bit off for SVG/Diagrams; this may well be down to
       differences in how fonts are rendered in the two backends

    drawTextA hta vta p txt =
      drawTextR hta vta 0 p txt
      >> withLineStyle (solidLine 1 (opaque red))
         (textDrawRect hta vta p txt
           >>= \rect -> alignStrokePath (rectPath rect) >>= strokePath)
    -}

    -- | Draw a textual label anchored by one of its corners
    --   or edges, with rotation. Rotation angle is given in degrees,
    --   rotation is performed around anchor point.
    --   See 'drawText'.
    drawTextR :: HTextAnchor -> VTextAnchor -> Double -> Point -> String -> ChartBackend ()
    drawTextR hta vta angle p s =
      withTranslation p $
        withRotation theta $ do
          ts <- textSize s
          drawText (adjustText hta vta ts) s
      where
        theta = angle*pi/180.0

    -- | Draw a multi-line textual label anchored by one of its corners
    --   or edges, with rotation. Rotation angle is given in degrees,
    --   rotation is performed around anchor point.
    --   See 'drawText'.
    drawTextsR :: HTextAnchor -> VTextAnchor -> Double -> Point -> String -> ChartBackend ()
    drawTextsR hta vta angle p s = case num of
          0 -> return ()
          1 -> drawTextR hta vta angle p s
          _ ->
            withTranslation p $
              withRotation theta $ do
                tss <- mapM textSize ss
                let ts = head tss
                let -- widths = map textSizeWidth tss
                    -- maxw   = maximum widths
                    maxh   = maximum (map textSizeYBearing tss)
                    gap    = maxh / 2 -- half-line spacing
                    totalHeight = fromIntegral num*maxh +
                                  (fromIntegral num-1)*gap
                    ys = take num (unfoldr (\y-> Just (y, y-gap-maxh))
                                           (yinit vta ts totalHeight))
                    xs = map (adjustTextX hta) tss
                sequence_ (zipWith3 drawT xs ys ss)
        where
          ss   = lines s
          num  = length ss

          drawT x y = drawText (Point x y)
          theta = angle*pi/180.0

          yinit VTA_Top      ts _      = textSizeAscent ts
          yinit VTA_BaseLine _  _      = 0
          yinit VTA_Centre   ts height = height / 2 + textSizeAscent ts
          yinit VTA_Bottom   ts height = height + textSizeAscent ts

    -- | Calculate the correct offset to align the text anchor.
    adjustText :: HTextAnchor -> VTextAnchor -> TextSize -> Point
    adjustText hta vta ts = Point (adjustTextX hta ts) (adjustTextY vta ts)

    -- | Calculate the correct offset to align the horizontal anchor.
    adjustTextX :: HTextAnchor -> TextSize -> Double
    adjustTextX HTA_Left   _  = 0
    adjustTextX HTA_Centre ts = - (textSizeWidth ts / 2)
    adjustTextX HTA_Right  ts = - textSizeWidth ts

    -- | Calculate the correct offset to align the vertical anchor.
    adjustTextY :: VTextAnchor -> TextSize -> Double
    adjustTextY VTA_Top      ts = textSizeAscent ts
    adjustTextY VTA_Centre   ts = - textSizeYBearing ts / 2
    adjustTextY VTA_BaseLine _  = 0
    adjustTextY VTA_Bottom   ts = - textSizeDescent ts

    -- | Return the bounding rectangle for a text string positioned
    --   where it would be drawn by 'drawText'.
    --   See 'textSize'.
    textDrawRect :: HTextAnchor -> VTextAnchor -> Point -> String -> ChartBackend Rect
    textDrawRect hta vta (Point x y) s = do
      ts <- textSize s
      -- This does not account for the pixel width of the label; e.g.
      -- with a label "bread" and a large-enough foint size (e.g. 36)
      -- I have seen the right-hand edge of the bounding box go through
      -- the vertical part of the 'd' character (see chart-tests/tests/Test8.hs
      -- and bump up the label size).
      let (w,h,dh) = (textSizeWidth ts, textSizeHeight ts, textSizeDescent ts)
          lx = adjustTextX hta ts
          ly = adjustTextY vta ts
          (x',y') = (x + lx, y + ly + dh)
          p1 = Point x' (y' - h)
          p2 = Point (x' + w) y'
      return $ Rect p1 p2

    -- | Get the width and height of the string when rendered.
    --   See 'textSize'.
    textDimension :: String -> ChartBackend RectSize
    textDimension s = do
      ts <- textSize s
      return (textSizeWidth ts, textSizeHeight ts)

    -- -----------------------------------------------------------------------
    -- Point Types and Drawing
    -- -----------------------------------------------------------------------

    -- | The different shapes a point can have.
    data PointShape = PointShapeCircle           -- ^ A circle.
                    | PointShapePolygon Int Bool -- ^ Number of vertices and is right-side-up?
                    | PointShapePlus  -- ^ A plus sign.
                    | PointShapeCross -- ^ A cross.
                    | PointShapeStar  -- ^ Combination of a cross and a plus.
                    | PointShapeArrowHead Double

    -- | Abstract data type for the style of a plotted point.
    data PointStyle = PointStyle
      { _point_color :: AlphaColour Double
      -- ^ The color to fill the point with.
      , _point_border_color :: AlphaColour Double
      -- ^ The color to stroke the outline with.
      , _point_border_width :: Double
      -- ^ The width of the outline.
      , _point_radius :: Double
      -- ^ The radius of the tightest surrounding circle of the point.
      , _point_shape :: PointShape
      -- ^ The shape.
      }

    -- | Default style to use for points.
    instance Default PointStyle where
      def = PointStyle
        { _point_color        = opaque black
        , _point_border_color = transparent
        , _point_border_width = 0
        , _point_radius       = 1
        , _point_shape        = PointShapeCircle
        }

    -- | Draw a single point at the given location.
    drawPoint :: PointStyle  -- ^ Style to use when rendering the point.
              -> Point       -- ^ Position of the point to render.
              -> ChartBackend ()
    drawPoint ps@(PointStyle cl _ _ r shape) p = withPointStyle ps $ do
      p'@(Point x y) <- alignStrokePoint p
      case shape of
        PointShapeCircle -> do
          let path = arc p' r 0 (2*pi)
          fillPath path
          strokePath path
        PointShapePolygon sides isrot -> do
          let intToAngle n =
                if isrot
                then       fromIntegral n * 2*pi/fromIntegral sides
                else (0.5 + fromIntegral n)*2*pi/fromIntegral sides
              angles = map intToAngle [0 .. sides-1]
              (p1:p1s) = map (\a -> Point (x + r * sin a)
                                          (y + r * cos a)) angles
          let path = G.moveTo p1 <> mconcat (map lineTo p1s) <> lineTo p1
          fillPath path
          strokePath path
        PointShapeArrowHead theta ->
          withTranslation p $ withRotation (theta - pi/2) $
              drawPoint (filledPolygon r 3 True cl) (Point 0 0)
        PointShapePlus ->
          strokePath $ moveTo' (x+r) y
                    <> lineTo' (x-r) y
                    <> moveTo' x (y-r)
                    <> lineTo' x (y+r)
        PointShapeCross -> do
          let rad = r / sqrt 2
          strokePath $ moveTo' (x+rad) (y+rad)
                    <> lineTo' (x-rad) (y-rad)
                    <> moveTo' (x+rad) (y-rad)
                    <> lineTo' (x-rad) (y+rad)
        PointShapeStar -> do
          let rad = r / sqrt 2
          strokePath $ moveTo' (x+r) y
                    <> lineTo' (x-r) y
                    <> moveTo' x (y-r)
                    <> lineTo' x (y+r)
                    <> moveTo' (x+rad) (y+rad)
                    <> lineTo' (x-rad) (y-rad)
                    <> moveTo' (x+rad) (y-rad)
                    <> lineTo' (x-rad) (y+rad)

    -- -----------------------------------------------------------------------
    -- Style Helpers
    -- -----------------------------------------------------------------------

    -- | The default sequence of colours to use when plotings different data sets
    --   in a graph.
    defaultColorSeq :: [AlphaColour Double]
    defaultColorSeq = cycle $ map opaque [blue, red, green, yellow, cyan, magenta]

    -- | Create a solid line style (not dashed).
    solidLine :: Double             -- ^ Width of line.
              -> AlphaColour Double -- ^ Colour of line.
              -> LineStyle
    solidLine w cl = LineStyle w cl [] LineCapButt LineJoinMiter

    -- | Create a dashed line style.
    dashedLine :: Double   -- ^ Width of line.
               -> [Double] -- ^ The dash pattern in device coordinates.
               -> AlphaColour Double -- ^ Colour of line.
               -> LineStyle
    dashedLine w ds cl = LineStyle w cl ds LineCapButt LineJoinMiter

    -- | Style for filled circle points.
    filledCircles :: Double             -- ^ Radius of circle.
                  -> AlphaColour Double -- ^ Fill colour.
                  -> PointStyle
    filledCircles radius cl =
      PointStyle cl transparent 0 radius PointShapeCircle

    -- | Style for stroked circle points.
    hollowCircles :: Double -- ^ Radius of circle.
                  -> Double -- ^ Thickness of line.
                  -> AlphaColour Double -- Colour of line.
                  -> PointStyle
    hollowCircles radius w cl =
      PointStyle transparent cl w radius PointShapeCircle

    -- | Style for stroked polygon points.
    hollowPolygon :: Double -- ^ Radius of circle.
                  -> Double -- ^ Thickness of line.
                  -> Int    -- ^ Number of vertices.
                  -> Bool   -- ^ Is right-side-up?
                  -> AlphaColour Double -- ^ Colour of line.
                  -> PointStyle
    hollowPolygon radius w sides isrot cl =
      PointStyle transparent cl w radius (PointShapePolygon sides isrot)

    -- | Style for filled polygon points.
    filledPolygon :: Double -- ^ Radius of circle.
                  -> Int    -- ^ Number of vertices.
                  -> Bool   -- ^ Is right-side-up?
                  -> AlphaColour Double -- ^ Fill color.
                  -> PointStyle
    filledPolygon radius sides isrot cl =
      PointStyle cl transparent 0 radius (PointShapePolygon sides isrot)

    -- | Plus sign point style.
    plusses :: Double -- ^ Radius of tightest surrounding circle.
            -> Double -- ^ Thickness of line.
            -> AlphaColour Double -- ^ Color of line.
            -> PointStyle
    plusses radius w cl =
      PointStyle transparent cl w radius PointShapePlus

    -- | Cross point style.
    exes :: Double -- ^ Radius of circle.
         -> Double -- ^ Thickness of line.
         -> AlphaColour Double -- ^ Color of line.
         -> PointStyle
    exes radius w cl =
      PointStyle transparent cl w radius PointShapeCross

    -- | Combination of plus and cross point style.
    stars :: Double -- ^ Radius of circle.
          -> Double -- ^ Thickness of line.
          -> AlphaColour Double -- ^ Color of line.
          -> PointStyle
    stars radius w cl =
      PointStyle transparent cl w radius PointShapeStar

    arrows :: Double -- ^ Radius of circle.
           -> Double -- ^ Rotation (Tau)
           -> Double -- ^ Thickness of line.
           -> AlphaColour Double -- ^ Color of line.
           -> PointStyle
    arrows radius angle w cl =
      PointStyle transparent cl w radius (PointShapeArrowHead angle)

    -- | Fill style that fill everything this the given colour.
    solidFillStyle :: AlphaColour Double -> FillStyle
    solidFillStyle = FillStyleSolid

    $( makeLenses ''PointStyle )