-----------------------------------------------------------------------------
-- |
-- 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 )
