-----------------------------------------------------------------------------
-- |
-- Module      :  Graphics.Rendering.Chart.Axis.Types
-- Copyright   :  (c) Tim Docker 2006, 2014
-- License     :  BSD-style (see chart/COPYRIGHT)
--
-- Type definitions for Axes
--

{-# LANGUAGE TemplateHaskell #-}

module Graphics.Rendering.Chart.Axis.Types(
    AxisData(..),
    AxisVisibility(..),
    AxisT(..),
    AxisStyle(..),
    PlotValue(..),
    AxisFn,

    defaultAxisLineStyle,
    defaultGridLineStyle,

    makeAxis,
    makeAxis',

    axisToRenderable,
    renderAxisGrid,
    axisOverhang,
    vmap,
    invmap,

    linMap,
    invLinMap,

    axisGridAtTicks,
    axisGridAtBigTicks,
    axisGridAtLabels,
    axisGridHide,
    axisLabelsOverride,
    
    axis_show_line,
    axis_show_ticks,
    axis_show_labels,

    axis_visibility,
    axis_viewport,
    axis_tropweiv,
    axis_ticks,
    axis_labels,
    axis_grid,

    axis_line_style,
    axis_label_style,
    axis_grid_style,
    axis_label_gap,

) where

import Control.Monad
import Data.List(sort,intersperse)
import Control.Lens hiding (at, re)
import Data.Colour (opaque)
import Data.Colour.Names (black, lightgrey)
import Data.Default.Class

import Graphics.Rendering.Chart.Geometry
import Graphics.Rendering.Chart.Drawing
import Graphics.Rendering.Chart.Renderable

-- | A typeclass abstracting the functions we need
-- to be able to plot against an axis of type a
class Ord a => PlotValue a where
    toValue  :: a -> Double
    fromValue:: Double -> a
    autoAxis :: AxisFn a

-- | Configures whick visual elements of a axis are shown at the
--   appropriate edge of a plot area.
data AxisVisibility = AxisVisibility
  { -- | Whether to display a line along the axis.
    AxisVisibility -> Bool
_axis_show_line :: Bool
    
    -- | Whether to display the tick marks.
  , AxisVisibility -> Bool
_axis_show_ticks :: Bool

    -- | Whether to display the labels.
  , AxisVisibility -> Bool
_axis_show_labels :: Bool
  }

-- | The basic data associated with an axis showing values of type x.
data AxisData x = AxisData {
    
    -- | Which parts of the axis shall be displayed.
    AxisData x -> AxisVisibility
_axis_visibility :: AxisVisibility,
    
    -- | The _axis_viewport function maps values into device coordinates.
    AxisData x -> Range -> x -> Double
_axis_viewport :: Range -> x -> Double,

    -- | The _axis_tropweiv function maps device coordinates back to values.
    AxisData x -> Range -> Double -> x
_axis_tropweiv :: Range -> Double -> x,

    -- | The tick marks on the axis as pairs.
    --   The first element is the position on the axis
    --   (in viewport units) and the second element is the
    --   length of the tick in output coordinates.
    --   The tick starts on the axis, and positive numbers are drawn
    --   towards the plot area.
    AxisData x -> [(x, Double)]
_axis_ticks    :: [(x,Double)],

    -- | The labels on an axis as pairs. The first element of the pair
    --   is the position on the axis (in viewport units) and the
    --   second is the label text string. Note that multiple sets of
    --   labels can be specified, and are shown successively further
    --   away from the axis line.
    AxisData x -> [[(x, String)]]
_axis_labels   :: [[(x, String)]],

    -- | The positions on the axis (in viewport units) where
    --   we want to show grid lines.
    AxisData x -> [x]
_axis_grid     :: [ x ]
}

-- | Control values for how an axis gets displayed.
data AxisStyle = AxisStyle {
    -- | 'LineStyle' to use for axis line and ticks.
    AxisStyle -> LineStyle
_axis_line_style  :: LineStyle,
    -- | 'FontStyle' to use for axis labels.
    AxisStyle -> FontStyle
_axis_label_style :: FontStyle,
    -- | 'LineStyle' to use for axis grid.
    AxisStyle -> LineStyle
_axis_grid_style  :: LineStyle,

    -- | How far the labels are to be drawn from the axis.
    AxisStyle -> Double
_axis_label_gap   :: Double
}

-- | A function to generate the axis data, given the data values
--   to be plotted against it.
type AxisFn x = [x] -> AxisData x

-- | Collect the information we need to render an axis. The
--   bool is true if the axis direction is reversed.
data AxisT x = AxisT RectEdge AxisStyle Bool (AxisData x)

-- | Construct a renderable from an axis, in order that
-- it can be composed with other renderables and drawn. This
-- does not include the drawing of the grid, which must be done
-- separately by the `renderAxisGrid` function.
axisToRenderable :: AxisT x -> Renderable x
axisToRenderable :: AxisT x -> Renderable x
axisToRenderable AxisT x
at = Renderable :: forall a.
BackendProgram Range
-> (Range -> BackendProgram (PickFn a)) -> Renderable a
Renderable {
     minsize :: BackendProgram Range
minsize = AxisT x -> BackendProgram Range
forall x. AxisT x -> BackendProgram Range
minsizeAxis AxisT x
at,
     render :: Range -> BackendProgram (PickFn x)
render  = AxisT x -> Range -> BackendProgram (PickFn x)
forall x. AxisT x -> Range -> BackendProgram (PickFn x)
renderAxis AxisT x
at
  }

-- | Modifier to remove grid lines from an axis
axisGridHide         :: AxisData x -> AxisData x
axisGridHide :: AxisData x -> AxisData x
axisGridHide AxisData x
ad       = AxisData x
ad{ _axis_grid :: [x]
_axis_grid = [] }

-- | Modifier to position grid lines to line up with the ticks
axisGridAtTicks      :: AxisData x -> AxisData x
axisGridAtTicks :: AxisData x -> AxisData x
axisGridAtTicks AxisData x
ad    = AxisData x
ad{ _axis_grid :: [x]
_axis_grid = ((x, Double) -> x) -> [(x, Double)] -> [x]
forall a b. (a -> b) -> [a] -> [b]
map (x, Double) -> x
forall a b. (a, b) -> a
fst (AxisData x -> [(x, Double)]
forall x. AxisData x -> [(x, Double)]
_axis_ticks AxisData x
ad) }

-- | Modifier to position grid lines to line up with only the major ticks
axisGridAtBigTicks   :: AxisData x -> AxisData x
axisGridAtBigTicks :: AxisData x -> AxisData x
axisGridAtBigTicks AxisData x
ad = AxisData x
ad{ _axis_grid :: [x]
_axis_grid =
                            ((x, Double) -> x) -> [(x, Double)] -> [x]
forall a b. (a -> b) -> [a] -> [b]
map (x, Double) -> x
forall a b. (a, b) -> a
fst ([(x, Double)] -> [x]) -> [(x, Double)] -> [x]
forall a b. (a -> b) -> a -> b
$
                            ((x, Double) -> Bool) -> [(x, Double)] -> [(x, Double)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> [Double] -> Double
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum (((x, Double) -> Double) -> [(x, Double)] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (Double -> Double
forall a. Num a => a -> a
abs(Double -> Double)
-> ((x, Double) -> Double) -> (x, Double) -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(x, Double) -> Double
forall a b. (a, b) -> b
snd) (AxisData x -> [(x, Double)]
forall x. AxisData x -> [(x, Double)]
_axis_ticks AxisData x
ad)))(Double -> Bool) -> ((x, Double) -> Double) -> (x, Double) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(x, Double) -> Double
forall a b. (a, b) -> b
snd) ([(x, Double)] -> [(x, Double)]) -> [(x, Double)] -> [(x, Double)]
forall a b. (a -> b) -> a -> b
$
                            AxisData x -> [(x, Double)]
forall x. AxisData x -> [(x, Double)]
_axis_ticks AxisData x
ad }

