-----------------------------------------------------------------------------
-- |
-- Module      :  Graphics.Rendering.Chart.Plot.Annotation
-- Copyright   :  (c) Tim Docker 2006, 2014
-- License     :  BSD-style (see chart/COPYRIGHT)
--
-- Show textual annotations on a chart.

{-# LANGUAGE TemplateHaskell #-}

module Graphics.Rendering.Chart.Plot.Annotation(
    PlotAnnotation(..),

    plot_annotation_hanchor,
    plot_annotation_vanchor,
    plot_annotation_angle,
    plot_annotation_style,
    plot_annotation_background,
    plot_annotation_values
) where

import Control.Lens
import Graphics.Rendering.Chart.Geometry
import Graphics.Rendering.Chart.Drawing
import Graphics.Rendering.Chart.Renderable
import Graphics.Rendering.Chart.Plot.Types
import Data.Default.Class

-- | Value for describing a series of text annotations
--   to be placed at arbitrary points on the graph. Annotations
--   can be rotated and styled.

data PlotAnnotation  x y = PlotAnnotation {
      PlotAnnotation x y -> HTextAnchor
_plot_annotation_hanchor :: HTextAnchor,
      PlotAnnotation x y -> VTextAnchor
_plot_annotation_vanchor :: VTextAnchor,
      PlotAnnotation x y -> Double
_plot_annotation_angle   :: Double,
      -- ^ Angle, in degrees, to rotate the annotation about the anchor point.
      PlotAnnotation x y -> FontStyle
_plot_annotation_style   :: FontStyle,
      PlotAnnotation x y -> Rectangle
_plot_annotation_background :: Rectangle,
      -- ^ Rectangle which style determines the background of the annotation
      -- text and which '_rect_minsize' determines the additional width and
      -- height of the background area
      PlotAnnotation x y -> [(x, y, String)]
_plot_annotation_values  :: [(x,y,String)]
}


instance ToPlot PlotAnnotation where
    toPlot :: PlotAnnotation x y -> Plot x y
toPlot PlotAnnotation x y
p = Plot :: forall x y.
(PointMapFn x y -> BackendProgram ())
-> [(String, Rect -> BackendProgram ())] -> ([x], [y]) -> Plot x y
Plot {
      _plot_render :: PointMapFn x y -> BackendProgram ()
_plot_render = PlotAnnotation x y -> PointMapFn x y -> BackendProgram ()
forall x y.
PlotAnnotation x y -> PointMapFn x y -> BackendProgram ()
renderAnnotation PlotAnnotation x y
p,
      _plot_legend :: [(String, Rect -> BackendProgram ())]
_plot_legend = [],
      _plot_all_points :: ([x], [y])
_plot_all_points = (((x, y, String) -> x) -> [(x, y, String)] -> [x]
forall a b. (a -> b) -> [a] -> [b]
map ((x, y, String) -> Getting x (x, y, String) x -> x
forall s a. s -> Getting a s a -> a
^.Getting x (x, y, String) x
forall s t a b. Field1 s t a b => Lens s t a b
_1) [(x, y, String)]
vs , ((x, y, String) -> y) -> [(x, y, String)] -> [y]
forall a b. (a -> b) -> [a] -> [b]
map ((x, y, String) -> Getting y (x, y, String) y -> y
forall s a. s -> Getting a s a -> a
^.Getting y (x, y, String) y
forall s t a b. Field2 s t a b => Lens s t a b
_2) [(x, y, String)]
vs)
    }
      where
        vs :: [(x, y, String)]
vs = PlotAnnotation x y -> [(x, y, String)]
forall x y. PlotAnnotation x y -> [(x, y, String)]
_plot_annotation_values PlotAnnotation x y
p


renderAnnotation :: PlotAnnotation x y -> PointMapFn x y -> BackendProgram ()
renderAnnotation :: PlotAnnotation x y -> PointMapFn x y -> BackendProgram ()
renderAnnotation PlotAnnotation x y
p PointMapFn x y
pMap = FontStyle -> BackendProgram () -> BackendProgram ()
forall a. FontStyle -> BackendProgram a -> BackendProgram a
withFontStyle FontStyle
style (BackendProgram () -> BackendProgram ())
-> BackendProgram () -> BackendProgram ()
forall a b. (a -> b) -> a -> b
$ do
                            ((x, y, String)
 -> ProgramT ChartBackendInstr Identity (PickFn Any))
-> [(x, y, String)] -> BackendProgram ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (x, y, String) -> ProgramT ChartBackendInstr Identity (PickFn Any)
forall a.
(x, y, String) -> ProgramT ChartBackendInstr Identity (PickFn a)
drawRect [(x, y, String)]
values
                            ((x, y, String) -> BackendProgram ())
-> [(x, y, String)] -> BackendProgram ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (x, y, String) -> BackendProgram ()
drawOne [(x, y, String)]
values
    where hta :: HTextAnchor
hta = PlotAnnotation x y -> HTextAnchor
forall x y. PlotAnnotation x y -> HTextAnchor
_plot_annotation_hanchor PlotAnnotation x y
p
          vta :: VTextAnchor
vta = PlotAnnotation x y -> VTextAnchor
forall x y. PlotAnnotation x y -> VTextAnchor
_plot_annotation_vanchor PlotAnnotation x y
p
          values :: [(x, y, String)]
values = PlotAnnotation x y -> [(x, y, String)]
forall x y. PlotAnnotation x y -> [(x, y, String)]
_plot_annotation_values PlotAnnotation x y
p
          angle :: Double
angle =  PlotAnnotation x y -> Double
forall x y. PlotAnnotation x y -> Double
_plot_annotation_angle PlotAnnotation x y
p
          style :: FontStyle
style =  PlotAnnotation x y -> FontStyle
forall x y. PlotAnnotation x y -> FontStyle
_plot_annotation_style PlotAnnotation x y
p
          rectangle :: Rectangle
rectangle = PlotAnnotation x y -> Rectangle
forall x y. PlotAnnotation x y -> Rectangle
_plot_annotation_background PlotAnnotation x y
p
          (Double
x1,Double
y1) = Rectangle -> (Double, Double)
_rect_minsize Rectangle
rectangle
          drawRect :: (x, y, String) -> ProgramT ChartBackendInstr Identity (PickFn a)
drawRect (x
x,y
y,String
s) = do
              TextSize
ts <- String -> BackendProgram TextSize
textSize String
s
              let (Double
x2,Double
y2) = (TextSize -> Double
textSizeWidth TextSize
ts, TextSize -> Double
textSizeHeight TextSize
ts)
                  Point Double
x3 Double
y3 = x -> y -> Point
point x
x y
y
                  -- position of top-left vertex of the rectangle
                  xvp :: HTextAnchor -> Double
xvp HTextAnchor
HTA_Left = Double
x3 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
x1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2
                  xvp HTextAnchor
HTA_Centre = Double
x3 Double -> Double -> Double
forall a. Num a => a -> a -> a
- (Double
x1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
x2) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2
                  xvp HTextAnchor
HTA_Right = Double
x3 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
x2 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
x1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2
                  yvp :: VTextAnchor -> Double
yvp VTextAnchor
VTA_Top = Double
y3 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
y1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2
                  yvp VTextAnchor
VTA_Centre = Double
y3 Double -> Double -> Double
forall a. Num a => a -> a -> a
- (Double
y1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
y2) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2
                  yvp VTextAnchor
VTA_Bottom = Double
y3 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
y2 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
y1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2
                  yvp VTextAnchor
VTA_BaseLine = Double
y3 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
y1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
- TextSize -> Double
textSizeAscent TextSize
ts
              Point
-> Rectangle -> ProgramT ChartBackendInstr Identity (PickFn a)
forall a. Point -> Rectangle -> BackendProgram (PickFn a)
drawRectangle (Double -> Double -> Point
Point (HTextAnchor -> Double
xvp HTextAnchor
hta) (VTextAnchor -> Double
yvp VTextAnchor
vta)) Rectangle
rectangle{ _rect_minsize :: (Double, Double)
_rect_minsize = (Double
x1Double -> Double -> Double
forall a. Num a => a -> a -> a
+Double
x2,Double
y1Double -> Double -> Double
forall a. Num a => a -> a -> a
+Double
y2) }
          drawOne :: (x, y, String) -> BackendProgram ()
drawOne (x
x,y
y,String
s) = HTextAnchor
-> VTextAnchor -> Double -> Point -> String -> BackendProgram ()
drawTextsR HTextAnchor
hta VTextAnchor
vta Double
angle (x -> y -> Point
point x
x y
y) String
s
          point :: x -> y -> Point
point x
x y
y = PointMapFn x y
pMap (x -> Limit x
forall a. a -> Limit a
LValue x
x, y -> Limit y
forall a. a -> Limit a
LValue y
y)

instance Default (PlotAnnotation x y) where
  def :: PlotAnnotation x y
def = PlotAnnotation :: forall x y.
HTextAnchor
-> VTextAnchor
-> Double
-> FontStyle
-> Rectangle
-> [(x, y, String)]
-> PlotAnnotation x y
PlotAnnotation 
    { _plot_annotation_hanchor :: HTextAnchor
_plot_annotation_hanchor = HTextAnchor
HTA_Centre
    , _plot_annotation_vanchor :: VTextAnchor
_plot_annotation_vanchor = VTextAnchor
VTA_Centre
    , _plot_annotation_angle :: Double
_plot_annotation_angle   = Double
0
    , _plot_annotation_style :: FontStyle
_plot_annotation_style   = FontStyle
forall a. Default a => a
def
    , _plot_annotation_background :: Rectangle
_plot_annotation_background = Rectangle
forall a. Default a => a
def
    , _plot_annotation_values :: [(x, y, String)]
_plot_annotation_values  = []
    }

$( makeLenses ''PlotAnnotation )