-----------------------------------------------------------------------------

-- |

-- 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.Monoid

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 {

   _pie_title       :: String,

   _pie_title_style :: FontStyle,

   _pie_plot        :: PieChart,

   _pie_background  :: FillStyle,

   _pie_margin      :: Double

}



data PieChart = PieChart {

   _pie_data             :: [PieItem],

   _pie_colors           :: [AlphaColour Double],

   _pie_label_style      :: FontStyle,

   _pie_label_line_style :: LineStyle, 

   _pie_start_angle      :: Double



}



data PieItem = PieItem {

   _pitem_label  :: String,

   _pitem_offset :: Double,

   _pitem_value  :: Double

}



instance Default PieChart where

  def = PieChart 

    { _pie_data             = []

    , _pie_colors           = defaultColorSeq

    , _pie_label_style      = def

    , _pie_label_line_style = solidLine 1 $ opaque black

    , _pie_start_angle      = 0

    }



instance Default PieItem where

  def = PieItem "" 0 0



instance Default PieLayout where

  def = PieLayout 

    { _pie_background  = solidFillStyle $ opaque white

    , _pie_title       = ""

    , _pie_title_style = def { _font_size   = 15

                             , _font_weight = FontWeightBold }

    , _pie_plot        = def

    , _pie_margin      = 10

    }



instance ToRenderable PieLayout where

  toRenderable = setPickFn nullPickFn . pieToRenderable



pieChartToRenderable :: PieChart -> Renderable (PickFn a)

pieChartToRenderable p = Renderable { minsize = minsizePie p

                                    , render  = renderPie p

                                    }



instance ToRenderable PieChart where

  toRenderable = setPickFn nullPickFn . pieChartToRenderable



pieToRenderable :: PieLayout -> Renderable (PickFn a)

pieToRenderable p = fillBackground (_pie_background p) (

       gridToRenderable $ aboveN

         [ tval $ addMargins (lm/2,0,0,0) (setPickFn nullPickFn title)

         , weights (1,1) $ tval $ addMargins (lm,lm,lm,lm)

                                             (pieChartToRenderable $ _pie_plot p)

         ] )

      where

        title = label (_pie_title_style p) HTA_Centre VTA_Top (_pie_title p)

        lm    = _pie_margin p



extraSpace :: PieChart -> BackendProgram (Double, Double)

extraSpace p = do

    textSizes <- mapM (textDimension . _pitem_label) (_pie_data p)

    let maxw  = foldr (max.fst) 0 textSizes

    let maxh  = foldr (max.snd) 0 textSizes

    let maxo  = foldr (max._pitem_offset) 0 (_pie_data p)

    let extra = label_rgap + label_rlength + maxo

    return (extra + maxw, extra + maxh )



minsizePie :: PieChart -> BackendProgram (Double, Double)

minsizePie p = do

    (extraw,extrah) <- extraSpace p

    return (extraw * 2, extrah * 2)



renderPie :: PieChart -> (Double, Double) -> BackendProgram (PickFn a)

renderPie p (w,h) = do

    (extraw,extrah) <- extraSpace 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 (w/2) (h/2)

    let radius = min (w - 2*extraw) (h - 2*extrah) / 2



    foldM_ (paint center radius) (_pie_start_angle p)

           (zip (_pie_colors p) content)

    return nullPickFn

 

    where

        -- p1 = Point 0 0 

        -- p2 = Point w h 

        content = let total = sum (map _pitem_value (_pie_data p))

                  in [ pitem{_pitem_value=_pitem_value pitem/total}

                     | pitem <- _pie_data p ]



        paint :: Point -> Double -> Double -> (AlphaColour Double, PieItem)

              -> BackendProgram Double

        paint center radius a1 (color,pitem) = do

            let ax     = 360.0 * _pitem_value pitem

            let a2     = a1 + (ax / 2)

            let a3     = a1 + ax

            let offset = _pitem_offset pitem



            pieSlice (ray a2 offset) a1 a3 color

            pieLabel (_pitem_label pitem) a2 offset



            return a3



            where

                pieLabel :: String -> Double -> Double -> BackendProgram ()

                pieLabel name angle offset = 

                    withFontStyle (_pie_label_style p) $ 

                      withLineStyle (_pie_label_line_style p) $ do

                        let p1 = ray angle (radius+label_rgap+label_rlength+offset)

                        p1a <- alignStrokePoint p1

                        (tw,_) <- textDimension name

                        let (offset',anchor) = if angle < 90 || angle > 270 

                                              then ((0+),HTA_Left)

                                              else ((0-),HTA_Right)

                        p0 <- alignStrokePoint $ ray angle (radius + label_rgap+offset)

                        strokePath $ G.moveTo p0

                                  <> lineTo p1a

                                  <> lineTo' (p_x p1a + offset' (tw + label_rgap)) (p_y p1a)



                        let p2 = p1 `pvadd` Vector (offset' label_rgap) 0

                        drawTextA anchor VTA_Bottom p2 name



                pieSlice :: Point -> Double -> Double -> AlphaColour Double -> BackendProgram ()

                pieSlice (Point x y) arc1 arc2 pColor = do

                    let path = arc' x y radius (radian arc1) (radian arc2)

                            <> lineTo' x y

                            <> lineTo' x y

                            <> close



                    withFillStyle (FillStyleSolid pColor) $ 

                      fillPath path

                    withLineStyle (def { _line_color = withOpacity white 0.1 }) $ 

                      strokePath path



                ray :: Double -> Double -> Point

                ray angle r = Point x' y'

                  where

                    x'   = x + (cos' * x'')

                    y'   = y + (sin' * x'')

                    cos' = (cos . radian) angle

                    sin' = (sin . radian) angle

                    -- TODO: is x'' defined in this way to try and avoid

                    --       numerical rounding?

                    x''  = (x + r) - x

                    x    = p_x center

                    y    = p_y center



                radian = (*(pi / 180.0))



label_rgap, label_rlength :: Double

label_rgap = 5

label_rlength = 15



$( makeLenses ''PieLayout )

$( makeLenses ''PieChart )

$( makeLenses ''PieItem )