-- | Modifier to position grid lines to line up with the labels
axisGridAtLabels     :: AxisData x -> AxisData x
axisGridAtLabels :: AxisData x -> AxisData x
axisGridAtLabels AxisData x
ad   = AxisData x
ad{ _axis_grid :: [x]
_axis_grid = ((x, String) -> x) -> [(x, String)] -> [x]
forall a b. (a -> b) -> [a] -> [b]
map (x, String) -> x
forall a b. (a, b) -> a
fst [(x, String)]
vs }
  where
    vs :: [(x, String)]
vs = case AxisData x -> [[(x, String)]]
forall x. AxisData x -> [[(x, String)]]
_axis_labels AxisData x
ad of
        [] -> []
        [[(x, String)]]
ls -> [[(x, String)]] -> [(x, String)]
forall a. [a] -> a
head [[(x, String)]]
ls

-- | Modifier to change labels on an axis
axisLabelsOverride  :: [(x,String)] -> AxisData x -> AxisData x
axisLabelsOverride :: [(x, String)] -> AxisData x -> AxisData x
axisLabelsOverride [(x, String)]
o AxisData x
ad = AxisData x
ad{ _axis_labels :: [[(x, String)]]
_axis_labels = [[(x, String)]
o] }

minsizeAxis :: AxisT x -> BackendProgram RectSize
minsizeAxis :: AxisT x -> BackendProgram Range
minsizeAxis (AxisT RectEdge
at AxisStyle
as Bool
_ AxisData x
ad) = do
    let labelVis :: Bool
labelVis = AxisVisibility -> Bool
_axis_show_labels (AxisVisibility -> Bool) -> AxisVisibility -> Bool
forall a b. (a -> b) -> a -> b
$ AxisData x -> AxisVisibility
forall x. AxisData x -> AxisVisibility
_axis_visibility AxisData x
ad
        tickVis :: Bool
tickVis  = AxisVisibility -> Bool
_axis_show_ticks  (AxisVisibility -> Bool) -> AxisVisibility -> Bool
forall a b. (a -> b) -> a -> b
$ AxisData x -> AxisVisibility
forall x. AxisData x -> AxisVisibility
_axis_visibility AxisData x
ad
        labels :: [[String]]
labels = if Bool
labelVis then AxisData x -> [[String]]
forall a. AxisData a -> [[String]]
labelTexts AxisData x
ad else []
        ticks :: [(x, Double)]
ticks = if Bool
tickVis then AxisData x -> [(x, Double)]
forall x. AxisData x -> [(x, Double)]
_axis_ticks AxisData x
ad else []
    [[Range]]
labelSizes <- FontStyle -> BackendProgram [[Range]] -> BackendProgram [[Range]]
forall a. FontStyle -> BackendProgram a -> BackendProgram a
withFontStyle (AxisStyle -> FontStyle
_axis_label_style AxisStyle
as) (BackendProgram [[Range]] -> BackendProgram [[Range]])
-> BackendProgram [[Range]] -> BackendProgram [[Range]]
forall a b. (a -> b) -> a -> b
$
                    ([String] -> ProgramT ChartBackendInstr Identity [Range])
-> [[String]] -> BackendProgram [[Range]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((String -> BackendProgram Range)
-> [String] -> ProgramT ChartBackendInstr Identity [Range]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> BackendProgram Range
textDimension) [[String]]
labels

    let ag :: Double
ag      = AxisStyle -> Double
_axis_label_gap AxisStyle
as
    let tsize :: Double
tsize   = [Double] -> Double
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Double
0 Double -> [Double] -> [Double]
forall a. a -> [a] -> [a]
: [ Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
0 (-Double
l) | (x
_,Double
l) <- [(x, Double)]
ticks ])

    let hw :: Double
hw = [Double] -> Double
forall a. (Num a, Ord a) => [a] -> a
maximum0 (([Range] -> Double) -> [[Range]] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map ([Double] -> Double
forall a. (Num a, Ord a) => [a] -> a
maximum0([Double] -> Double) -> ([Range] -> [Double]) -> [Range] -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Range -> Double) -> [Range] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map Range -> Double
forall a b. (a, b) -> a
fst) [[Range]]
labelSizes)
    let hh :: Double
hh = Double
ag Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
tsize Double -> Double -> Double
forall a. Num a => a -> a -> a
+ ([Double] -> Double
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Double] -> Double)
-> ([[Range]] -> [Double]) -> [[Range]] -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> [Double] -> [Double]
forall a. a -> [a] -> [a]
intersperse Double
ag ([Double] -> [Double])
-> ([[Range]] -> [Double]) -> [[Range]] -> [Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Range] -> Double) -> [[Range]] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map ([Double] -> Double
forall a. (Num a, Ord a) => [a] -> a
maximum0([Double] -> Double) -> ([Range] -> [Double]) -> [Range] -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Range -> Double) -> [Range] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map Range -> Double
forall a b. (a, b) -> b
snd) ([[Range]] -> Double) -> [[Range]] -> Double
forall a b. (a -> b) -> a -> b
$ [[Range]]
labelSizes)

    let vw :: Double
