-----------------------------------------------------------------------------
-- |
-- Module      :  Graphics.Rendering.Plot.Render.Plot.Legend
-- Copyright   :  (c) A. V. H. McPhail 2010
-- License     :  BSD3
--
-- Maintainer  :  haskell.vivian.mcphail <at> gmail <dot> com
-- Stability   :  provisional
-- Portability :  portable
--
-- Rendering 'Figure's
--
-----------------------------------------------------------------------------

module Graphics.Rendering.Plot.Render.Plot.Legend (
                                       -- * Rendering
                                       renderLegend
                                       ) where

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

import Data.List(maximumBy)

import Data.Colour.Names

import qualified Data.Array.IArray as A
import qualified Graphics.Rendering.Cairo as C
import qualified Graphics.Rendering.Pango as P

import Control.Monad.Reader

import Graphics.Rendering.Plot.Types
import Graphics.Rendering.Plot.Defaults

import Graphics.Rendering.Plot.Render.Types
import Graphics.Rendering.Plot.Render.Text
import Graphics.Rendering.Plot.Render.Plot.Glyph

--import qualified Text.Printf as Printf

--import Prelude hiding(min,max)
--import qualified Prelude(max)

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

renderLegend :: Maybe LegendData -> DataSeries -> Render (Padding -> Render ())
renderLegend Nothing                  _ = return $ \_ -> return ()
renderLegend (Just (Legend b l o to)) d = do
  -- calculate row height and max length
  let (ln,ls) = getLabels d
      mx = maximumBy (\ x y -> length x `compare` length y) $ fst $ unzip ls
  pc <- asks _pangocontext
  (w,h) <- cairo $ do
     lo <- pango $ P.layoutText pc mx
     setTextOptions to lo
     (_,twh) <- textSize lo Centre Middle 0 0 
     return twh
  -- if outside shift bounding box
  case o of
    -- render legend
    Outside -> do
      outside <- renderLegendOutside b l w h to ln ls
      return outside
    -- else return (render legend)
    Inside ->  return $ \_ -> renderLegendInside b l w h to ln ls

