-----------------------------------------------------------------------------
-- |
-- Module      :  Graphics.Rendering.Chart.Plot.Pie
-- Copyright   :  (c) Tim Docker 2008
-- 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
--        $ defaultPieLayout
-- renderable = toRenderable layout
-- @
{-# LANGUAGE TemplateHaskell #-}

module Graphics.Rendering.Chart.Plot.Pie(
    PieLayout(..),
    PieChart(..),
    PieItem(..),
    defaultPieLayout,
    defaultPieChart,
    defaultPieItem,
    
    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

import Data.List
import Data.Bits
import Control.Lens hiding (moveTo)
import Data.Colour
import Data.Colour.Names (black, white)
import Data.Monoid
import Data.Default.Class
import Control.Monad

import Graphics.Rendering.Chart.Geometry
import Graphics.Rendering.Chart.Drawing
import Graphics.Rendering.Chart.Legend
import Graphics.Rendering.Chart.Renderable
import Graphics.Rendering.Chart.Grid
import Graphics.Rendering.Chart.Plot.Types

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
}

{-# DEPRECATED defaultPieChart  "Use the according Data.Default instance!" #-}
defaultPieChart :: PieChart
defaultPieChart = def

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
    }

{-# DEPRECATED defaultPieItem  "Use the according Data.Default instance!" #-}
defaultPieItem :: PieItem
defaultPieItem = def

instance Default PieItem where
  def = PieItem "" 0 0

{-# DEPRECATED defaultPieLayout  "Use the according Data.Default instance!" #-}
defaultPieLayout :: PieLayout
defaultPieLayout = def

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        = defaultPieChart
    , _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 -> ChartBackend (Double, Double)
extraSpace p = do
    textSizes <- mapM textDimension (map _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 -> ChartBackend (Double, Double)
minsizePie p = do
    (extraw,extrah) <- extraSpace p
    return (extraw * 2, extrah * 2)

renderPie :: PieChart -> (Double, Double) -> ChartBackend (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 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 [ pi{_pitem_value=_pitem_value pi/total}
                     | pi <- _pie_data p ]

        paint :: Point -> Double -> Double -> (AlphaColour Double, PieItem)
              -> ChartBackend 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 -> ChartBackend ()
                pieLabel name angle offset = do
                    withFontStyle (_pie_label_style p) $ do
                      withLineStyle (_pie_label_line_style p) $ do
                        let p1 = ray angle (radius+label_rgap+label_rlength+offset)
                        p1a <- alignStrokePoint $ p1
                        (tw,th) <- 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 $ 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 -> ChartBackend ()
                pieSlice (Point x y) a1 a2 color = do
                    let path = arc' x y radius (radian a1) (radian a2)
                            <> lineTo' x y
                            <> lineTo' x y
                            <> close

                    withFillStyle (FillStyleSolid color) $ do
                      fillPath path
                    withLineStyle (def { _line_color = withOpacity white 0.1 }) $ do
                      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
                    x''  = ((x + r) - x)
                    x    = p_x center
                    y    = p_y center

                radian = (*(pi / 180.0))


label_rgap = 5
label_rlength = 15

$( makeLenses ''PieLayout )
$( makeLenses ''PieChart )
$( makeLenses ''PieItem )