vw = Double
ag Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
tsize Double -> Double -> Double
forall a. Num a => a -> a -> a
+ ([Double] -> Double
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Double] -> Double)
-> ([[Range]] -> [Double]) -> [[Range]] -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> [Double] -> [Double]
forall a. a -> [a] -> [a]
intersperse Double
ag ([Double] -> [Double])
-> ([[Range]] -> [Double]) -> [[Range]] -> [Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Range] -> Double) -> [[Range]] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map ([Double] -> Double
forall a. (Num a, Ord a) => [a] -> a
maximum0([Double] -> Double) -> ([Range] -> [Double]) -> [Range] -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Range -> Double) -> [Range] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map Range -> Double
forall a b. (a, b) -> a
fst) ([[Range]] -> Double) -> [[Range]] -> Double
forall a b. (a -> b) -> a -> b
$ [[Range]]
labelSizes)
    let vh :: Double
vh = [Double] -> Double
forall a. (Num a, Ord a) => [a] -> a
maximum0 (([Range] -> Double) -> [[Range]] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map ([Double] -> Double
forall a. (Num a, Ord a) => [a] -> a
maximum0([Double] -> Double) -> ([Range] -> [Double]) -> [Range] -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Range -> Double) -> [Range] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map Range -> Double
forall a b. (a, b) -> b
snd) [[Range]]
labelSizes)

    let sz :: Range
sz      = case RectEdge
at of
                    RectEdge
E_Top    -> (Double
hw,Double
hh)
                    RectEdge
E_Bottom -> (Double
hw,Double
hh)
                    RectEdge
E_Left   -> (Double
vw,Double
vh)
                    RectEdge
E_Right  -> (Double
vw,Double
vh)
    Range -> BackendProgram Range
forall (m :: * -> *) a. Monad m => a -> m a
return Range
sz

