{-# LANGUAGE TemplateHaskell #-}
module Graphics.Rendering.Chart.Plot.Pie(
PieLayout(..),
PieChart(..),
PieItem(..),
pieToRenderable,
pieChartToRenderable,
pie_title,
pie_title_style,
pie_plot,
pie_background,
pie_margin,
pie_data,
pie_colors,
pie_label_style,
pie_label_line_style,
pie_start_angle,
pitem_label,
pitem_offset,
pitem_value,
) where
import Control.Lens
import Data.Colour
import Data.Colour.Names (white)
import Data.Default.Class
import Control.Monad
import Graphics.Rendering.Chart.Geometry hiding (moveTo)
import qualified Graphics.Rendering.Chart.Geometry as G
import Graphics.Rendering.Chart.Drawing
import Graphics.Rendering.Chart.Renderable
import Graphics.Rendering.Chart.Grid
data PieLayout = PieLayout {
PieLayout -> String
_pie_title :: String,
PieLayout -> FontStyle
_pie_title_style :: FontStyle,
PieLayout -> PieChart
_pie_plot :: PieChart,
PieLayout -> FillStyle
_pie_background :: FillStyle,
PieLayout -> Double
_pie_margin :: Double
}
data PieChart = PieChart {
PieChart -> [PieItem]
_pie_data :: [PieItem],
PieChart -> [AlphaColour Double]
_pie_colors :: [AlphaColour Double],
PieChart -> FontStyle
_pie_label_style :: FontStyle,
PieChart -> LineStyle
_pie_label_line_style :: LineStyle,
PieChart -> Double
_pie_start_angle :: Double
}
data PieItem = PieItem {
PieItem -> String
_pitem_label :: String,
PieItem -> Double
_pitem_offset :: Double,
PieItem -> Double
_pitem_value :: Double
}
instance Default PieChart where
def :: PieChart
def = PieChart
{ _pie_data :: [PieItem]
_pie_data = []
, _pie_colors :: [AlphaColour Double]
_pie_colors = [AlphaColour Double]
defaultColorSeq
, _pie_label_style :: FontStyle
_pie_label_style = forall a. Default a => a
def
, _pie_label_line_style :: LineStyle
_pie_label_line_style = 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
, _pie_start_angle :: Double
_pie_start_angle = Double
0
}
instance Default PieItem where
def :: PieItem
def = String -> Double -> Double -> PieItem
PieItem String
"" Double
0 Double
0
instance Default PieLayout where
def :: PieLayout
def = PieLayout
{ _pie_background :: FillStyle
_pie_background = AlphaColour Double -> FillStyle
solidFillStyle forall a b. (a -> b) -> a -> b
$ forall a. Num a => Colour a -> AlphaColour a
opaque forall a. (Ord a, Floating a) => Colour a
white
, _pie_title :: String
_pie_title = String
""
, _pie_title_style :: FontStyle
_pie_title_style = forall a. Default a => a
def { _font_size :: Double
_font_size = Double
15
, _font_weight :: FontWeight
_font_weight = FontWeight
FontWeightBold }
, _pie_plot :: PieChart
_pie_plot = forall a. Default a => a
def
, _pie_margin :: Double
_pie_margin = Double
10
}
instance ToRenderable PieLayout where
toRenderable :: PieLayout -> Renderable ()
toRenderable = forall b a. PickFn b -> Renderable a -> Renderable b
setPickFn forall a. PickFn a
nullPickFn forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. PieLayout -> Renderable (PickFn a)
pieToRenderable
pieChartToRenderable :: PieChart -> Renderable (PickFn a)
pieChartToRenderable :: forall a. PieChart -> Renderable (PickFn a)
pieChartToRenderable PieChart
p = Renderable { minsize :: BackendProgram RectSize
minsize = PieChart -> BackendProgram RectSize
minsizePie PieChart
p
, render :: RectSize -> BackendProgram (PickFn (PickFn a))
render = forall a. PieChart -> RectSize -> BackendProgram (PickFn a)
renderPie PieChart
p
}
instance ToRenderable PieChart where
toRenderable :: PieChart -> Renderable ()
toRenderable = forall b a. PickFn b -> Renderable a -> Renderable b
setPickFn forall a. PickFn a
nullPickFn forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. PieChart -> Renderable (PickFn a)
pieChartToRenderable
pieToRenderable :: PieLayout -> Renderable (PickFn a)
pieToRenderable :: forall a. PieLayout -> Renderable (PickFn a)
pieToRenderable PieLayout
p = forall a. FillStyle -> Renderable a -> Renderable a
fillBackground (PieLayout -> FillStyle
_pie_background PieLayout
p) (
forall a. Grid (Renderable a) -> Renderable a
gridToRenderable forall a b. (a -> b) -> a -> b
$ forall a. [Grid a] -> Grid a
aboveN
[ forall a. a -> Grid a
tval forall a b. (a -> b) -> a -> b
$ forall a.
(Double, Double, Double, Double) -> Renderable a -> Renderable a
addMargins (Double
lmforall a. Fractional a => a -> a -> a
/Double
2,Double
0,Double
0,Double
0) (forall b a. PickFn b -> Renderable a -> Renderable b
setPickFn forall a. PickFn a
nullPickFn Renderable String
title)
, forall a. RectSize -> Grid a -> Grid a
weights (Double
1,Double
1) forall a b. (a -> b) -> a -> b
$ forall a. a -> Grid a
tval forall a b. (a -> b) -> a -> b
$ forall a.
(Double, Double, Double, Double) -> Renderable a -> Renderable a
addMargins (Double
lm,Double
lm,Double
lm,Double
lm)
(forall a. PieChart -> Renderable (PickFn a)
pieChartToRenderable forall a b. (a -> b) -> a -> b
$ PieLayout -> PieChart
_pie_plot PieLayout
p)
] )
where
title :: Renderable String
title = FontStyle
-> HTextAnchor -> VTextAnchor -> String -> Renderable String
label (PieLayout -> FontStyle
_pie_title_style PieLayout
p) HTextAnchor
HTA_Centre VTextAnchor
VTA_Top (PieLayout -> String
_pie_title PieLayout
p)
lm :: Double
lm = PieLayout -> Double
_pie_margin PieLayout
p
extraSpace :: PieChart -> BackendProgram (Double, Double)
PieChart
p = do
[RectSize]
textSizes <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (String -> BackendProgram RectSize
textDimension forall b c a. (b -> c) -> (a -> b) -> a -> c
. PieItem -> String
_pitem_label) (PieChart -> [PieItem]
_pie_data PieChart
p)
let maxw :: Double
maxw = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a. Ord a => a -> a -> a
maxforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (a, b) -> a
fst) Double
0 [RectSize]
textSizes
let maxh :: Double
maxh = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a. Ord a => a -> a -> a
maxforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (a, b) -> b
snd) Double
0 [RectSize]
textSizes
let maxo :: Double
maxo = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a. Ord a => a -> a -> a
maxforall b c a. (b -> c) -> (a -> b) -> a -> c
.PieItem -> Double
_pitem_offset) Double
0 (PieChart -> [PieItem]
_pie_data PieChart
p)
let extra :: Double
extra = Double
label_rgap forall a. Num a => a -> a -> a
+ Double
label_rlength forall a. Num a => a -> a -> a
+ Double
maxo
forall (m :: * -> *) a. Monad m => a -> m a
return (Double
extra forall a. Num a => a -> a -> a
+ Double
maxw, Double
extra forall a. Num a => a -> a -> a
+ Double
maxh )
minsizePie :: PieChart -> BackendProgram (Double, Double)
minsizePie :: PieChart -> BackendProgram RectSize
minsizePie PieChart
p = do
(Double
extraw,Double
extrah) <- PieChart -> BackendProgram RectSize
extraSpace PieChart
p
forall (m :: * -> *) a. Monad m => a -> m a
return (Double
extraw forall a. Num a => a -> a -> a
* Double
2, Double
extrah forall a. Num a => a -> a -> a
* Double
2)
renderPie :: PieChart -> (Double, Double) -> BackendProgram (PickFn a)
renderPie :: forall a. PieChart -> RectSize -> BackendProgram (PickFn a)
renderPie PieChart
p (Double
w,Double
h) = do
(Double
extraw,Double
extrah) <- PieChart -> BackendProgram RectSize
extraSpace PieChart
p
let center :: Point
center = Double -> Double -> Point
Point (Double
wforall a. Fractional a => a -> a -> a
/Double
2) (Double
hforall a. Fractional a => a -> a -> a
/Double
2)
let radius :: Double
radius = forall a. Ord a => a -> a -> a
min (Double
w forall a. Num a => a -> a -> a
- Double
2forall a. Num a => a -> a -> a
*Double
extraw) (Double
h forall a. Num a => a -> a -> a
- Double
2forall a. Num a => a -> a -> a
*Double
extrah) forall a. Fractional a => a -> a -> a
/ Double
2
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m ()
foldM_ (Point
-> Double
-> Double
-> (AlphaColour Double, PieItem)
-> BackendProgram Double
paint Point
center Double
radius) (PieChart -> Double
_pie_start_angle PieChart
p)
(forall a b. [a] -> [b] -> [(a, b)]
zip (PieChart -> [AlphaColour Double]
_pie_colors PieChart
p) [PieItem]
content)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a. PickFn a
nullPickFn
where
content :: [PieItem]
content = let total :: Double
total = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (forall a b. (a -> b) -> [a] -> [b]
map PieItem -> Double
_pitem_value (PieChart -> [PieItem]
_pie_data PieChart
p))
in [ PieItem
pitem{_pitem_value :: Double
_pitem_value=PieItem -> Double
_pitem_value PieItem
pitemforall a. Fractional a => a -> a -> a
/Double
total}
| PieItem
pitem <- PieChart -> [PieItem]
_pie_data PieChart
p ]
paint :: Point -> Double -> Double -> (AlphaColour Double, PieItem)
-> BackendProgram Double
paint :: Point
-> Double
-> Double
-> (AlphaColour Double, PieItem)
-> BackendProgram Double
paint Point
center Double
radius Double
a1 (AlphaColour Double
color,PieItem
pitem) = do
let ax :: Double
ax = Double
360.0 forall a. Num a => a -> a -> a
* PieItem -> Double
_pitem_value PieItem
pitem
let a2 :: Double
a2 = Double
a1 forall a. Num a => a -> a -> a
+ (Double
ax forall a. Fractional a => a -> a -> a
/ Double
2)
let a3 :: Double
a3 = Double
a1 forall a. Num a => a -> a -> a
+ Double
ax
let offset :: Double
offset = PieItem -> Double
_pitem_offset PieItem
pitem
Point
-> Double -> Double -> AlphaColour Double -> BackendProgram ()
pieSlice (Double -> Double -> Point
ray Double
a2 Double
offset) Double
a1 Double
a3 AlphaColour Double
color
String -> Double -> Double -> BackendProgram ()
pieLabel (PieItem -> String
_pitem_label PieItem
pitem) Double
a2 Double
offset
forall (m :: * -> *) a. Monad m => a -> m a
return Double
a3
where
pieLabel :: String -> Double -> Double -> BackendProgram ()
pieLabel :: String -> Double -> Double -> BackendProgram ()
pieLabel String
name Double
angle Double
offset =
forall a. FontStyle -> BackendProgram a -> BackendProgram a
withFontStyle (PieChart -> FontStyle
_pie_label_style PieChart
p) forall a b. (a -> b) -> a -> b
$
forall a. LineStyle -> BackendProgram a -> BackendProgram a
withLineStyle (PieChart -> LineStyle
_pie_label_line_style PieChart
p) forall a b. (a -> b) -> a -> b
$ do
let p1 :: Point
p1 = Double -> Double -> Point
ray Double
angle (Double
radiusforall a. Num a => a -> a -> a
+Double
label_rgapforall a. Num a => a -> a -> a
+Double
label_rlengthforall a. Num a => a -> a -> a
+Double
offset)
Point
p1a <- Point -> BackendProgram Point
alignStrokePoint Point
p1
(Double
tw,Double
_) <- String -> BackendProgram RectSize
textDimension String
name
let (Double -> Double
offset',HTextAnchor
anchor) = if Double
angle forall a. Ord a => a -> a -> Bool
< Double
90 Bool -> Bool -> Bool
|| Double
angle forall a. Ord a => a -> a -> Bool
> Double
270
then ((Double
0forall a. Num a => a -> a -> a
+),HTextAnchor
HTA_Left)
else ((Double
0forall a. Num a => a -> a -> a
-),HTextAnchor
HTA_Right)
Point
p0 <- Point -> BackendProgram Point
alignStrokePoint forall a b. (a -> b) -> a -> b
$ Double -> Double -> Point
ray Double
angle (Double
radius forall a. Num a => a -> a -> a
+ Double
label_rgapforall a. Num a => a -> a -> a
+Double
offset)
Path -> BackendProgram ()
strokePath forall a b. (a -> b) -> a -> b
$ Point -> Path
G.moveTo Point
p0
forall a. Semigroup a => a -> a -> a
<> Point -> Path
lineTo Point
p1a
forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Path
lineTo' (Point -> Double
p_x Point
p1a forall a. Num a => a -> a -> a
+ Double -> Double
offset' (Double
tw forall a. Num a => a -> a -> a
+ Double
label_rgap)) (Point -> Double
p_y Point
p1a)
let p2 :: Point
p2 = Point
p1 Point -> Vector -> Point
`pvadd` Double -> Double -> Vector
Vector (Double -> Double
offset' Double
label_rgap) Double
0
HTextAnchor -> VTextAnchor -> Point -> String -> BackendProgram ()
drawTextA HTextAnchor
anchor VTextAnchor
VTA_Bottom Point
p2 String
name
pieSlice :: Point -> Double -> Double -> AlphaColour Double -> BackendProgram ()
pieSlice :: Point
-> Double -> Double -> AlphaColour Double -> BackendProgram ()
pieSlice (Point Double
x Double
y) Double
arc1 Double
arc2 AlphaColour Double
pColor = do
let path :: Path
path = Double -> Double -> Double -> Double -> Double -> Path
arc' Double
x Double
y Double
radius (Double -> Double
radian Double
arc1) (Double -> Double
radian Double
arc2)
forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Path
lineTo' Double
x Double
y
forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Path
lineTo' Double
x Double
y
forall a. Semigroup a => a -> a -> a
<> Path
close
forall a. FillStyle -> BackendProgram a -> BackendProgram a
withFillStyle (AlphaColour Double -> FillStyle
FillStyleSolid AlphaColour Double
pColor) forall a b. (a -> b) -> a -> b
$
Path -> BackendProgram ()
fillPath Path
path
forall a. LineStyle -> BackendProgram a -> BackendProgram a
withLineStyle (forall a. Default a => a
def { _line_color :: AlphaColour Double
_line_color = forall a. Num a => Colour a -> a -> AlphaColour a
withOpacity forall a. (Ord a, Floating a) => Colour a
white Double
0.1 }) forall a b. (a -> b) -> a -> b
$
Path -> BackendProgram ()
strokePath Path
path
ray :: Double -> Double -> Point
ray :: Double -> Double -> Point
ray Double
angle Double
r = Double -> Double -> Point
Point Double
x' Double
y'
where
x' :: Double
x' = Double
x forall a. Num a => a -> a -> a
+ (Double
cos' forall a. Num a => a -> a -> a
* Double
x'')
y' :: Double
y' = Double
y forall a. Num a => a -> a -> a
+ (Double
sin' forall a. Num a => a -> a -> a
* Double
x'')
cos' :: Double
cos' = (forall a. Floating a => a -> a
cos forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Double
radian) Double
angle
sin' :: Double
sin' = (forall a. Floating a => a -> a
sin forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Double
radian) Double
angle
x'' :: Double
x'' = (Double
x forall a. Num a => a -> a -> a
+ Double
r) forall a. Num a => a -> a -> a
- Double
x
x :: Double
x = Point -> Double
p_x Point
center
y :: Double
y = Point -> Double
p_y Point
center
radian :: Double -> Double
radian = (forall a. Num a => a -> a -> a
*(forall a. Floating a => a
pi forall a. Fractional a => a -> a -> a
/ Double
180.0))
label_rgap, label_rlength :: Double
label_rgap :: Double
label_rgap = Double
5
label_rlength :: Double
label_rlength = Double
15
$( makeLenses ''PieLayout )
$( makeLenses ''PieChart )
$( makeLenses ''PieItem )