{-# 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
class Ord a => PlotValue a where
toValue :: a -> Double
fromValue:: Double -> a
autoAxis :: AxisFn a
data AxisVisibility = AxisVisibility
{
AxisVisibility -> Bool
_axis_show_line :: Bool
, AxisVisibility -> Bool
_axis_show_ticks :: Bool
, AxisVisibility -> Bool
_axis_show_labels :: Bool
}
data AxisData x = AxisData {
forall x. AxisData x -> AxisVisibility
_axis_visibility :: AxisVisibility,
forall x. AxisData x -> Range -> x -> Double
_axis_viewport :: Range -> x -> Double,
forall x. AxisData x -> Range -> Double -> x
_axis_tropweiv :: Range -> Double -> x,
forall x. AxisData x -> [(x, Double)]
_axis_ticks :: [(x,Double)],
forall x. AxisData x -> [[(x, String)]]
_axis_labels :: [[(x, String)]],
forall x. AxisData x -> [x]
_axis_grid :: [ x ]
}
data AxisStyle = AxisStyle {
AxisStyle -> LineStyle
_axis_line_style :: LineStyle,
AxisStyle -> FontStyle
_axis_label_style :: FontStyle,
AxisStyle -> LineStyle
_axis_grid_style :: LineStyle,
AxisStyle -> Double
_axis_label_gap :: Double
}
type AxisFn x = [x] -> AxisData x
data AxisT x = AxisT RectEdge AxisStyle Bool (AxisData x)
axisToRenderable :: AxisT x -> Renderable x
axisToRenderable :: forall x. AxisT x -> Renderable x
axisToRenderable AxisT x
at = Renderable {
minsize :: BackendProgram Range
minsize = forall x. AxisT x -> BackendProgram Range
minsizeAxis AxisT x
at,
render :: Range -> BackendProgram (PickFn x)
render = forall x. AxisT x -> Range -> BackendProgram (PickFn x)
renderAxis AxisT x
at
}
axisGridHide :: AxisData x -> AxisData x
axisGridHide :: forall x. AxisData x -> AxisData x
axisGridHide AxisData x
ad = AxisData x
ad{ _axis_grid :: [x]
_axis_grid = [] }
axisGridAtTicks :: AxisData x -> AxisData x
axisGridAtTicks :: forall x. AxisData x -> AxisData x
axisGridAtTicks AxisData x
ad = AxisData x
ad{ _axis_grid :: [x]
_axis_grid = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst (forall x. AxisData x -> [(x, Double)]
_axis_ticks AxisData x
ad) }
axisGridAtBigTicks :: AxisData x -> AxisData x
axisGridAtBigTicks :: forall x. AxisData x -> AxisData x
axisGridAtBigTicks AxisData x
ad = AxisData x
ad{ _axis_grid :: [x]
_axis_grid =
forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$
forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Ord a => a -> a -> Bool
> forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum (forall a b. (a -> b) -> [a] -> [b]
map (forall a. Num a => a -> a
absforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (a, b) -> b
snd) (forall x. AxisData x -> [(x, Double)]
_axis_ticks AxisData x
ad)))forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (a, b) -> b
snd) forall a b. (a -> b) -> a -> b
$
forall x. AxisData x -> [(x, Double)]
_axis_ticks AxisData x
ad }
axisGridAtLabels :: AxisData x -> AxisData x
axisGridAtLabels :: forall x. AxisData x -> AxisData x
axisGridAtLabels AxisData x
ad = AxisData x
ad{ _axis_grid :: [x]
_axis_grid = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(x, String)]
vs }
where
vs :: [(x, String)]
vs = case forall x. AxisData x -> [[(x, String)]]
_axis_labels AxisData x
ad of
[] -> []
[[(x, String)]]
ls -> forall a. [a] -> a
head [[(x, String)]]
ls
axisLabelsOverride :: [(x,String)] -> AxisData x -> AxisData x
axisLabelsOverride :: forall x. [(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 :: forall x. AxisT x -> BackendProgram Range
minsizeAxis (AxisT RectEdge
at AxisStyle
as Bool
_ AxisData x
ad) = do
let labelVis :: Bool
labelVis = AxisVisibility -> Bool
_axis_show_labels forall a b. (a -> b) -> a -> b
$ forall x. AxisData x -> AxisVisibility
_axis_visibility AxisData x
ad
tickVis :: Bool
tickVis = AxisVisibility -> Bool
_axis_show_ticks forall a b. (a -> b) -> a -> b
$ forall x. AxisData x -> AxisVisibility
_axis_visibility AxisData x
ad
labels :: [[String]]
labels = if Bool
labelVis then forall a. AxisData a -> [[String]]
labelTexts AxisData x
ad else []
ticks :: [(x, Double)]
ticks = if Bool
tickVis then forall x. AxisData x -> [(x, Double)]
_axis_ticks AxisData x
ad else []
[[Range]]
labelSizes <- forall a. FontStyle -> BackendProgram a -> BackendProgram a
withFontStyle (AxisStyle -> FontStyle
_axis_label_style AxisStyle
as) forall a b. (a -> b) -> a -> b
$
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (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 = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Double
0 forall a. a -> [a] -> [a]
: [ forall a. Ord a => a -> a -> a
max Double
0 (-Double
l) | (x
_,Double
l) <- [(x, Double)]
ticks ])
let hw :: Double
hw = forall a. (Num a, Ord a) => [a] -> a
maximum0 (forall a b. (a -> b) -> [a] -> [b]
map (forall a. (Num a, Ord a) => [a] -> a
maximum0forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst) [[Range]]
labelSizes)
let hh :: Double
hh = Double
ag forall a. Num a => a -> a -> a
+ Double
tsize forall a. Num a => a -> a -> a
+ (forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [a] -> [a]
intersperse Double
ag forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a. (Num a, Ord a) => [a] -> a
maximum0forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd) forall a b. (a -> b) -> a -> b
$ [[Range]]
labelSizes)
let vw :: Double
vw = Double
ag forall a. Num a => a -> a -> a
+ Double
tsize forall a. Num a => a -> a -> a
+ (forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [a] -> [a]
intersperse Double
ag forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a. (Num a, Ord a) => [a] -> a
maximum0forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst) forall a b. (a -> b) -> a -> b
$ [[Range]]
labelSizes)
let vh :: Double
vh = forall a. (Num a, Ord a) => [a] -> a
maximum0 (forall a b. (a -> b) -> [a] -> [b]
map (forall a. (Num a, Ord a) => [a] -> a
maximum0forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (a -> b) -> [a] -> [b]
map 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)
forall (m :: * -> *) a. Monad m => a -> m a
return Range
sz
labelTexts :: AxisData a -> [[String]]
labelTexts :: forall a. AxisData a -> [[String]]
labelTexts AxisData a
ad = forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd) (forall x. AxisData x -> [[(x, String)]]
_axis_labels AxisData a
ad)
maximum0 :: (Num a, Ord a) => [a] -> a
maximum0 :: forall a. (Num a, Ord a) => [a] -> a
maximum0 [] = a
0
maximum0 [a]
vs = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [a]
vs
axisOverhang :: (Ord x) => AxisT x -> BackendProgram (Double,Double)
axisOverhang :: forall x. Ord x => AxisT x -> BackendProgram Range
axisOverhang (AxisT RectEdge
at AxisStyle
as Bool
_ AxisData x
ad) = do
let labels :: [String]
labels = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> [a]
sort forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. AxisData x -> [[(x, String)]]
_axis_labels forall a b. (a -> b) -> a -> b
$ AxisData x
ad
[Range]
labelSizes <- forall a. FontStyle -> BackendProgram a -> BackendProgram a
withFontStyle (AxisStyle -> FontStyle
_axis_label_style AxisStyle
as) forall a b. (a -> b) -> a -> b
$
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
[] -> forall (m :: * -> *) a. Monad m => a -> m a
return (Double
0,Double
0)
[Range]
ls -> let l1 :: Range
l1 = forall a. [a] -> a
head [Range]
ls
l2 :: Range
l2 = forall a. [a] -> a
last [Range]
ls
ohangv :: BackendProgram Range
ohangv = forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. (a, b) -> b
snd Range
l1 forall a. Fractional a => a -> a -> a
/ Double
2, forall a b. (a, b) -> b
snd Range
l2 forall a. Fractional a => a -> a -> a
/ Double
2)
ohangh :: BackendProgram Range
ohangh = forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. (a, b) -> a
fst Range
l1 forall a. Fractional a => a -> a -> a
/ Double
2, forall a b. (a, b) -> a
fst Range
l2 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 :: forall x. 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 = forall x. AxisData x -> AxisVisibility
_axis_visibility AxisData x
ad
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (AxisVisibility -> Bool
_axis_show_line AxisVisibility
vis) forall a b. (a -> b) -> a -> b
$
forall a. LineStyle -> BackendProgram a -> BackendProgram a
withLineStyle (LineStyle
ls {_line_cap :: LineCap
_line_cap = LineCap
LineCapSquare}) 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
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (AxisVisibility -> Bool
_axis_show_ticks AxisVisibility
vis) forall a b. (a -> b) -> a -> b
$
forall a. LineStyle -> BackendProgram a -> BackendProgram a
withLineStyle (LineStyle
ls {_line_cap :: LineCap
_line_cap = LineCap
LineCapButt}) forall a b. (a -> b) -> a -> b
$
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (x, Double) -> ProgramT ChartBackendInstr Identity ()
drawTick (forall x. AxisData x -> [(x, Double)]
_axis_ticks AxisData x
ad)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (AxisVisibility -> Bool
_axis_show_labels AxisVisibility
vis) forall a b. (a -> b) -> a -> b
$
forall a. FontStyle -> BackendProgram a -> BackendProgram a
withFontStyle (AxisStyle -> FontStyle
_axis_label_style AxisStyle
as) forall a b. (a -> b) -> a -> b
$ do
[[Range]]
labelSizes <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> BackendProgram Range
textDimension) (forall a. AxisData a -> [[String]]
labelTexts AxisData x
ad)
let sizes :: [Double]
sizes = forall a b. (a -> b) -> [a] -> [b]
map ((forall a. Num a => a -> a -> a
+Double
ag)forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a. (Num a, Ord a) => [a] -> a
maximum0forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (a -> b) -> [a] -> [b]
map forall {b}. (b, b) -> b
coord) [[Range]]
labelSizes
let offsets :: [Double]
offsets = forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl forall a. Num a => a -> a -> a
(+) Double
ag [Double]
sizes
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Double, [(x, String)]) -> ProgramT ChartBackendInstr Identity ()
drawLabels (forall a b. [a] -> [b] -> [(a, b)]
zip [Double]
offsets (forall x. AxisData x -> [[(x, String)]]
_axis_labels AxisData x
ad))
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) = 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] 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, 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, 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, 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, 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 <- 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
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> a
head forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter ([Rect] -> Bool
noOverlaps forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst)
forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a. Int -> [a] -> [a]
`eachNth` [(Rect, (x, String))]
rects) [Int
0 .. 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
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
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 = forall a. a -> Maybe a
Just 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 forall a b. (a -> b) -> a -> b
$ Double -> Double -> Point
Point Double
x' Double
y
where x' :: Double
x' = Double
x forall a. Num a => a -> a -> a
+ Double
wforall a. Fractional a => a -> a -> a
/Double
2
w :: Double
w = Double
x 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
yforall a. a -> [a] -> [a]
:[Rect]
l)
rectsOverlap :: Rect -> Rect -> Bool
rectsOverlap :: Rect -> Rect -> Bool
rectsOverlap (Rect Point
p1 Point
p2) Rect
r = 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 :: forall a. Int -> [a] -> [a]
eachNth Int
n = forall {a}. [a] -> [a]
skipN
where
n' :: Int
n' = Int
n forall a. Num a => a -> a -> a
- Int
1
skipN :: [a] -> [a]
skipN [] = []
skipN (a
x:[a]
xs) = a
x forall a. a -> [a] -> [a]
: [a] -> [a]
skipN (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)
= forall (t :: * -> *). Foldable t => t Bool -> Bool
and [Double
x forall a. Ord a => a -> a -> Bool
>= Double
x1 Bool -> Bool -> Bool
&& Double
x forall a. Ord a => a -> a -> Bool
<= Double
x2,
Double
y forall a. Ord a => a -> a -> Bool
>= Double
y1 Bool -> Bool -> Bool
&& Double
y forall a. Ord a => a -> a -> Bool
<= Double
y2]
axisMapping :: AxisT z -> RectSize
-> (Double,Double,Double,Double,Vector,z->Point,Point->z)
axisMapping :: forall z.
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 = forall {a}. (a, a) -> (a, a)
reverseR (Double
x1,Double
x2)
yr :: Range
yr = forall {a}. (a, a) -> (a, a)
reverseR (Double
y2,Double
y1)
mapx :: Double -> z -> Point
mapx Double
y z
x = Double -> Double -> Point
Point (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 (forall x. AxisData x -> Range -> x -> Double
_axis_viewport AxisData z
ad Range
yr z
y)
imapx :: Point -> z
imapx (Point Double
x Double
_) = forall x. AxisData x -> Range -> Double -> x
_axis_tropweiv AxisData z
ad Range
xr Double
x
imapy :: Point -> z
imapy (Point Double
_ Double
y) = 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 :: forall z.
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) =
forall a. LineStyle -> BackendProgram a -> BackendProgram a
withLineStyle (AxisStyle -> LineStyle
_axis_grid_style AxisStyle
as) forall a b. (a -> b) -> a -> b
$
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (RectEdge -> z -> ProgramT ChartBackendInstr Identity ()
drawGridLine RectEdge
re) (forall x. AxisData x -> [x]
_axis_grid AxisData z
ad)
where
(Double
_,Double
_,Double
_,Double
_,Vector
_,z -> Point
axisPoint,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] 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'] forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Point] -> ProgramT ChartBackendInstr Identity ()
strokePointPath
makeAxis :: PlotValue x => ([x] -> [String]) -> ([x],[x],[x]) -> AxisData x
makeAxis :: forall x.
PlotValue x =>
([x] -> [String]) -> ([x], [x], [x]) -> AxisData x
makeAxis [x] -> [String]
labelf ([x]
labelvs, [x]
tickvs, [x]
gridvs) = AxisData {
_axis_visibility :: AxisVisibility
_axis_visibility = 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 = forall x. PlotValue x => (x, x) -> Range -> x -> Double
vmap (x
min',x
max')
newTropweiv :: Range -> Double -> x
newTropweiv = 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 ] forall a. [a] -> [a] -> [a]
++ [ (x
v,Double
5) | x
v <- [x]
labelvs ]
newLabels :: [(x, String)]
newLabels = 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) forall a. a -> [a] -> [a]
: [a] -> [b] -> [(a, b)]
zipWithLengthCheck [a]
xs [b]
ys
zipWithLengthCheck [] [] = []
zipWithLengthCheck [a]
_ [b]
_ =
forall a. HasCallStack => String -> a
error String
"makeAxis: label function returned the wrong number of labels"
min' :: x
min' = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [x]
labelvs
max' :: x
max' = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [x]
labelvs
makeAxis' :: Ord x => (x -> Double) -> (Double -> x) -> ([x] -> [String])
-> ([x],[x],[x]) -> AxisData x
makeAxis' :: forall x.
Ord x =>
(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 {
_axis_visibility :: AxisVisibility
_axis_visibility = forall a. Default a => a
def,
_axis_viewport :: Range -> x -> Double
_axis_viewport = forall a. (a -> Double) -> (a, a) -> Range -> a -> Double
linMap x -> Double
t (forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [x]
labelvs, forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [x]
labelvs),
_axis_tropweiv :: Range -> Double -> x
_axis_tropweiv = forall a.
(Double -> a) -> (a -> Double) -> (a, a) -> Range -> Double -> a
invLinMap Double -> x
f x -> Double
t (forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [x]
labelvs, forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [x]
labelvs),
_axis_ticks :: [(x, Double)]
_axis_ticks = forall a b. [a] -> [b] -> [(a, b)]
zip [x]
tickvs (forall a. a -> [a]
repeat Double
2) forall a. [a] -> [a] -> [a]
++ forall a b. [a] -> [b] -> [(a, b)]
zip [x]
labelvs (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) forall a. a -> [a] -> [a]
: [a] -> [b] -> [(a, b)]
zipWithLengthCheck [a]
xs [b]
ys
zipWithLengthCheck [] [] = []
zipWithLengthCheck [a]
_ [b]
_ =
forall a. HasCallStack => String -> a
error String
"makeAxis': label function returned the wrong number of labels"
in [forall a b. [a] -> [b] -> [(a, b)]
zipWithLengthCheck [x]
labelvs ([x] -> [String]
labelf [x]
labelvs)]
}
defaultAxisLineStyle :: LineStyle
defaultAxisLineStyle :: LineStyle
defaultAxisLineStyle = Double -> AlphaColour Double -> LineStyle
solidLine Double
1 forall a b. (a -> b) -> a -> b
$ forall a. Num a => Colour a -> AlphaColour a
opaque forall a. Num a => Colour a
black
defaultGridLineStyle :: LineStyle
defaultGridLineStyle :: LineStyle
defaultGridLineStyle = Double -> [Double] -> AlphaColour Double -> LineStyle
dashedLine Double
1 [Double
5,Double
5] forall a b. (a -> b) -> a -> b
$ forall a. Num a => Colour a -> AlphaColour a
opaque forall a. (Ord a, Floating a) => Colour a
lightgrey
instance Default AxisStyle where
def :: AxisStyle
def = AxisStyle
{ _axis_line_style :: LineStyle
_axis_line_style = LineStyle
defaultAxisLineStyle
, _axis_label_style :: FontStyle
_axis_label_style = forall a. Default a => a
def
, _axis_grid_style :: LineStyle
_axis_grid_style = LineStyle
defaultGridLineStyle
, _axis_label_gap :: Double
_axis_label_gap = Double
10
}
instance Default AxisVisibility where
def :: AxisVisibility
def = 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
}
vmap :: PlotValue x => (x,x) -> Range -> x -> Double
vmap :: forall x. PlotValue x => (x, x) -> Range -> x -> Double
vmap (x
v1,x
v2) (Double
v3,Double
v4) x
v = Double
v3 forall a. Num a => a -> a -> a
+ (forall a. PlotValue a => a -> Double
toValue x
v forall a. Num a => a -> a -> a
- forall a. PlotValue a => a -> Double
toValue x
v1) forall a. Num a => a -> a -> a
* (Double
v4forall a. Num a => a -> a -> a
-Double
v3)
forall a. Fractional a => a -> a -> a
/ (forall a. PlotValue a => a -> Double
toValue x
v2 forall a. Num a => a -> a -> a
- forall a. PlotValue a => a -> Double
toValue x
v1)
invmap :: PlotValue x => (x,x) -> Range -> Double -> x
invmap :: forall x. PlotValue x => (x, x) -> Range -> Double -> x
invmap (x
v3,x
v4) (Double
d1,Double
d2) Double
d = forall a. PlotValue a => Double -> a
fromValue (forall a. PlotValue a => a -> Double
toValue x
v3 forall a. Num a => a -> a -> a
+ ( (Double
dforall a. Num a => a -> a -> a
-Double
d1) forall a. Num a => a -> a -> a
* Double
doubleRange
forall a. Fractional a => a -> a -> a
/ (Double
d2forall a. Num a => a -> a -> a
-Double
d1) ))
where doubleRange :: Double
doubleRange = forall a. PlotValue a => a -> Double
toValue x
v4 forall a. Num a => a -> a -> a
- forall a. PlotValue a => a -> Double
toValue x
v3
linMap :: (a -> Double) -> (a,a) -> Range -> a -> Double
linMap :: forall a. (a -> Double) -> (a, a) -> Range -> a -> Double
linMap a -> Double
f (a
x1,a
x2) (Double
d1,Double
d2) a
x =
Double
d1 forall a. Num a => a -> a -> a
+ (Double
d2 forall a. Num a => a -> a -> a
- Double
d1) forall a. Num a => a -> a -> a
* (a -> Double
f a
x forall a. Num a => a -> a -> a
- a -> Double
f a
x1) forall a. Fractional a => a -> a -> a
/ (a -> Double
f a
x2 forall a. Num a => a -> a -> a
- a -> Double
f a
x1)
invLinMap :: (Double -> a) -> (a -> Double) -> (a,a) -> Range -> Double -> a
invLinMap :: forall a.
(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 forall a. Num a => a -> a -> a
+ ( (Double
dforall a. Num a => a -> a -> a
-Double
d1) forall a. Num a => a -> a -> a
* Double
doubleRange forall a. Fractional a => a -> a -> a
/ (Double
d2forall a. Num a => a -> a -> a
-Double
d1) ))
where
doubleRange :: Double
doubleRange = a -> Double
t a
v4 forall a. Num a => a -> a -> a
- a -> Double
t a
v3
$( makeLenses ''AxisVisibility )
$( makeLenses ''AxisData )
$( makeLenses ''AxisStyle )