labelTexts :: AxisData a -> [[String]]
labelTexts :: AxisData a -> [[String]]
labelTexts AxisData a
ad = ([(a, String)] -> [String]) -> [[(a, String)]] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map (((a, String) -> String) -> [(a, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (a, String) -> String
forall a b. (a, b) -> b
snd) (AxisData a -> [[(a, String)]]
forall x. AxisData x -> [[(x, String)]]
_axis_labels AxisData a
ad)

maximum0 :: (Num a, Ord a) => [a] -> a
maximum0 :: [a] -> a
maximum0 [] = a
0
maximum0 [a]
vs = [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [a]
vs

-- | Calculate the amount by which the labels extend beyond
--   the ends of the axis.
axisOverhang :: (Ord x) => AxisT x -> BackendProgram (Double,Double)
axisOverhang :: AxisT x -> BackendProgram Range
axisOverhang (AxisT RectEdge
at AxisStyle
as Bool
_ AxisData x
ad) = do
    let labels :: [String]
labels = ((x, String) -> String) -> [(x, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (x, String) -> String
forall a b. (a, b) -> b
snd ([(x, String)] -> [String])
-> (AxisData x -> [(x, String)]) -> AxisData x -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(x, String)] -> [(x, String)]
forall a. Ord a => [a] -> [a]
sort ([(x, String)] -> [(x, String)])
-> (AxisData x -> [(x, String)]) -> AxisData x -> [(x, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[(x, String)]] -> [(x, String)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(x, String)]] -> [(x, String)])
-> (AxisData x -> [[(x, String)]]) -> AxisData x -> [(x, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AxisData x -> [[(x, String)]]
forall x. AxisData x -> [[(x, String)]]
_axis_labels (AxisData x -> [String]) -> AxisData x -> [String]
forall a b. (a -> b) -> a -> b
$ AxisData x
ad
    [Range]
labelSizes <- FontStyle
-> ProgramT ChartBackendInstr Identity [Range]
-> ProgramT ChartBackendInstr Identity [Range]
forall a. FontStyle -> BackendProgram a -> BackendProgram a
withFontStyle (AxisStyle -> FontStyle
_axis_label_style AxisStyle
as) (ProgramT ChartBackendInstr Identity [Range]
 -> ProgramT ChartBackendInstr Identity [Range])
-> ProgramT ChartBackendInstr Identity [Range]
-> ProgramT ChartBackendInstr Identity [Range]
forall a b. (a -> b) -> a -> b
$
      (String -> BackendProgram Range)
-> [String] -> ProgramT ChartBackendInstr Identity [Range]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> BackendProgram Range
textDimension [String]
labels
    case [Range]
labelSizes of
      []  -> Range -> BackendProgram Range
forall (m :: * -> *) a. Monad m => a -> m a
return (Double
0,Double
0)
      [Range]
ls  -> let l1 :: Range
l1     = [Range] -> Range
forall a. [a] -> a
head [Range]
ls
                 l2 :: Range
l2     = [Range] -> Range
forall a. [a] -> a
last [Range]
ls
                 ohangv :: BackendProgram Range
ohangv = Range -> BackendProgram Range
forall (m :: * -> *) a. Monad m => a -> m a
return (Range -> Double
forall a b. (a, b) -> b
snd Range
l1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2, Range -> Double
forall a b. (a, b) -> b
snd Range
l2 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2)
                 ohangh :: BackendProgram Range
ohangh = Range -> BackendProgram Range
forall (m :: * -> *) a. Monad m => a -> m a
return (Range -> Double
forall a b. (a, b) -> a
fst Range
l1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2, Range -> Double
forall a b. (a, b) -> a
fst Range
l2 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2)
             in case RectEdge
at of
                 RectEdge
E_Top    -> BackendProgram Range
ohangh
                 RectEdge
E_Bottom -> BackendProgram Range
ohangh
                 RectEdge
E_Left   -> BackendProgram Range
ohangv
                 RectEdge
E_Right  -> BackendProgram Range
ohangh

renderAxis :: AxisT x -> RectSize -> BackendProgram (PickFn x)
renderAxis :: AxisT x -> Range -> BackendProgram (PickFn x)
renderAxis at :: AxisT x
at@(AxisT RectEdge
et AxisStyle
as Bool
_ AxisData x
ad) Range
sz = do
  let ls :: LineStyle
ls = AxisStyle -> LineStyle
_axis_line_style AxisStyle
as
      vis :: AxisVisibility
vis = AxisData x -> AxisVisibility
forall x. AxisData x -> AxisVisibility
_axis_visibility AxisData x
ad
  Bool
-> ProgramT ChartBackendInstr Identity ()
-> ProgramT ChartBackendInstr Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (AxisVisibility -> Bool
_axis_show_line AxisVisibility
vis) (ProgramT ChartBackendInstr Identity ()
 -> ProgramT ChartBackendInstr Identity ())
-> ProgramT ChartBackendInstr Identity ()
-> ProgramT ChartBackendInstr Identity ()
forall a b. (a -> b) -> a -> b
$ 
    LineStyle
-> ProgramT ChartBackendInstr Identity ()
-> ProgramT ChartBackendInstr Identity ()
forall a. LineStyle -> BackendProgram a -> BackendProgram a
withLineStyle (LineStyle
ls {_line_cap :: LineCap
_line_cap = LineCap
LineCapSquare}) (ProgramT ChartBackendInstr Identity ()
 -> ProgramT ChartBackendInstr Identity ())
-> ProgramT ChartBackendInstr Identity ()
-> ProgramT ChartBackendInstr Identity ()
forall a b. (a -> b) -> a -> b
$ do
      [Point]
p <- [Point] -> BackendProgram [Point]
alignStrokePoints [Double -> Double -> Point
Point Double
sx Double
sy,Double -> Double -> Point
Point Double
ex Double
ey]
      [Point] -> ProgramT ChartBackendInstr Identity ()
strokePointPath [Point]
p
  Bool
-> ProgramT ChartBackendInstr Identity ()
-> ProgramT ChartBackendInstr Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (AxisVisibility -> Bool
_axis_show_ticks AxisVisibility
vis) (ProgramT ChartBackendInstr Identity ()
 -> ProgramT ChartBackendInstr Identity ())
-> ProgramT ChartBackendInstr Identity ()
-> ProgramT ChartBackendInstr Identity ()
forall a b. (a -> b) -> a -> b
$ 
    LineStyle
-> ProgramT ChartBackendInstr Identity ()
-> ProgramT ChartBackendInstr Identity ()
forall a. LineStyle -> BackendProgram a -> BackendProgram a
withLineStyle (LineStyle
ls {_line_cap :: LineCap
_line_cap = LineCap
LineCapButt}) (ProgramT ChartBackendInstr Identity ()
 -> ProgramT ChartBackendInstr Identity ())
-> ProgramT ChartBackendInstr Identity ()
-> ProgramT ChartBackendInstr Identity ()
forall a b. (a -> b) -> a -> b
$ 
      ((x, Double) -> ProgramT ChartBackendInstr Identity ())
-> [(x, Double)] -> ProgramT ChartBackendInstr Identity ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (x, Double) -> ProgramT ChartBackendInstr Identity ()
drawTick (AxisData x -> [(x, Double)]
forall x. AxisData x -> [(x, Double)]
_axis_ticks AxisData x
ad)
  Bool
-> ProgramT ChartBackendInstr Identity ()
-> ProgramT ChartBackendInstr Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (AxisVisibility -> Bool
_axis_show_labels AxisVisibility
vis) (ProgramT ChartBackendInstr Identity ()
 -> ProgramT ChartBackendInstr Identity ())
-> ProgramT ChartBackendInstr Identity ()
-> ProgramT ChartBackendInstr Identity ()
forall a b. (a -> b) -> a -> b
$ 
    FontStyle
-> ProgramT ChartBackendInstr Identity ()
-> ProgramT ChartBackendInstr Identity ()
forall a. FontStyle -> BackendProgram a -> BackendProgram a
withFontStyle (AxisStyle -> FontStyle
_axis_label_style AxisStyle
as) (ProgramT ChartBackendInstr Identity ()
 -> ProgramT ChartBackendInstr Identity ())
-> ProgramT ChartBackendInstr Identity ()
-> ProgramT ChartBackendInstr Identity ()
forall a b. (a -> b) -> a -> b
$ do
      [[Range]]
labelSizes <- ([String] -> ProgramT ChartBackendInstr Identity [Range])
-> [[String]] -> BackendProgram [[Range]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((String -> BackendProgram Range)
-> [String] -> ProgramT ChartBackendInstr Identity [Range]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> BackendProgram Range
textDimension) (AxisData x -> [[String]]
forall a. AxisData a -> [[String]]
labelTexts AxisData x
ad)
      let sizes :: [Double]
sizes = ([Range] -> Double) -> [[Range]] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map ((Double -> Double -> Double
forall a. Num a => a -> a -> a
+Double
ag)(Double -> Double) -> ([Range] -> Double) -> [Range] -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[Double] -> Double
forall a. (Num a, Ord a) => [a] -> a
maximum0([Double] -> Double) -> ([Range] -> [Double]) -> [Range] -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Range -> Double) -> [Range] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map Range -> Double
forall b. (b, b) -> b
coord) [[Range]]
labelSizes
      let offsets :: [Double]
offsets = (Double -> Double -> Double) -> Double -> [Double] -> [Double]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl Double -> Double -> Double
forall a. Num a => a -> a -> a
(+) Double
ag [Double]
sizes
      ((Double, [(x, String)]) -> ProgramT ChartBackendInstr Identity ())
-> [(Double, [(x, String)])]
-> ProgramT ChartBackendInstr Identity ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Double, [(x, String)]) -> ProgramT ChartBackendInstr Identity ()
drawLabels ([Double] -> [[(x, String)]] -> [(Double, [(x, String)])]
forall a b. [a] -> [b] -> [(a, b)]
zip [Double]
offsets  (AxisData x -> [[(x, String)]]
forall x. AxisData x -> [[(x, String)]]
_axis_labels AxisData x
ad))
  PickFn x -> BackendProgram (PickFn x)
forall (m :: * -> *) a. Monad m => a -> m a
return PickFn x
pickfn
 where
   (Double
sx,Double
sy,Double
ex,Double
ey,Vector
tp,x -> Point
axisPoint,Point -> x
invAxisPoint) = AxisT x
-> Range
-> (Double, Double, Double, Double, Vector, x -> Point, Point -> x)
forall z.
AxisT z
-> Range
-> (Double, Double, Double, Double, Vector, z -> Point, Point -> z)
axisMapping AxisT x
at Range
sz

   drawTick :: (x, Double) -> ProgramT ChartBackendInstr Identity ()
drawTick (x
value,Double
len) =
       let t1 :: Point
t1 = x -> Point
axisPoint x
value
           t2 :: Point
t2 = Point
t1 Point -> Vector -> Point
`pvadd` Double -> Vector -> Vector
vscale Double
len Vector
tp
       in [Point] -> BackendProgram [Point]
alignStrokePoints [Point
t1,Point
t2] BackendProgram [Point]
-> ([Point] -> ProgramT ChartBackendInstr Identity ())
-> ProgramT ChartBackendInstr Identity ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Point] -> ProgramT ChartBackendInstr Identity ()
strokePointPath

   (HTextAnchor
hta,VTextAnchor
vta,(b, b) -> b
coord,Double -> Vector
awayFromAxis) = case RectEdge
et of
       RectEdge
E_Top    -> (HTextAnchor
HTA_Centre, VTextAnchor
VTA_Bottom, (b, b) -> b
forall a b. (a, b) -> b
snd, \Double
v -> Double -> Double -> Vector
Vector Double
0 (-Double
v))
       RectEdge
E_Bottom -> (HTextAnchor
HTA_Centre, VTextAnchor
VTA_Top,    (b, b) -> b
forall a b. (a, b) -> b
snd, \Double
v -> Double -> Double -> Vector
Vector Double
0 Double
v)
       RectEdge
E_Left   -> (HTextAnchor
HTA_Right,  VTextAnchor
VTA_Centre, (b, b) -> b
forall a b. (a, b) -> a
fst, \Double
v -> Double -> Double -> Vector
Vector (-Double
v) Double
0)
       RectEdge
E_Right  -> (HTextAnchor
HTA_Left,   VTextAnchor
VTA_Centre, (b, b) -> b
forall a b. (a, b) -> a
fst, \Double
v -> Double -> Double -> Vector
Vector Double
v Double
0)

   avoidOverlaps :: [(x, String)] -> ProgramT ChartBackendInstr Identity [(x, String)]
avoidOverlaps [(x, String)]
labels = do
       [(Rect, (x, String))]
rects <- ((x, String)
 -> ProgramT ChartBackendInstr Identity (Rect, (x, String)))
-> [(x, String)]
-> ProgramT ChartBackendInstr Identity [(Rect, (x, String))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (x, String)
-> ProgramT ChartBackendInstr Identity (Rect, (x, String))
labelDrawRect [(x, String)]
labels
       [(x, String)] -> ProgramT ChartBackendInstr Identity [(x, String)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(x, String)]
 -> ProgramT ChartBackendInstr Identity [(x, String)])
-> [(x, String)]
-> ProgramT ChartBackendInstr Identity [(x, String)]
forall a b. (a -> b) -> a -> b
$ ((Rect, (x, String)) -> (x, String))
-> [(Rect, (x, String))] -> [(x, String)]
forall a b. (a -> b) -> [a] -> [b]
map (Rect, (x, String)) -> (x, String)
forall a b. (a, b) -> b
snd ([(Rect, (x, String))] -> [(x, String)])
-> ([[(Rect, (x, String))]] -> [(Rect, (x, String))])
-> [[(Rect, (x, String))]]
-> [(x, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[(Rect, (x, String))]] -> [(Rect, (x, String))]
forall a. [a] -> a
head ([[(Rect, (x, String))]] -> [(Rect, (x, String))])
-> ([[(Rect, (x, String))]] -> [[(Rect, (x, String))]])
-> [[(Rect, (x, String))]]
-> [(Rect, (x, String))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(Rect, (x, String))] -> Bool)
-> [[(Rect, (x, String))]] -> [[(Rect, (x, String))]]
forall a. (a -> Bool) -> [a] -> [a]
filter ([Rect] -> Bool
noOverlaps ([Rect] -> Bool)
-> ([(Rect, (x, String))] -> [Rect])
-> [(Rect, (x, String))]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Rect, (x, String)) -> Rect) -> [(Rect, (x, String))] -> [Rect]
forall a b. (a -> b) -> [a] -> [b]
map (Rect, (x, String)) -> Rect
forall a b. (a, b) -> a
fst)
              ([[(Rect, (x, String))]] -> [(x, String)])
-> [[(Rect, (x, String))]] -> [(x, String)]
forall a b. (a -> b) -> a -> b
$ (Int -> [(Rect, (x, String))]) -> [Int] -> [[(Rect, (x, String))]]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> [(Rect, (x, String))] -> [(Rect, (x, String))]
forall a. Int -> [a] -> [a]
`eachNth` [(Rect, (x, String))]
rects) [Int
0 .. [(Rect, (x, String))] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Rect, (x, String))]
rects]

   labelDrawRect :: (x, String)
