1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
|
{-# LANGUAGE TemplateHaskell, FlexibleInstances #-}
module Graphics.Rendering.Chart.State(
plot,
plotLeft,
plotRight,
takeColor,
takeShape,
CState,
colors,
shapes,
EC,
execEC,
liftEC,
liftCState,
) where
import Control.Lens
import Control.Monad.State
import Data.Default.Class
import Data.List(cycle)
import Data.Colour
import Data.Colour.Names
import Graphics.Rendering.Chart.Layout
import Graphics.Rendering.Chart.Plot
import Graphics.Rendering.Chart.Axis
import Graphics.Rendering.Chart.Backend
import Graphics.Rendering.Chart.Drawing
import Graphics.Rendering.Chart.Renderable
-- | The state held when monadically constructing a graphical element
data CState = CState {
_colors :: [AlphaColour Double], -- ^ An infinite source of colors, for use in plots
_shapes :: [PointShape] -- ^ An infinite source of shapes, for use in plots
}
$( makeLenses ''CState )
-- | We use nested State monads to give nice syntax. The outer state
-- is the graphical element being constructed (typically a
-- layout). The inner state contains any additional state
-- reqired. This approach means that lenses and the state monad lens
-- operators can be used directly on the value being constructed.
type EC l a = StateT l (State CState) a
instance Default CState where
def = CState colors shapes
where
colors = cycle (map opaque [blue,green,red,orange,yellow,violet])
shapes = cycle [PointShapeCircle,PointShapePlus,PointShapeCross,PointShapeStar]
-- | Run the monadic `EC` computation, and return the graphical
-- element (ie the outer monad' state)
execEC :: (Default l) => EC l a -> l
execEC ec = evalState (execStateT ec def) def
-- | Nest the construction of a graphical element within
-- the construction of another.
liftEC :: (Default l1) => EC l1 a -> EC l2 l1
liftEC ec = do
cs <- lift get
let (l,cs') = runState (execStateT ec def) cs
lift (put cs')
return l
-- | Lift a a computation over `CState`
liftCState :: State CState a -> EC l a
liftCState = lift
-- | Add a plot to the `Layout` being constructed.
plot :: (ToPlot p) => EC (Layout x y) (p x y) -> EC (Layout x y) ()
plot pm = do
p <- pm
layout_plots %= (++[toPlot p])
-- | Add a plot against the left axis to the `LayoutLR` being constructed.
plotLeft :: (ToPlot p) => EC (LayoutLR x y1 y2) (p x y1) -> EC (LayoutLR x y1 y2) ()
plotLeft pm = do
p <- pm
layoutlr_plots %= (++[Left (toPlot p)])
-- | Add a plot against the right axis tof the `LayoutLR` being constructed.
plotRight :: (ToPlot p) => EC (LayoutLR x y1 y2) (p x y2) -> EC (LayoutLR x y1 y2) ()
plotRight pm = do
p <- pm
layoutlr_plots %= (++[Right (toPlot p)])
-- | Pop and return the next color from the state
takeColor :: EC l (AlphaColour Double)
takeColor = liftCState $ do
(c:cs) <- use colors
colors .= cs
return c
-- | Pop and return the next shape from the state
takeShape :: EC l PointShape
takeShape = liftCState $ do
(c:cs) <- use shapes
shapes .= cs
return c
|
