{-# LANGUAGE TemplateHaskell #-}
module Graphics.Rendering.Chart.Plot.Candle(
PlotCandle(..),
Candle(..),
plot_candle_title,
plot_candle_line_style,
plot_candle_tick_length,
plot_candle_width,
plot_candle_centre,
plot_candle_fill,
plot_candle_rise_fill_style,
plot_candle_fall_fill_style,
plot_candle_values,
) where
import Control.Lens hiding (op)
import Graphics.Rendering.Chart.Geometry hiding (close)
import Graphics.Rendering.Chart.Drawing
import Graphics.Rendering.Chart.Plot.Types
import Control.Monad
import Data.Colour (opaque)
import Data.Colour.Names (white, blue)
import Data.Default.Class
data PlotCandle x y = PlotCandle {
forall x y. PlotCandle x y -> String
_plot_candle_title :: String,
forall x y. PlotCandle x y -> LineStyle
_plot_candle_line_style :: LineStyle,
forall x y. PlotCandle x y -> Bool
_plot_candle_fill :: Bool,
forall x y. PlotCandle x y -> FillStyle
_plot_candle_rise_fill_style :: FillStyle,
forall x y. PlotCandle x y -> FillStyle
_plot_candle_fall_fill_style :: FillStyle,
forall x y. PlotCandle x y -> Double
_plot_candle_tick_length :: Double,
forall x y. PlotCandle x y -> Double
_plot_candle_width :: Double,
forall x y. PlotCandle x y -> Double
_plot_candle_centre :: Double,
forall x y. PlotCandle x y -> [Candle x y]
_plot_candle_values :: [Candle x y]
}
data Candle x y = Candle { forall x y. Candle x y -> x
candle_x :: x
, forall x y. Candle x y -> y
candle_low :: y
, forall x y. Candle x y -> y
candle_open :: y
, forall x y. Candle x y -> y
candle_mid :: y
, forall x y. Candle x y -> y
candle_close :: y
, forall x y. Candle x y -> y
candle_high :: y
} deriving (Int -> Candle x y -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall x y. (Show x, Show y) => Int -> Candle x y -> ShowS
forall x y. (Show x, Show y) => [Candle x y] -> ShowS
forall x y. (Show x, Show y) => Candle x y -> String
showList :: [Candle x y] -> ShowS
$cshowList :: forall x y. (Show x, Show y) => [Candle x y] -> ShowS
show :: Candle x y -> String
$cshow :: forall x y. (Show x, Show y) => Candle x y -> String
showsPrec :: Int -> Candle x y -> ShowS
$cshowsPrec :: forall x y. (Show x, Show y) => Int -> Candle x y -> ShowS
Show)
instance ToPlot PlotCandle where
toPlot :: forall x y. PlotCandle x y -> Plot x y
toPlot PlotCandle x y
p = Plot {
_plot_render :: PointMapFn x y -> BackendProgram ()
_plot_render = forall x y. PlotCandle x y -> PointMapFn x y -> BackendProgram ()
renderPlotCandle PlotCandle x y
p,
_plot_legend :: [(String, Rect -> BackendProgram ())]
_plot_legend = [(forall x y. PlotCandle x y -> String
_plot_candle_title PlotCandle x y
p, forall x y. PlotCandle x y -> Rect -> BackendProgram ()
renderPlotLegendCandle PlotCandle x y
p)],
_plot_all_points :: ([x], [y])
_plot_all_points = ( forall a b. (a -> b) -> [a] -> [b]
map forall x y. Candle x y -> x
candle_x [Candle x y]
pts
, forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ [forall x y. Candle x y -> y
candle_low Candle x y
c, forall x y. Candle x y -> y
candle_high Candle x y
c]
| Candle x y
c <- [Candle x y]
pts ] )
}
where
pts :: [Candle x y]
pts = forall x y. PlotCandle x y -> [Candle x y]
_plot_candle_values PlotCandle x y
p
renderPlotCandle :: PlotCandle x y -> PointMapFn x y -> BackendProgram ()
renderPlotCandle :: forall x y. PlotCandle x y -> PointMapFn x y -> BackendProgram ()
renderPlotCandle PlotCandle x y
p PointMapFn x y
pmap =
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall x y.
PlotCandle x y -> Candle Double Double -> BackendProgram ()
drawCandle PlotCandle x y
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. Candle x y -> Candle Double Double
candlemap) (forall x y. PlotCandle x y -> [Candle x y]
_plot_candle_values PlotCandle x y
p)
where
candlemap :: Candle x y -> Candle Double Double
candlemap (Candle x
x y
lo y
op y
mid y
cl y
hi) =
forall x y. x -> y -> y -> y -> y -> y -> Candle x y
Candle Double
x' Double
lo' Double
op' Double
mid' Double
cl' Double
hi'
where (Point Double
x' Double
mid') = (x, y) -> Point
pmap' (x
x,y
mid)
(Point Double
_ Double
lo') = (x, y) -> Point
pmap' (x
x,y
lo)
(Point Double
_ Double
op') = (x, y) -> Point
pmap' (x
x,y
op)
(Point Double
_ Double
cl') = (x, y) -> Point
pmap' (x
x,y
cl)
(Point Double
_ Double
hi') = (x, y) -> Point
pmap' (x
x,y
hi)
pmap' :: (x, y) -> Point
pmap' = forall x y. PointMapFn x y -> (x, y) -> Point
mapXY PointMapFn x y
pmap
drawCandle :: PlotCandle x y -> Candle Double Double -> BackendProgram ()
drawCandle :: forall x y.
PlotCandle x y -> Candle Double Double -> BackendProgram ()
drawCandle PlotCandle x y
ps (Candle Double
x Double
lo Double
open Double
mid Double
close Double
hi) = do
let tl :: Double
tl = forall x y. PlotCandle x y -> Double
_plot_candle_tick_length PlotCandle x y
ps
let wd :: Double
wd = forall x y. PlotCandle x y -> Double
_plot_candle_width PlotCandle x y
ps
let ct :: Double
ct = forall x y. PlotCandle x y -> Double
_plot_candle_centre PlotCandle x y
ps
let f :: Bool
f = forall x y. PlotCandle x y -> Bool
_plot_candle_fill PlotCandle x y
ps
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
f forall a b. (a -> b) -> a -> b
$ forall a. FillStyle -> BackendProgram a -> BackendProgram a
withFillStyle (if Double
open forall a. Ord a => a -> a -> Bool
>= Double
close
then forall x y. PlotCandle x y -> FillStyle
_plot_candle_rise_fill_style PlotCandle x y
ps
else forall x y. PlotCandle x y -> FillStyle
_plot_candle_fall_fill_style PlotCandle x y
ps) forall a b. (a -> b) -> a -> b
$
Path -> BackendProgram ()
fillPath forall a b. (a -> b) -> a -> b
$ Double -> Double -> Path
moveTo' (Double
xforall a. Num a => a -> a -> a
-Double
wd) Double
open
forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Path
lineTo' (Double
xforall a. Num a => a -> a -> a
-Double
wd) Double
close
forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Path
lineTo' (Double
xforall a. Num a => a -> a -> a
+Double
wd) Double
close
forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Path
lineTo' (Double
xforall a. Num a => a -> a -> a
+Double
wd) Double
open
forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Path
lineTo' (Double
xforall a. Num a => a -> a -> a
-Double
wd) Double
open
forall a. LineStyle -> BackendProgram a -> BackendProgram a
withLineStyle (forall x y. PlotCandle x y -> LineStyle
_plot_candle_line_style PlotCandle x y
ps) forall a b. (a -> b) -> a -> b
$ do
Path -> BackendProgram ()
strokePath forall a b. (a -> b) -> a -> b
$ Double -> Double -> Path
moveTo' (Double
xforall a. Num a => a -> a -> a
-Double
wd) Double
open
forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Path
lineTo' (Double
xforall a. Num a => a -> a -> a
-Double
wd) Double
close
forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Path
lineTo' (Double
xforall a. Num a => a -> a -> a
+Double
wd) Double
close
forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Path
lineTo' (Double
xforall a. Num a => a -> a -> a
+Double
wd) Double
open
forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Path
lineTo' (Double
xforall a. Num a => a -> a -> a
-Double
wd) Double
open
Path -> BackendProgram ()
strokePath forall a b. (a -> b) -> a -> b
$ Double -> Double -> Path
moveTo' Double
x (forall a. Ord a => a -> a -> a
min Double
lo Double
hi)
forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Path
lineTo' Double
x (forall a. Ord a => a -> a -> a
min Double
open Double
close)
forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Path
moveTo' Double
x (forall a. Ord a => a -> a -> a
max Double
open Double
close)
forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Path
lineTo' Double
x (forall a. Ord a => a -> a -> a
max Double
hi Double
lo)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Double
tl forall a. Ord a => a -> a -> Bool
> Double
0) forall a b. (a -> b) -> a -> b
$ Path -> BackendProgram ()
strokePath forall a b. (a -> b) -> a -> b
$ Double -> Double -> Path
moveTo' (Double
xforall a. Num a => a -> a -> a
-Double
tl) Double
lo
forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Path
lineTo' (Double
xforall a. Num a => a -> a -> a
+Double
tl) Double
lo
forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Path
moveTo' (Double
xforall a. Num a => a -> a -> a
-Double
tl) Double
hi
forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Path
lineTo' (Double
xforall a. Num a => a -> a -> a
+Double
tl) Double
hi
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Double
ct forall a. Ord a => a -> a -> Bool
> Double
0) forall a b. (a -> b) -> a -> b
$ Path -> BackendProgram ()
strokePath forall a b. (a -> b) -> a -> b
$ Double -> Double -> Path
moveTo' (Double
xforall a. Num a => a -> a -> a
-Double
ct) Double
mid
forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Path
lineTo' (Double
xforall a. Num a => a -> a -> a
+Double
ct) Double
mid
renderPlotLegendCandle :: PlotCandle x y -> Rect -> BackendProgram ()
renderPlotLegendCandle :: forall x y. PlotCandle x y -> Rect -> BackendProgram ()
renderPlotLegendCandle PlotCandle x y
pc (Rect Point
p1 Point
p2) = do
forall x y.
PlotCandle x y -> Candle Double Double -> BackendProgram ()
drawCandle PlotCandle x y
pc2 (forall x y. x -> y -> y -> y -> y -> y -> Candle x y
Candle (Double
xwidforall a. Num a => a -> a -> a
*Double
1forall a. Fractional a => a -> a -> a
/Double
4) Double
lo Double
open Double
mid Double
close Double
hi)
forall x y.
PlotCandle x y -> Candle Double Double -> BackendProgram ()
drawCandle PlotCandle x y
pc2 (forall x y. x -> y -> y -> y -> y -> y -> Candle x y
Candle (Double
xwidforall a. Num a => a -> a -> a
*Double
2forall a. Fractional a => a -> a -> a
/Double
3) Double
lo Double
close Double
mid Double
open Double
hi)
where
pc2 :: PlotCandle x y
pc2 = PlotCandle x y
pc { _plot_candle_width :: Double
_plot_candle_width = Double
2 }
xwid :: Double
xwid = Point -> Double
p_x Point
p1 forall a. Num a => a -> a -> a
+ Point -> Double
p_x Point
p2
lo :: Double
lo = forall a. Ord a => a -> a -> a
max (Point -> Double
p_y Point
p1) (Point -> Double
p_y Point
p2)
mid :: Double
mid = (Point -> Double
p_y Point
p1 forall a. Num a => a -> a -> a
+ Point -> Double
p_y Point
p2)forall a. Fractional a => a -> a -> a
/Double
2
hi :: Double
hi = forall a. Ord a => a -> a -> a
min (Point -> Double
p_y Point
p1) (Point -> Double
p_y Point
p2)
open :: Double
open = (Double
lo forall a. Num a => a -> a -> a
+ Double
mid) forall a. Fractional a => a -> a -> a
/ Double
2
close :: Double
close = (Double
mid forall a. Num a => a -> a -> a
+ Double
hi) forall a. Fractional a => a -> a -> a
/ Double
2
instance Default (PlotCandle x y) where
def :: PlotCandle x y
def = PlotCandle
{ _plot_candle_title :: String
_plot_candle_title = String
""
, _plot_candle_line_style :: LineStyle
_plot_candle_line_style = Double -> AlphaColour Double -> LineStyle
solidLine Double
1 forall a b. (a -> b) -> a -> b
$ forall a. Num a => Colour a -> AlphaColour a
opaque forall a. (Ord a, Floating a) => Colour a
blue
, _plot_candle_fill :: Bool
_plot_candle_fill = Bool
False
, _plot_candle_rise_fill_style :: FillStyle
_plot_candle_rise_fill_style = AlphaColour Double -> FillStyle
solidFillStyle forall a b. (a -> b) -> a -> b
$ forall a. Num a => Colour a -> AlphaColour a
opaque forall a. (Ord a, Floating a) => Colour a
white
, _plot_candle_fall_fill_style :: FillStyle
_plot_candle_fall_fill_style = AlphaColour Double -> FillStyle
solidFillStyle forall a b. (a -> b) -> a -> b
$ forall a. Num a => Colour a -> AlphaColour a
opaque forall a. (Ord a, Floating a) => Colour a
blue
, _plot_candle_tick_length :: Double
_plot_candle_tick_length = Double
2
, _plot_candle_width :: Double
_plot_candle_width = Double
5
, _plot_candle_centre :: Double
_plot_candle_centre = Double
0
, _plot_candle_values :: [Candle x y]
_plot_candle_values = []
}
$( makeLenses ''PlotCandle )