{-# LANGUAGE MultiParamTypeClasses #-}

-- |
-- Module     : Simulation.Aivika.Experiment.Chart.Backend.Diagrams
-- Copyright  : Copyright (c) 2012-2017, David Sorokin <david.sorokin@gmail.com>
-- License    : BSD3
-- Maintainer : David Sorokin <david.sorokin@gmail.com>
-- Stability  : experimental
-- Tested with: GHC 7.10.1
--
-- This module defines a renderer that uses the Chart-diagrams library
-- for rendering charts within simulation, i.e. without using Cairo,
-- which can be suitable for MS Windows.
--

module Simulation.Aivika.Experiment.Chart.Backend.Diagrams
       (DiagramsRenderer(..)) where

import System.FilePath

import Data.Map
import Data.Colour
import Data.Colour.Names

import Control.Lens

import Graphics.Rendering.Chart
import Graphics.Rendering.Chart.Backend.Diagrams

import Simulation.Aivika.Experiment
import Simulation.Aivika.Experiment.Chart

-- | This renderer uses the Chart-diagrams library for rendering charts within simulation.
data DiagramsRenderer =
  DiagramsRenderer { DiagramsRenderer -> FileFormat
rendererFileFormat :: FileFormat,
                     -- ^ It returns the file format used for saving the image.
                     DiagramsRenderer -> IO (FontSelector Double)
rendererCustomFonts :: IO (FontSelector Double)
                     -- ^ It contains the custom fonts.
                   }

instance ChartRendering DiagramsRenderer where

  renderableChartExtension :: DiagramsRenderer -> String
renderableChartExtension (DiagramsRenderer FileFormat
EPS IO (FontSelector Double)
_) = String
".eps"
  renderableChartExtension (DiagramsRenderer FileFormat
SVG IO (FontSelector Double)
_) = String
".svg"
  renderableChartExtension (DiagramsRenderer FileFormat
SVG_EMBEDDED IO (FontSelector Double)
_)  = String
".svg"
  
  renderChart :: forall c.
DiagramsRenderer
-> (Int, Int) -> String -> Renderable c -> IO (PickFn c)
renderChart (DiagramsRenderer FileFormat
format IO (FontSelector Double)
fonts) (Int
width, Int
height) =
    forall a. FileOptions -> String -> Renderable a -> IO (PickFn a)
renderableToFile ((Double, Double)
-> FileFormat -> IO (FontSelector Double) -> FileOptions
FileOptions (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
width, forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
height) FileFormat
format IO (FontSelector Double)
fonts)

  renderingLayout :: DiagramsRenderer -> Layout Double Double -> Layout Double Double
renderingLayout (DiagramsRenderer FileFormat
_ IO (FontSelector Double)
_) = Layout Double Double -> Layout Double Double
defaultLayout
  renderingLayoutLR :: DiagramsRenderer
-> LayoutLR Double Double Double -> LayoutLR Double Double Double
renderingLayoutLR (DiagramsRenderer FileFormat
_ IO (FontSelector Double)
_) = LayoutLR Double Double Double -> LayoutLR Double Double Double
defaultLayoutLR

-- | Default font style.
defaultFontStyle :: FontStyle
defaultFontStyle :: FontStyle
defaultFontStyle =
  String
-> Double
-> FontSlant
-> FontWeight
-> AlphaColour Double
-> FontStyle
FontStyle String
"serif" Double
16 FontSlant
FontSlantNormal FontWeight
FontWeightNormal (forall a. Num a => Colour a -> AlphaColour a
opaque forall a. Num a => Colour a
black) 

-- | Default title font style.
defaultTitleFontStyle :: FontStyle
defaultTitleFontStyle :: FontStyle
defaultTitleFontStyle =
  String
-> Double
-> FontSlant
-> FontWeight
-> AlphaColour Double
-> FontStyle
FontStyle String
"serif" Double
20 FontSlant
FontSlantNormal FontWeight
FontWeightBold (forall a. Num a => Colour a -> AlphaColour a
opaque forall a. Num a => Colour a
black) 

-- | The default layout.
defaultLayoutLR :: LayoutLR Double Double Double -> LayoutLR Double Double Double
defaultLayoutLR :: LayoutLR Double Double Double -> LayoutLR Double Double Double
defaultLayoutLR LayoutLR Double Double Double
layoutlr =
  forall x y1 y2. Lens' (LayoutLR x y1 y2) FontStyle
layoutlr_title_style forall s t a b. ASetter s t a b -> b -> s -> t
.~ FontStyle
defaultTitleFontStyle forall a b. (a -> b) -> a -> b
$
  forall x y1 y2. Setter' (LayoutLR x y1 y2) FontStyle
layoutlr_all_font_styles forall s t a b. ASetter s t a b -> b -> s -> t
.~ FontStyle
defaultFontStyle forall a b. (a -> b) -> a -> b
$
  LayoutLR Double Double Double
layoutlr

-- | The default layout.
defaultLayout :: Layout Double Double -> Layout Double Double
defaultLayout :: Layout Double Double -> Layout Double Double
defaultLayout Layout Double Double
layout =
  forall x y. Lens' (Layout x y) FontStyle
layout_title_style forall s t a b. ASetter s t a b -> b -> s -> t
.~ FontStyle
defaultTitleFontStyle forall a b. (a -> b) -> a -> b
$
  forall x y. Setter' (Layout x y) FontStyle
layout_all_font_styles forall s t a b. ASetter s t a b -> b -> s -> t
.~ FontStyle
defaultFontStyle forall a b. (a -> b) -> a -> b
$
  Layout Double Double
layout