renderLegendOutside :: Bool -> LegendLocation -> Double -> Double -> TextOptions -> Int -> [(SeriesLabel,Decoration)] -> Render (Padding -> Render ())
renderLegendOutside b l w h to ln ls 
    | l == North                 = do
       let h' = textPad + h + textPad
       bbLowerTop $ h' + 4*textPad
       return $ \(Padding _ _ _ t) -> do
          x' <- bbCentreWidth
          y' <- bbTopHeight
          let w' = (fromIntegral ln)*(textPad + legendSampleWidth 
                    + legendSampleWidth + textPad + w) + 5*textPad
          let x = x'- (w'/2)
              y = y'- h' - t
          when b (cairo $ renderBorder 1.0 black (x+0.5) (y+0.5) w' h')
          renderLegendEntries (x+3*textPad) (y+textPad) 
            (textPad + legendSampleWidth + legendSampleWidth + textPad 
                     + w + textPad) 0 0 h to ls 
          return ()
    | l == NorthEast             = do
       let h' = textPad + h + textPad
       bbLowerTop $ h' + 4*textPad
       return $ \(Padding _ _ _ t) -> do
          x' <- bbRightWidth
          y' <- bbTopHeight
          let w' = (fromIntegral ln)*(textPad + legendSampleWidth 
                    + legendSampleWidth + textPad + w) + 5*textPad
          let x = x'- w'
              y = y'- h' - t
          when b (cairo $ renderBorder 1.0 black (x+0.5) (y+0.5) w' h')
          renderLegendEntries (x+3*textPad) (y+textPad) 
            (textPad + legendSampleWidth + legendSampleWidth + textPad 
                     + w + textPad) 0 0 h to ls 
          return ()
    | l == East                  = do
       let w' = textPad + legendSampleWidth + legendSampleWidth 
                        + textPad + w + textPad
       bbShiftRight $ w' + 4*textPad
       return $ \(Padding _ r _ _) -> do
          x' <- bbRightWidth
          y' <- bbCentreHeight
          let h' = (fromIntegral ln)*(h+textPad) + 5*textPad
          let x = x' + 4*textPad + r
              y = y'-(h'/2)
          when b (cairo $ renderBorder 1.0 black (x+0.5) (y+0.5) w' h')
          renderLegendEntries (x+2*textPad) (y+3*textPad) 0 (h+textPad) 
             0 h to ls 
          return ()
    | l == SouthEast             = do
       let h' = textPad + h + textPad
       bbRaiseBottom $ h' + 4*textPad
       return $ \(Padding _ _ b' _) -> do
          x' <- bbRightWidth
          y' <- bbBottomHeight
          let w' = (fromIntegral ln)*(textPad + legendSampleWidth 
                     + legendSampleWidth + textPad + w) + 5*textPad
          let x = x'- w'
              y = y' + b' +textPad
          when b (cairo $ renderBorder 1.0 black (x+0.5) (y+0.5) w' h')
          renderLegendEntries (x+3*textPad) (y+textPad) 
            (textPad + legendSampleWidth + legendSampleWidth + textPad 
                     + w + textPad) 0 0 h to ls 
          return ()
    | l == South                 = do
       let h' = textPad + h + textPad
       bbRaiseBottom $ h' + 4*textPad
       return $ \(Padding _ _ b' _) -> do
          x' <- bbCentreWidth
          y' <- bbBottomHeight
          let w' = (fromIntegral ln)*(textPad + legendSampleWidth 
                     + legendSampleWidth + textPad + w) + 5*textPad
          let x = x' - (w'/2)
              y = y' + b' +textPad
          when b (cairo $ renderBorder 1.0 black (x+0.5) (y+0.5) w' h')
          renderLegendEntries (x+3*textPad) (y+textPad) 
            (textPad + legendSampleWidth + legendSampleWidth + textPad 
                     + w + textPad) 0 0 h to ls 
          return ()
    | l == SouthWest             = do
       let h' = textPad + h + textPad
       bbRaiseBottom $ h' + 4*textPad
       return $ \(Padding _ _ b' _) -> do
          x' <- bbLeftWidth
          y' <- bbBottomHeight
          let w' = (fromIntegral ln)*(textPad + legendSampleWidth 
                     + legendSampleWidth + textPad + w) + 5*textPad
          let x = x'
              y = y' + b' +textPad
          when b (cairo $ renderBorder 1.0 black (x+0.5) (y+0.5) w' h')
          renderLegendEntries (x+3*textPad) (y+textPad) 
             (textPad + legendSampleWidth + legendSampleWidth + textPad 
                      + w + textPad) 0 0 h to ls 
          return ()
    | l == West                   = do
       let w' = textPad + legendSampleWidth + legendSampleWidth + textPad 
                        + w + textPad
       bbShiftLeft $ w' + 4*textPad
       return $ \(Padding l' _ _ _) -> do
          x' <- bbLeftWidth
          y' <- bbCentreHeight
          let h' = (fromIntegral ln)*(h+textPad) + 5*textPad
          let x = x' - w' - 4*textPad - l'
              y = y'-(h'/2)
          when b (cairo $ renderBorder 1.0 black (x+0.5) (y+0.5) w' h')
          renderLegendEntries (x+2*textPad) (y+3*textPad) 0 (h+textPad) 
            0 h to ls 
          return ()
    | l == NorthWest             = do
       let h' = textPad + h + textPad
       bbLowerTop $ h' + 4*textPad
       return $ \(Padding _ _ _ t) -> do
          x' <- bbLeftWidth
          y' <- bbTopHeight
          let w' = (fromIntegral ln)*(textPad + legendSampleWidth 
                     + legendSampleWidth + textPad + w) + 5*textPad
          let x = x'
              y = y'- h' - t
          when b (cairo $ renderBorder 1.0 black (x+0.5) (y+0.5) w' h')
          renderLegendEntries (x+3*textPad) (y+textPad) 
            (textPad + legendSampleWidth + legendSampleWidth + textPad 
                     + w + textPad) 0 0 h to ls 
          return ()
renderLegendOutside _ _ _ _ _ _ _ = return (\_ -> return ())

renderBorder :: Double -> Color -> Double -> Double -> Double -> Double -> C.Render ()
renderBorder lw c x y w h = do
  C.setLineWidth lw
  setColour c
  C.rectangle x y w h
  C.stroke

