module Graphics.Rendering.Chart.Legend(
Legend(..),
LegendStyle(..),
defaultLegendStyle,
legendToRenderable,
legend_label_style,
legend_margin,
legend_plot_size,
) where
import qualified Graphics.Rendering.Cairo as C
import Control.Monad
import Data.List (nub, partition,intersperse)
import Data.Accessor.Template
import Graphics.Rendering.Chart.Types
import Graphics.Rendering.Chart.Plot
import Graphics.Rendering.Chart.Renderable
import Graphics.Rendering.Chart.Grid
data LegendStyle = LegendStyle {
legend_label_style_ :: CairoFontStyle,
legend_margin_ :: Double,
legend_plot_size_ :: Double
}
data Legend x y = Legend Bool LegendStyle [(String,Plot x y)]
instance ToRenderable (Legend x y) where
toRenderable = setPickFn nullPickFn.legendToRenderable
legendToRenderable :: Legend x y -> Renderable String
legendToRenderable (Legend _ ls plots) = gridToRenderable grid
where
grid = besideN $ intersperse ggap1 (map (tval.rf) (join_nub plots))
rf (title,ps) = setPickFn (const (Just title)) (gridToRenderable grid1)
where
grid1 = besideN $ intersperse ggap2 (map rp ps) ++ [ggap2,gtitle]
gtitle = tval $ lbl title
rp p = tval $ Renderable {
minsize = return (legend_plot_size_ ls, 0),
render = \(w,h) -> do
plot_render_legend_ p (Rect (Point 0 0) (Point w h))
return nullPickFn
}
ggap1 = tval $ spacer (legend_margin_ ls,0)
ggap2 = tval $ spacer1 (lbl "X")
lbl s = label (legend_label_style_ ls) HTA_Centre VTA_Centre s
join_nub :: [(String, a)] -> [(String, [a])]
join_nub ((x,a1):ys) = case partition ((==x) . fst) ys of
(xs, rest) -> (x, a1:map snd xs) : join_nub rest
join_nub [] = []
defaultLegendStyle = LegendStyle {
legend_label_style_=defaultFontStyle,
legend_margin_=20,
legend_plot_size_=20
}
$( deriveAccessors ''LegendStyle )