-----------------------------------------------------------------------------
-- |
-- Module      :  Graphics.Rendering.Chart.Plot.Types
-- Copyright   :  (c) Tim Docker 2006, 2014
-- License     :  BSD-style (see chart/COPYRIGHT)
--
-- Datatypes and functions common to the implementation of the various
-- plot types.
--
{-# LANGUAGE TemplateHaskell #-}

module Graphics.Rendering.Chart.Plot.Types(
    Plot(..),
    joinPlot,
    ToPlot(..),

    mapXY,

    plot_render,
    plot_legend,
    plot_all_points,

    ) where

import Graphics.Rendering.Chart.Geometry
import Graphics.Rendering.Chart.Drawing
import Control.Lens

-- | Interface to control plotting on a 2D area.
data Plot x y = Plot {

    -- | Given the mapping between model space coordinates and device
    --   coordinates, render this plot into a chart.
    Plot x y -> PointMapFn x y -> BackendProgram ()
_plot_render     :: PointMapFn x y -> BackendProgram (),

    -- | Details for how to show this plot in a legend. For each item
    --   the string is the text to show, and the function renders a
    --   graphical sample of the plot.
    Plot x y -> [(String, Rect -> BackendProgram ())]
_plot_legend     :: [ (String, Rect -> BackendProgram ()) ],

    -- | All of the model space coordinates to be plotted. These are
    --   used to autoscale the axes where necessary.
    Plot x y -> ([x], [y])
_plot_all_points :: ([x],[y])
}

-- | A type class abstracting the conversion of a value to a Plot.
class ToPlot a where
   toPlot :: a x y -> Plot x y

instance ToPlot Plot where
  toPlot :: Plot x y -> Plot x y
toPlot Plot x y
p = Plot x y
p

-- | Join any two plots together (they will share a legend).
joinPlot :: Plot x y -> Plot x y -> Plot x y
joinPlot :: Plot x y -> Plot x y -> Plot x y
joinPlot Plot{ _plot_render :: forall x y. Plot x y -> PointMapFn x y -> BackendProgram ()
_plot_render     = PointMapFn x y -> BackendProgram ()
renderP
             , _plot_legend :: forall x y. Plot x y -> [(String, Rect -> BackendProgram ())]
_plot_legend     = [(String, Rect -> BackendProgram ())]
legendP
             , _plot_all_points :: forall x y. Plot x y -> ([x], [y])
_plot_all_points = ([x]
xsP,[y]
ysP) }
         Plot{ _plot_render :: forall x y. Plot x y -> PointMapFn x y -> BackendProgram ()
_plot_render     = PointMapFn x y -> BackendProgram ()
renderQ
             , _plot_legend :: forall x y. Plot x y -> [(String, Rect -> BackendProgram ())]
_plot_legend     = [(String, Rect -> BackendProgram ())]
legendQ
             , _plot_all_points :: forall x y. Plot x y -> ([x], [y])
_plot_all_points = ([x]
xsQ,[y]
ysQ) }

       = Plot :: forall x y.
(PointMapFn x y -> BackendProgram ())
-> [(String, Rect -> BackendProgram ())] -> ([x], [y]) -> Plot x y
Plot{ _plot_render :: PointMapFn x y -> BackendProgram ()
_plot_render     = \PointMapFn x y
a-> PointMapFn x y -> BackendProgram ()
renderP PointMapFn x y
a BackendProgram () -> BackendProgram () -> BackendProgram ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> PointMapFn x y -> BackendProgram ()
renderQ PointMapFn x y
a
             , _plot_legend :: [(String, Rect -> BackendProgram ())]
_plot_legend     = [(String, Rect -> BackendProgram ())]
legendP [(String, Rect -> BackendProgram ())]
-> [(String, Rect -> BackendProgram ())]
-> [(String, Rect -> BackendProgram ())]
forall a. [a] -> [a] -> [a]
++ [(String, Rect -> BackendProgram ())]
legendQ
             , _plot_all_points :: ([x], [y])
_plot_all_points = ( [x]
xsP[x] -> [x] -> [x]
forall a. [a] -> [a] -> [a]
++[x]
xsQ, [y]
ysP[y] -> [y] -> [y]
forall a. [a] -> [a] -> [a]
++[y]
ysQ )
             }


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

mapXY :: PointMapFn x y -> (x,y) -> Point
mapXY :: PointMapFn x y -> (x, y) -> Point
mapXY PointMapFn x y
f (x
x,y
y) = PointMapFn x y
f (x -> Limit x
forall a. a -> Limit a
LValue x
x, y -> Limit y
forall a. a -> Limit a
LValue y
y)

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



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

$( makeLenses ''Plot )