-> ProgramT ChartBackendInstr Identity (Rect, (x, String))
labelDrawRect (x
value,String
s) = do
       let pt :: Point
pt = x -> Point
axisPoint x
value Point -> Vector -> Point
`pvadd` Double -> Vector
awayFromAxis Double
ag
       Rect
r <- HTextAnchor
-> VTextAnchor -> Point -> String -> BackendProgram Rect
textDrawRect HTextAnchor
hta VTextAnchor
vta Point
pt String
s
       (Rect, (x, String))
-> ProgramT ChartBackendInstr Identity (Rect, (x, String))
forall (m :: * -> *) a. Monad m => a -> m a
return (Rect -> Rect
hBufferRect Rect
r,(x
value,String
s))

   drawLabels :: (Double, [(x, String)]) -> ProgramT ChartBackendInstr Identity ()
drawLabels (Double
offset,[(x, String)]
labels) = do
        [(x, String)]
labels' <- [(x, String)] -> ProgramT ChartBackendInstr Identity [(x, String)]
avoidOverlaps [(x, String)]
labels
        ((x, String) -> BackendProgram Range)
-> [(x, String)] -> ProgramT ChartBackendInstr Identity ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (x, String) -> BackendProgram Range
drawLabel [(x, String)]
labels'
     where
       drawLabel :: (x, String) -> BackendProgram Range
drawLabel (x
value,String
s) = do
           HTextAnchor
-> VTextAnchor
-> Point
-> String
-> ProgramT ChartBackendInstr Identity ()
drawTextA HTextAnchor
hta VTextAnchor
vta (x -> Point
axisPoint x
value Point -> Vector -> Point
`pvadd` Double -> Vector
awayFromAxis Double
offset) String
s
           String -> BackendProgram Range
textDimension String
s

   ag :: Double
ag = AxisStyle -> Double
_axis_label_gap AxisStyle
as
   pickfn :: PickFn x
pickfn = x -> Maybe x
forall a. a -> Maybe a
Just (x -> Maybe x) -> (Point -> x) -> PickFn x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point -> x
invAxisPoint

hBufferRect :: Rect -> Rect
hBufferRect :: Rect -> Rect
hBufferRect (Rect Point
p (Point Double
x Double
y)) = Point -> Point -> Rect
Rect Point
p (Point -> Rect) -> Point -> Rect
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Point
Point Double
x' Double
y
  where x' :: Double
x' = Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
wDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
2
        w :: Double
w = Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
- Point -> Double
p_x Point
p

noOverlaps :: [Rect] -> Bool
noOverlaps :: [Rect] -> Bool
noOverlaps [] = Bool
True
noOverlaps [Rect
_] = Bool
True
noOverlaps (Rect
x:Rect
y:[Rect]
l) | Rect -> Rect -> Bool
rectsOverlap Rect
x Rect
y = Bool
False
                   | Bool
