-----------------------------------------------------------------------------
-- |
-- Module      :  Graphics
-- Copyright   :  (c)2011, Texas Instruments France
-- License     :  BSD-style (see the file LICENSE)
-- 
-- Maintainer  :  c-favergeon-borgialli@ti.com
-- Stability   :  provisional
-- Portability :  portable
--
-- Generic graphics code to draw the performance curves
--
-----------------------------------------------------------------------------
module Graphics(
  -- * Graphics type
   RGB(..)
 , PictSettings(..)
 , GraphicOutput(..)
 , Samples(..)
 -- * Graphics functions
 , defaultSettings
 , drawCurve
 , drawAxis
 -- * Graphics size
 , Bounds
 , getBounds
 ) where


import Control.Monad(forM_,when)
import Text.Printf(printf)
import Graphics.PDF.Typesetting(Orientation(..),Justification(..))
import Perfs

import Data.List(sortBy)

-- | RGB Color
data RGB = RGB Double Double Double deriving(Eq,Read,Show)

-- | Picture settings
data PictSettings = PictSettings {
                    width :: Int
                  , height :: Int
                  , hmargin :: Int
                  , vmargin :: Int
                  , textColor :: RGB
                  , lineColor :: RGB
                  }
-- | Default settings : size and color
defaultSettings = PictSettings 500 400 50 50 (RGB 0.0 0.0 0.0) (RGB 1.0 0.0 0.0)

-- | Graphic class to abstract the output format (PDF or PNG ...)
class GraphicOutput m where
  -- | Set the stroke color
  strokeColor :: Double -> Double -> Double -> m ()
  -- | Set the fill color
  fillColor :: Double -> Double -> Double -> m ()
  -- | Set the fill color with alpha blending
  fillColorA :: Double -> Double -> Double -> Double -> m ()
  -- | Stroke a line
  strokeLine :: Double -> Double -> Double -> Double -> m ()
  -- | Draw text
  text :: Int -> Double -> Double -> String -> m ()
  -- | Fill rectangle
  fillRectangle :: Double -> Double -> Double -> Double -> m ()
  -- | Label
  label :: Justification -> Int -> Double -> Double -> Double -> Double -> Orientation -> String -> m ()

-- | Conversion function
fi = fromIntegral
       

data Bounds = Bounds {
              minTime :: Double
            , maxTime :: Double
            , minNumber :: Double
            , maxNumber :: Double
            }
            deriving(Eq,Show)

getBounds :: Samples -> Bounds
getBounds s = let samples = map snd s
                  mit = minimum (map snd samples)
                  mat = maximum (map snd samples)
                  nmi = fi $ minimum (map fst samples) :: Double
                  nma = fi $ maximum (map fst samples) :: Double
 in 
   Bounds mit mat nmi nma

-- | Draw the axis
-- | Draw a performance curve
drawAxis :: (Monad m,GraphicOutput m) 
          => PictSettings -- ^ Picture settings
          -> Bounds
          -> String -- ^ Title of the picture
          -> String -- ^ labelX
          -> String -- ^ labelY
          -> m () 
