Chart-fltkhs-0.1.0.4: examples/Example3.hs

{-# LANGUAGE OverloadedStrings
  , BangPatterns
  , MultiWayIf
  , LambdaCase
  , TemplateHaskell
#-}
module Main where


import           Control.Monad                  ( void )

import qualified Graphics.UI.FLTK.LowLevel.FL  as FL
import           Graphics.UI.FLTK.LowLevel.Fl_Types
import           Graphics.UI.FLTK.LowLevel.FLTKHS
                                               as FL
import           Data.Colour
import           Data.Colour.SRGB
import           Data.Time.LocalTime
import           Data.Time.Calendar

import           Control.Lens

import           Graphics.Rendering.Chart.Easy as Ch
import           Graphics.Rendering.Chart.Backend.FLTKHS

import           Prices                         ( prices1 )

fillBetween title vs = liftEC $ do
    plot_fillbetween_title .= title
    color <- takeColor
    plot_fillbetween_style .= solidFillStyle color
    plot_fillbetween_values .= vs


green1 = opaque $ sRGB 0.5 1 0.5
blue1 = opaque $ sRGB 0.5 0.5 1

chart = toRenderable layout
  where
    price1 =
        plot_fillbetween_style
            .~ solidFillStyle green1
            $  plot_fillbetween_values
            .~ [ (d, (0, v2)) | (d, v1, v2) <- prices1 ]
            $  plot_fillbetween_title
            .~ "price 1"
            $  def

    price2 =
        plot_fillbetween_style
            .~ solidFillStyle blue1
            $  plot_fillbetween_values
            .~ [ (d, (0, v1)) | (d, v1, v2) <- prices1 ]
            $  plot_fillbetween_title
            .~ "price 2"
            $  def

    layout =
        layout_title
            .~ "Price History"
            $  layout_grid_last
            .~ True
            $  layout_plots
            .~ [toPlot price1, toPlot price2]
            $  def


drawChart :: Ref Widget -> IO ()
drawChart widget = do
    rectangle' <- getRectangle widget
    withFlClip rectangle' $
        renderToWidgetEC widget $ do
            layout_title .= "Price History"
            plot
                (fillBetween "price 1" [ (d, (0, v2)) | (d, v1, v2) <- prices1 ]
                )
            plot
                (fillBetween "price 2" [ (d, (0, v1)) | (d, v1, v2) <- prices1 ]
                )


main :: IO ()
main = do
    let width  = 800
        height = 600

    window' <- doubleWindowNew (Size (Width width) (Height height))
                               Nothing
                               Nothing
    begin window'
    widget' <- widgetCustom
        (FL.Rectangle (Position (X 0) (Y 0))
                      (Size (Width width) (Height height))
        )
        Nothing
        drawChart
        defaultCustomWidgetFuncs
    end window'
    showWidget window'
    void FL.run