-----------------------------------------------------------------------------
-- |
-- Module      :  Graphics.Rendering.Chart.Plot.Pie
-- Copyright   :  (c) Tim Docker 2008, 2014
-- License     :  BSD-style (see chart/COPYRIGHT)
--
-- A  basic pie chart.
--
-- Pie charts are handled different to other plots, in that they
-- have their own layout, and can't be composed with other plots. A
-- pie chart is rendered with code in the following form:
--
-- @
-- values :: [PieItem]
-- values = [...]
-- layout :: PieLayout
-- layout = pie_plot ^: pie_data ^= values
--        $ def
-- renderable = toRenderable layout
-- @
{-# 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
-- original code thanks to Neal Alexander

-- see ../Drawing.hs for why we do not use hiding (moveTo) for
-- lens < 4
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)
extraSpace :: PieChart -> BackendProgram RectSize
extraSpace 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 (w,h)  = (p_x p2 - p_x p1, p_y p2 - p_y p1)
    -- let center = Point (p_x p1 + w/2)  (p_y p1 + h/2)
    --
    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
        -- p1 = Point 0 0
        -- p2 = Point w h
        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
                    -- TODO: is x'' defined in this way to try and avoid
                    --       numerical rounding?
                    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 )