renderLegendInside :: Bool -> LegendLocation -> Double -> Double -> TextOptions -> Int -> [(SeriesLabel,Decoration)] -> Render ()
renderLegendInside b l w h to ln ls = do
  let w' = (textPad + legendSampleWidth + legendSampleWidth + textPad 
                    + w + textPad)
      h' = h+textPad
      h'' = (fromIntegral ln)*h'+textPad
  (x,y) <- case l of
     North     -> do
       x' <- bbCentreWidth
       y' <- bbTopHeight
       return (x'-w'/2-textPad,y'+textPad)
     NorthEast -> do
       x' <- bbRightWidth
       y' <- bbTopHeight
       return (x'-w'-3*textPad,y'+textPad)
     East      -> do
       x' <- bbRightWidth
       y' <- bbCentreHeight
       let y'' = y' - h''/2 
       return (x'-w'-3*textPad,y''-textPad)
     SouthEast -> do
       x' <- bbRightWidth
       y' <- bbBottomHeight
       let y'' = y' - h''
       return (x'-w'-3*textPad,y''-3*textPad)
     South    -> do
       x' <- bbCentreWidth
       y' <- bbBottomHeight
       let y'' = y' - h''
       return (x'-w'/2-textPad,y''-3*textPad)
     SouthWest -> do
       x' <- bbLeftWidth
       y' <- bbBottomHeight
       let y'' = y' - h''
       return (x'+textPad,y''-3*textPad)
     West      -> do
       x' <- bbLeftWidth
       y' <- bbCentreHeight
       let y'' = y' - h''/2 
       return (x'+textPad,y''-textPad)
     NorthWest -> do
       x' <- bbLeftWidth
       y' <- bbTopHeight
       return (x'+textPad,y'+textPad)
  when b (cairo $ renderBorder 1.0 black (x+0.5) (y+0.5) w' h'')
  cairo $ do
    --C.setSourceRGBA 1 0 0 0
    setColour white
    C.rectangle (x+0.5) (y+0.5) w' h''
    C.fill
    C.stroke
  renderLegendEntries (x+3*textPad) (y+textPad) 0 h' w' 
           (h'-textPad) to ls 

renderLegendEntries :: Double -> Double -> Double -> Double -> Double -> Double 
                    -> TextOptions
                    -> [(SeriesLabel,Decoration)] -> Render ()
renderLegendEntries x y wa ha w h to ls = do
  _ <- foldM (renderLegendEntry wa ha w h to) (x,y) ls
  return ()

renderLegendEntry :: Double -> Double -> Double -> Double -> TextOptions -> (Double,Double) -> (SeriesLabel,Decoration) -> Render (Double,Double)
renderLegendEntry wa ha w h to (x,y) (l,d) = do
  renderLegendSample x y legendSampleWidth h d
  pc <- asks _pangocontext
  cairo $ do
    lo <- pango $ P.layoutText pc l
    setTextOptions to lo
    showText lo (x+legendSampleWidth + 2*textPad) y
  return (x+wa,y+ha)

renderLegendSample :: Double -> Double -> Double -> Double -> Decoration -> Render ()
renderLegendSample x y w h d = do
  let l = decorationGetLineType d
  let p = decorationGetPointType d
  case l of
    Nothing -> return ()
    Just l' -> do
      cairo $ do
        setLineStyle l'
        C.moveTo x     (y+h/2+0.5)
        C.lineTo (x+w) (y+h/2+0.5)
        C.stroke
  case p of
    Nothing -> return ()
    Just p' -> do
      cairo $ do
        C.save   
        C.moveTo (x+w/2) (y+h/2)
        g <- setPointStyle p'
        renderGlyph 1 g
        C.restore

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

getLabels :: DataSeries -> (Int,[(SeriesLabel,Decoration)])
getLabels (DS_Y d)      = let mls = map (\(DecSeries o d') -> (maybe "" id $ getOrdLabel o,d')) $ A.elems d
                              ln = length mls
                          in (ln,mls)
getLabels (DS_1toN _ d) = let mls = map (\(DecSeries o d') -> (maybe "" id $ getOrdLabel o,d')) $ A.elems d
                              ln = length mls
                          in (ln,mls)
getLabels (DS_1to1 d)   = let mls = map (\(_,(DecSeries o d')) -> (maybe "" id $ getOrdLabel o,d')) $ A.elems d
                              ln = length mls
                          in (ln,mls)
getLabels (DS_Surf _)   = (0,[])

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