otherwise        = [Rect] -> Bool
noOverlaps (Rect
yRect -> [Rect] -> [Rect]
forall a. a -> [a] -> [a]
:[Rect]
l)

rectsOverlap :: Rect -> Rect -> Bool
rectsOverlap :: Rect -> Rect -> Bool
rectsOverlap (Rect Point
p1 Point
p2) Rect
r = (Point -> Bool) -> [Point] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Rect -> Point -> Bool
withinRect Rect
r) [Point]
ps
  where (Point Double
x1 Double
y1) = Point
p1
        (Point Double
x2 Double
y2) = Point
p2
        p3 :: Point
p3 = Double -> Double -> Point
Point Double
x1 Double
y2
        p4 :: Point
p4 = Double -> Double -> Point
Point Double
x2 Double
y1
        ps :: [Point]
ps = [Point
p1,Point
p2,Point
p3,Point
p4]

eachNth :: Int -> [a] -> [a]
eachNth :: Int -> [a] -> [a]
eachNth Int
n = [a] -> [a]
forall a. [a] -> [a]
skipN
  where
    n' :: Int
n' = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    skipN :: [a] -> [a]
skipN [] = []
    skipN (a
x:[a]
xs) = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a]
skipN (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
n' [a]
xs)

withinRect :: Rect -> Point -> Bool
withinRect :: Rect -> Point -> Bool
withinRect (Rect (Point Double
x1 Double
y1) (Point Double
x2 Double
y2)) (Point Double
x Double
y)
    = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
x1 Bool -> Bool -> Bool
&& Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
x2,
           Double
y Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
y1 Bool -> Bool -> Bool
&& Double
y Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
y2]

axisMapping :: AxisT z -> RectSize
               -> (Double,Double,Double,Double,Vector,z->Point,Point->z)
axisMapping :: AxisT z
-> Range
-> (Double, Double, Double, Double, Vector, z -> Point, Point -> z)
axisMapping (AxisT RectEdge
et AxisStyle
_ Bool
rev AxisData z
ad) (Double
x2,Double
y2) = case RectEdge
et of
    RectEdge
E_Top    -> (Double
x1,Double
y2,Double
x2,Double
y2, Double -> Double -> Vector
Vector Double
0 Double
1,    Double -> z -> Point
mapx Double
y2, Point -> z
imapx)
    RectEdge
E_Bottom -> (Double
x1,Double
y1,Double
x2,Double
y1, Double -> Double -> Vector
Vector Double
0 (-Double
1), Double -> z -> Point
mapx Double
y1, Point -> z
imapx)
    RectEdge
E_Left   -> (Double
x2,Double
y2,Double
x2,Double
y1, Double -> Double -> Vector
Vector Double
1 Double
0,    Double -> z -> Point
mapy Double
x2, Point -> z
imapy) 
    RectEdge
E_Right  -> (Double
x1,Double
y2,Double
x1,Double
y1, Double -> Double -> Vector
Vector (-Double
1) Double
0, Double -> z -> Point
mapy Double
x1, Point -> z
imapy)
  where
    (Double
x1,Double
y1) = (Double
0,Double
0)
    xr :: Range
xr = Range -> Range
forall a. (a, a) -> (a, a)
reverseR (Double
x1,Double
x2)
    yr :: Range
yr = Range -> Range
forall a. (a, a) -> (a, a)
reverseR (Double
y2,Double
y1)

    mapx :: Double -> z -> Point
mapx Double
y z
x = Double -> Double -> Point
Point (AxisData z -> Range -> z -> Double
forall x. AxisData x -> Range -> x -> Double
_axis_viewport AxisData z
ad Range
xr z
x) Double
y
    mapy :: Double -> z -> Point
mapy Double
x z
y = Double -> Double -> Point
Point Double
x (AxisData z -> Range -> z -> Double
forall x. AxisData x -> Range -> x -> Double
_axis_viewport AxisData z
ad Range
yr z
y)

    imapx :: Point -> z
imapx (Point Double
x Double
_) = AxisData z -> Range -> Double -> z
forall x. AxisData x -> Range -> Double -> x
_axis_tropweiv AxisData z
ad Range
xr Double
x
    imapy :: Point -> z
imapy (Point Double
_ Double
y) = AxisData z -> Range -> Double -> z
forall x. AxisData x -> Range -> Double -> x
_axis_tropweiv AxisData z
ad Range
yr Double
y

    reverseR :: (a, a) -> (a, a)
reverseR r :: (a, a)
r@(a
r0,a
r1)  = if Bool
rev then (a
r1,a
r0) else (a, a)
r

-- 
renderAxisGrid :: RectSize -> AxisT z -> BackendProgram ()
renderAxisGrid :: Range -> AxisT z -> ProgramT ChartBackendInstr Identity ()
renderAxisGrid sz :: Range
sz@(Double
w,Double
h) at :: AxisT z
at@(AxisT RectEdge
re AxisStyle
as Bool
_ AxisData z
ad) = 
    LineStyle
-> ProgramT ChartBackendInstr Identity ()
-> ProgramT ChartBackendInstr Identity ()
forall a. LineStyle -> BackendProgram a -> BackendProgram a
withLineStyle (AxisStyle -> LineStyle
_axis_grid_style AxisStyle
as) (ProgramT ChartBackendInstr Identity ()
 -> ProgramT ChartBackendInstr Identity ())
-> ProgramT ChartBackendInstr Identity ()
-> ProgramT ChartBackendInstr Identity ()
forall a b. (a -> b) -> a -> b
$ 
      (z -> ProgramT ChartBackendInstr Identity ())
-> [z] -> ProgramT ChartBackendInstr Identity ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (RectEdge -> z -> ProgramT ChartBackendInstr Identity ()
drawGridLine RectEdge
re) (AxisData z -> [z]
forall x. AxisData x -> [x]
_axis_grid AxisData z
ad)
  where
    (Double
_,Double
_,Double
_,Double
_,Vector
_,z -> Point
axisPoint,Point -> z
_) = AxisT z
-> Range
-> (Double, Double, Double, Double, Vector, z -> Point, Point -> z)
forall z.
AxisT z
-> Range
-> (Double, Double, Double, Double, Vector, z -> Point, Point -> z)
axisMapping AxisT z
at Range
sz

    drawGridLine :: RectEdge -> z -> ProgramT ChartBackendInstr Identity ()
drawGridLine RectEdge
E_Top    = z -> ProgramT ChartBackendInstr Identity ()
vline
    drawGridLine RectEdge
