-----------------------------------------------------------------------------
-- |
-- Module      :  Graphics.Rendering.Chart.Plot.Hidden
-- Copyright   :  (c) Tim Docker 2006, 2014
-- License     :  BSD-style (see chart/COPYRIGHT)
--
-- Plots that don't show, but occupy space so as to effect axis
-- scaling
--
{-# LANGUAGE TemplateHaskell #-}

module Graphics.Rendering.Chart.Plot.Hidden(
    PlotHidden(..),
    
    plot_hidden_x_values,
    plot_hidden_y_values
) where

import Control.Lens
import Graphics.Rendering.Chart.Plot.Types

-- | Value defining some hidden x and y values. The values are
--   not displayed, but they still affect axis scaling.
data PlotHidden x y = PlotHidden {
    PlotHidden x y -> [x]
_plot_hidden_x_values :: [x],
    PlotHidden x y -> [y]
_plot_hidden_y_values :: [y]
}

instance ToPlot PlotHidden where
    toPlot :: PlotHidden x y -> Plot x y
toPlot PlotHidden x y
ph = 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
_ -> () -> BackendProgram ()
forall (m :: * -> *) a. Monad m => a -> m a
return (),
        _plot_legend :: [(String, Rect -> BackendProgram ())]
_plot_legend     = [],
        _plot_all_points :: ([x], [y])
_plot_all_points = (PlotHidden x y -> [x]
forall x y. PlotHidden x y -> [x]
_plot_hidden_x_values PlotHidden x y
ph, PlotHidden x y -> [y]
forall x y. PlotHidden x y -> [y]
_plot_hidden_y_values PlotHidden x y
ph)
    }

$( makeLenses ''PlotHidden )