module Graphics.Rendering.Chart.Plot.Candle(
PlotCandle(..),
Candle(..),
defaultPlotCandle,
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 Data.Accessor.Template
import qualified Graphics.Rendering.Cairo as C
import Graphics.Rendering.Chart.Types
import Graphics.Rendering.Chart.Renderable
import Graphics.Rendering.Chart.Plot.Types
import Control.Monad
import Data.Colour (opaque)
import Data.Colour.Names (black, white, blue)
import Data.Colour.SRGB (sRGB)
data PlotCandle x y = PlotCandle {
plot_candle_title_ :: String,
plot_candle_line_style_ :: CairoLineStyle,
plot_candle_fill_ :: Bool,
plot_candle_rise_fill_style_ :: CairoFillStyle,
plot_candle_fall_fill_style_ :: CairoFillStyle,
plot_candle_tick_length_ :: Double,
plot_candle_width_ :: Double,
plot_candle_centre_ :: Double,
plot_candle_values_ :: [Candle x y]
}
data Candle x y = Candle { candle_x :: x
, candle_low :: y
, candle_open :: y
, candle_mid :: y
, candle_close :: y
, candle_high :: y
} deriving (Show)
instance ToPlot PlotCandle where
toPlot p = Plot {
plot_render_ = renderPlotCandle p,
plot_legend_ = [(plot_candle_title_ p, renderPlotLegendCandle p)],
plot_all_points_ = ( map candle_x pts
, concat [ [candle_low c, candle_high c]
| c <- pts ] )
}
where
pts = plot_candle_values_ p
renderPlotCandle :: PlotCandle x y -> PointMapFn x y -> CRender ()
renderPlotCandle p pmap = preserveCState $ do
mapM_ (drawCandle p . candlemap) (plot_candle_values_ p)
where
candlemap (Candle x lo op mid cl hi) =
Candle x' lo' op' mid' cl' hi'
where (Point x' mid') = pmap' (x,mid)
(Point _ lo') = pmap' (x,lo)
(Point _ op') = pmap' (x,op)
(Point _ cl') = pmap' (x,cl)
(Point _ hi') = pmap' (x,hi)
pmap' = mapXY pmap
drawCandle ps (Candle x lo open mid close hi) = do
let tl = plot_candle_tick_length_ ps
let wd = plot_candle_width_ ps
let ct = plot_candle_centre_ ps
let f = plot_candle_fill_ ps
when f $ do setFillStyle (if open >= close
then plot_candle_rise_fill_style_ ps
else plot_candle_fall_fill_style_ ps)
c $ C.newPath
c $ C.moveTo (xwd) open
c $ C.lineTo (xwd) close
c $ C.lineTo (x+wd) close
c $ C.lineTo (x+wd) open
c $ C.lineTo (xwd) open
c $ C.fill
setLineStyle (plot_candle_line_style_ ps)
c $ C.newPath
c $ C.moveTo (xwd) open
c $ C.lineTo (xwd) close
c $ C.lineTo (x+wd) close
c $ C.lineTo (x+wd) open
c $ C.lineTo (xwd) open
c $ C.stroke
c $ C.newPath
c $ C.moveTo x (min lo hi)
c $ C.lineTo x (min open close)
c $ C.moveTo x (max open close)
c $ C.lineTo x (max hi lo)
c $ C.stroke
when (tl > 0) $ do c $ C.newPath
c $ C.moveTo (xtl) lo
c $ C.lineTo (x+tl) lo
c $ C.moveTo (xtl) hi
c $ C.lineTo (x+tl) hi
c $ C.stroke
when (ct > 0) $ do c $ C.moveTo (xct) mid
c $ C.lineTo (x+ct) mid
c $ C.stroke
renderPlotLegendCandle :: PlotCandle x y -> Rect -> CRender ()
renderPlotLegendCandle p r@(Rect p1 p2) = preserveCState $ do
drawCandle p{ plot_candle_width_ = 2}
(Candle ((p_x p1 + p_x p2)*1/4) lo open mid close hi)
drawCandle p{ plot_candle_width_ = 2}
(Candle ((p_x p1 + p_x p2)*2/3) lo close mid open hi)
where
lo = max (p_y p1) (p_y p2)
mid = (p_y p1 + p_y p2)/2
hi = min (p_y p1) (p_y p2)
open = (lo + mid) / 2
close = (mid + hi) / 2
defaultPlotCandle :: PlotCandle x y
defaultPlotCandle = PlotCandle {
plot_candle_title_ = "",
plot_candle_line_style_ = solidLine 1 $ opaque blue,
plot_candle_fill_ = False,
plot_candle_rise_fill_style_ = solidFillStyle $ opaque white,
plot_candle_fall_fill_style_ = solidFillStyle $ opaque blue,
plot_candle_tick_length_ = 2,
plot_candle_width_ = 5,
plot_candle_centre_ = 0,
plot_candle_values_ = []
}
$( deriveAccessors ''PlotCandle )