E_Bottom = z -> ProgramT ChartBackendInstr Identity ()
vline
    drawGridLine RectEdge
E_Left   = z -> ProgramT ChartBackendInstr Identity ()
hline
    drawGridLine RectEdge
E_Right  = z -> ProgramT ChartBackendInstr Identity ()
hline

    vline :: z -> ProgramT ChartBackendInstr Identity ()
vline z
v = let v' :: Double
v' = Point -> Double
p_x (z -> Point
axisPoint z
v)
              in [Point] -> BackendProgram [Point]
alignStrokePoints [Double -> Double -> Point
Point Double
v' Double
0,Double -> Double -> Point
Point Double
v' Double
h] BackendProgram [Point]
-> ([Point] -> ProgramT ChartBackendInstr Identity ())
-> ProgramT ChartBackendInstr Identity ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Point] -> ProgramT ChartBackendInstr Identity ()
strokePointPath

    hline :: z -> ProgramT ChartBackendInstr Identity ()
hline z
v = let v' :: Double
v' = Point -> Double
p_y (z -> Point
axisPoint z
v)
              in [Point] -> BackendProgram [Point]
alignStrokePoints [Double -> Double -> Point
Point Double
0 Double
v',Double -> Double -> Point
Point Double
w Double
v'] BackendProgram [Point]
-> ([Point] -> ProgramT ChartBackendInstr Identity ())
-> ProgramT ChartBackendInstr Identity ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Point] -> ProgramT ChartBackendInstr Identity ()
strokePointPath


-- | Construct an axis given the positions for ticks, grid lines, and 
-- labels, and the labelling function
makeAxis :: PlotValue x => ([x] -> [String]) -> ([x],[x],[x]) -> AxisData x
makeAxis :: ([x] -> [String]) -> ([x], [x], [x]) -> AxisData x
makeAxis [x] -> [String]
labelf ([x]
labelvs, [x]
tickvs, [x]
gridvs) = AxisData :: forall x.
AxisVisibility
-> (Range -> x -> Double)
-> (Range -> Double -> x)
-> [(x, Double)]
-> [[(x, String)]]
-> [x]
-> AxisData x
AxisData {
    _axis_visibility :: AxisVisibility
_axis_visibility = AxisVisibility
forall a. Default a => a
def,
    _axis_viewport :: Range -> x -> Double
_axis_viewport = Range -> x -> Double
newViewport,
    _axis_tropweiv :: Range -> Double -> x
_axis_tropweiv = Range -> Double -> x
newTropweiv,
    _axis_ticks :: [(x, Double)]
_axis_ticks    = [(x, Double)]
newTicks,
    _axis_grid :: [x]
_axis_grid     = [x]
gridvs,
    _axis_labels :: [[(x, String)]]
_axis_labels   = [[(x, String)]
newLabels]
    }
  where
    newViewport :: Range -> x -> Double