drawAxis s bounds title labelX labelY = do
  let delta = 10
      tickl = 5
      mit = minTime bounds
      mat = maxTime bounds
      nmi = minNumber bounds
      nma = maxNumber bounds
      x n = (n - nmi) / (nma - nmi) * fi (width s - hmargin s - hmargin s)  + fi (hmargin s)
      y t = (t - mit) / (mat - mit) * fi (height s - vmargin s - vmargin s)  + fi (vmargin s)
      deltax =  (nma - nmi) / 10.0
      deltay = (mat - mit) / 10.0
      maxLabelWidth = (fi (width s - hmargin s - hmargin s)) / 10.0
      maxLabelHeight = (fi (height s - vmargin s - vmargin s)) / 10.0
      hLabel title x w =
        label Centered 9 x (fi $ vmargin s - tickl) w (fi $ vmargin s) N title
      vLabel title y h =
        label Centered 9 (fi $ hmargin s ) y (fi $ hmargin s) 100.0 W title
      drawXTick n = do
           strokeLine (x n) (fi $ vmargin s - tickl) (x n) (fi $ vmargin s + tickl)
           let label = printf "%2.2e" n
           hLabel label (x n) deltax
      drawYTick n = do
           strokeLine (fi $ hmargin s - tickl) (y n) (fi $ hmargin s + tickl) (y n) 
           let label = printf "%2.2e" n
           vLabel label (y n) deltay
      drawXAxis = do
        strokeLine (fi $ hmargin s) (fi $ vmargin s) (fi $ width s - hmargin s) (fi $ vmargin s)
        forM_ [nmi,nmi+deltax..nma] drawXTick
      drawYAxis = do
        strokeLine (fi $ hmargin s) (fi $ vmargin s) (fi $ hmargin s) (fi $ height s - vmargin s)
        forM_ [mit,mit+deltay..mat] drawYTick

  fillColor 0.0 0.0 0.0
  drawXAxis
  drawYAxis
  label Centered 10 (fi $ hmargin s) (fi $ height s) (fi 100) (maxLabelHeight) N (labelY ++ " ")
  label RightJustification 10 (fi $ width s) (fi $ vmargin s) (maxLabelWidth) (fi 100) W (labelX ++ " ")
  label Centered 20 (0.5*(fi $ width s)) (fi $ height s - 5) (fi $ width s) 100 N title

color :: (Monad m,GraphicOutput m) => Int -> m ()
color 1 = fillColor 1.0 0.0 0.0 >> strokeColor 1.0 0.0 0.0
color 2 = fillColor 0.0 1.0 0.0 >> strokeColor 0.0 1.0 0.0
color 3 = fillColor 0.0 0.0 1.0 >> strokeColor 0.0 0.0 1.0
color 4 = fillColor 1.0 0.0 1.0 >> strokeColor 1.0 0.0 1.0
color 5 = fillColor 0.0 1.0 1.0 >> strokeColor 0.0 1.0 1.0
color 6 = fillColor 1.0 1.0 0.0 >> strokeColor 1.0 1.0 0.0
color _ = fillColor 0.0 0.0 0.0 >> strokeColor 0.0 0.0 0.0

labelColor :: (Monad m,GraphicOutput m) => Double -> Double -> Double -> Int -> m ()
labelColor x y w c = do
  color c
  fillRectangle x y (x+0.5*w) (y+9)

-- | Draw a performance curve
drawCurve :: (Monad m,GraphicOutput m) 
          => PictSettings -- ^ Picture settings
          -> Bounds
          -> ((String,[(Int,Double)]),Int) -- ^ Performance curve
          -> m ()
drawCurve s bounds ((curveName, curve),curveNb) = do
  let samples = sortBy sameX curve
      sameX a b = compare (fst a) (fst b)
      mit = minTime bounds
      mat = maxTime bounds
      nmi = minNumber bounds
      nma = maxNumber bounds
      x n = (n - nmi) / (nma - nmi) * fi (width s - hmargin s - hmargin s)  + fi (hmargin s)
      y t = (t - mit) / (mat - mit) * fi (height s - vmargin s - vmargin s)  + fi (vmargin s)
      drawPoints ((na,ta):b@(nb,tb):l) =  do
         strokeLine (x $ fi na) (y ta) (x $ fi nb) (y tb)
         drawPoints (b:l)
      drawPoints _ = return ()

  let wm = 90
      hm = 40
      wc = 10
  when ((not . null) curveName) $ do
      labelColor ((fi $ (wm+wc) * (curveNb -1))) 0 (fi wc) curveNb
      label Centered 9 (fi $ (wm+wc) * (curveNb-1) + wc) 0 (fi $ wm) (fi hm) SE curveName
  drawPoints samples
  