newViewport = (x, x) -> Range -> x -> Double
forall x. PlotValue x => (x, x) -> Range -> x -> Double
vmap (x
min',x
max')
    newTropweiv :: Range -> Double -> x
newTropweiv = (x, x) -> Range -> Double -> x
forall x. PlotValue x => (x, x) -> Range -> Double -> x
invmap (x
min',x
max')
    newTicks :: [(x, Double)]
newTicks    = [ (x
v,Double
2)        | x
v <- [x]
tickvs  ] [(x, Double)] -> [(x, Double)] -> [(x, Double)]
forall a. [a] -> [a] -> [a]
++ [ (x
v,Double
5) | x
v <- [x]
labelvs ]
    newLabels :: [(x, String)]
newLabels   = [x] -> [String] -> [(x, String)]
forall a b. [a] -> [b] -> [(a, b)]
zipWithLengthCheck [x]
labelvs ([x] -> [String]
labelf [x]
labelvs)
      where
        zipWithLengthCheck :: [a] -> [b] -> [(a, b)]
zipWithLengthCheck (a
x:[a]
xs) (b
y:[b]
ys) = (a
x,b
y) (a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
: [a] -> [b] -> [(a, b)]
zipWithLengthCheck [a]
xs [b]
ys
        zipWithLengthCheck [] [] = []
        zipWithLengthCheck [a]
_ [b]
_ =
          String -> [(a, b)]
forall a. HasCallStack => String -> a
error String
"makeAxis: label function returned the wrong number of labels"

    min' :: x
min'        = [x] -> x
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [x]
labelvs
    max' :: x
max'        = [x] -> x
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [x]
labelvs

-- | Construct an axis given the positions for ticks, grid lines, and 
-- labels, and the positioning and labelling functions
makeAxis' :: Ord x => (x -> Double) -> (Double -> x) -> ([x] -> [String])
                   -> ([x],[x],[x]) -> AxisData x
makeAxis' :: (x -> Double)
-> (Double -> x)
-> ([x] -> [String])
-> ([x], [x], [x])
-> AxisData x
makeAxis' x -> Double
t Double -> x
f [x] -> [String]
labelf ([x]
labelvs, [x]
tickvs, [x]
gridvs) = AxisData :: forall x.
AxisVisibility
-> (Range -> x -> Double)
-> (Range -> Double -> x)
-> [(x, Double)]
-> [[(x, String)]]
-> [x]
-> AxisData x
AxisData {
    _axis_visibility :: AxisVisibility
_axis_visibility = AxisVisibility
forall a. Default a => a
def,
    _axis_viewport :: Range -> x -> Double
_axis_viewport = (x -> Double) -> (x, x) -> Range -> x -> Double
forall a. (a -> Double) -> (a, a) -> Range -> a -> Double
linMap x -> Double
t ([x] -> x
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [x]
labelvs, [x] -> x
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [x]
labelvs),
    _axis_tropweiv :: Range -> Double -> x
_axis_tropweiv = (Double -> x) -> (x -> Double) -> (x, x) -> Range -> Double -> x
forall a.
(Double -> a) -> (a -> Double) -> (a, a) -> Range -> Double -> a
invLinMap Double -> x
f x -> Double
t ([x] -> x
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [x]
labelvs, [x] -> x
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [x]
labelvs),
    _axis_ticks :: [(x, Double)]
_axis_ticks    = [x] -> [Double] -> [(x, Double)]
forall a b. [a] -> [b] -> [(a, b)]
zip [x]
tickvs (Double -> [Double]
forall a. a -> [a]
repeat Double
2)  [(x, Double)] -> [(x, Double)] -> [(x, Double)]
forall a. [a] -> [a] -> [a]
++  [x] -> [Double] -> [(x, Double)]
forall a b. [a] -> [b] -> [(a, b)]
zip [x]
labelvs (Double -> [Double]
forall a. a -> [a]
repeat Double
5),
    _axis_grid :: [x]
_axis_grid     = [x]
gridvs,
    _axis_labels :: [[(x, String)]]
_axis_labels   =
      let zipWithLengthCheck :: [a] -> [b] -> [(a, b)]
zipWithLengthCheck (a
x:[a]
xs) (b
y:[b]
ys) = (a
x,b
y) (a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
: [a] -> [b] -> [(a, b)]
zipWithLengthCheck [a]
xs [b]
ys
          zipWithLengthCheck [] [] = []
          zipWithLengthCheck [a]
_ [b]
_ =
            String -> [(a, b)]
forall a. HasCallStack => String -> a
error String
"makeAxis': label function returned the wrong number of labels"
      in [[x] -> [String] -> [(x, String)]
forall a b. [a] -> [b] -> [(a, b)]
zipWithLengthCheck [x]
labelvs ([x] -> [String]
labelf [x]
labelvs)]
    }


----------------------------------------------------------------------

-- | The default 'LineStyle' of an axis.
defaultAxisLineStyle :: LineStyle
defaultAxisLineStyle :: LineStyle
defaultAxisLineStyle = Double -> AlphaColour Double -> LineStyle
solidLine Double
1 (AlphaColour Double -> LineStyle)
-> AlphaColour Double -> LineStyle
forall a b. (a -> b) -> a -> b
$ Colour Double -> AlphaColour Double
forall a. Num a => Colour a -> AlphaColour a
opaque Colour Double
forall a. Num a => Colour a
black

-- | The default 'LineStyle' of a plot area grid.
defaultGridLineStyle :: LineStyle
defaultGridLineStyle :: LineStyle
defaultGridLineStyle = Double -> [Double] -> AlphaColour Double -> LineStyle
dashedLine Double
1 [Double
5,Double
5] (AlphaColour Double -> LineStyle)
-> AlphaColour Double -> LineStyle
forall a b. (a -> b) -> a -> b
$ Colour Double -> AlphaColour Double
forall a. Num a => Colour a -> AlphaColour a
opaque Colour Double
forall a. (Ord a, Floating a) => Colour a
lightgrey

instance Default AxisStyle where
  def :: AxisStyle
def = AxisStyle :: LineStyle -> FontStyle -> LineStyle -> Double -> AxisStyle
AxisStyle 
    { _axis_line_style :: LineStyle
_axis_line_style  = LineStyle
defaultAxisLineStyle
    , _axis_label_style :: FontStyle
_axis_label_style = FontStyle
forall a. Default a => a
def
    , _axis_grid_style :: LineStyle
_axis_grid_style  = LineStyle
defaultGridLineStyle
    , _axis_label_gap :: Double
_axis_label_gap   = Double
10
    }

-- | By default all parts of a axis are visible.
instance Default AxisVisibility where
  def :: AxisVisibility
def = AxisVisibility :: Bool -> Bool -> Bool -> AxisVisibility
AxisVisibility
    { _axis_show_line :: Bool
_axis_show_line   = Bool
True
    , _axis_show_ticks :: Bool
_axis_show_ticks  = Bool
True
    , _axis_show_labels :: Bool
_axis_show_labels = Bool
True
    }

----------------------------------------------------------------------

-- | A linear mapping of points in one range to another.
vmap :: PlotValue x => (x,x) -> Range -> x -> Double
vmap :: (x, x) -> Range -> x -> Double
vmap (x
v1,x
v2) (Double
v3,Double
v4) x
v = Double
v3 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (x -> Double
forall a. PlotValue a => a -> Double
toValue x
v Double -> Double -> Double
forall a. Num a => a -> a -> a
- x -> Double
forall a. PlotValue a => a -> Double
toValue x
v1) Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
v4Double -> Double -> Double
forall a. Num a => a -> a -> a
-Double
v3)
                              Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (x -> Double
forall a. PlotValue a => a -> Double
toValue x
v2 Double -> Double -> Double
forall a. Num a => a -> a -> a
- x -> Double
forall a. PlotValue a => a -> Double
toValue x
v1)

-- | The inverse mapping from device co-ordinate range back to
--   interesting values.
invmap :: PlotValue x => (x,x) -> Range -> Double -> x
invmap :: (x, x) -> Range -> Double -> x
invmap (x
v3,x
v4) (Double
d1,Double
d2) Double
d = Double -> x
forall a. PlotValue a => Double -> a
fromValue (x -> Double
forall a. PlotValue a => a -> Double
toValue x
v3 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ ( (Double
dDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
d1) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
doubleRange
                                                   Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
d2Double -> Double -> Double
forall a. Num a => a -> a -> a
-Double
d1) ))
    where doubleRange :: Double
doubleRange = x -> Double
forall a. PlotValue a => a -> Double
toValue x
v4 Double -> Double -> Double
forall a. Num a => a -> a -> a
- x -> Double
forall a. PlotValue a => a -> Double
toValue x
v3

-- | A linear mapping of points in one range to another.
linMap :: (a -> Double) -> (a,a) -> Range -> a -> Double
linMap :: (a -> Double) -> (a, a) -> Range -> a -> Double
linMap a -> Double
f (a
x1,a
x2) (Double
d1,Double
d2) a
x =
    Double
d1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (Double
d2 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
d1) Double -> Double -> Double
forall a. Num a => a -> a -> a
* (a -> Double
f a
x Double -> Double -> Double
forall a. Num a => a -> a -> a
- a -> Double
f a
x1) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (a -> Double
f a
x2 Double -> Double -> Double
forall a. Num a => a -> a -> a
- a -> Double
f a
x1)

-- | An inverse linear mapping of points from one range to another.
invLinMap :: (Double -> a) -> (a -> Double) -> (a,a) -> Range -> Double -> a
invLinMap :: (Double -> a) -> (a -> Double) -> (a, a) -> Range -> Double -> a
invLinMap Double -> a
f a -> Double
t (a
v3,a
v4) (Double
d1,Double
d2) Double
d =
    Double -> a
f (a -> Double
t a
v3 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ ( (Double
dDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
d1) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
doubleRange Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
d2Double -> Double -> Double
forall a. Num a => a -> a -> a
-Double
d1) ))
  where
    doubleRange :: Double
doubleRange = a -> Double
t a
v4 Double -> Double -> Double
forall a. Num a => a -> a -> a
- a -> Double
t a
v3

$( makeLenses ''AxisVisibility )
$( makeLenses ''AxisData )
$( makeLenses ''AxisStyle )