Chart-fltkhs-0.1.0.4: examples/Example2.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.Time.LocalTime

import           Control.Lens

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

import           Prices                         ( prices
                                                , mkDate
                                                , filterPrices
                                                )

prices' :: [(LocalTime, Double, Double)]
prices' = filterPrices prices (mkDate 1 1 2005) (mkDate 31 12 2006)


chart = toRenderable layout
  where

    price1 =
        plot_lines_style
            .  line_color
            .~ opaque blue
            $  plot_lines_values
            .~ [[ (d, v) | (d, v, _) <- prices' ]]
            $  plot_lines_title
            .~ "price 1"
            $  def

    price2 =
        plot_lines_style
            .  line_color
            .~ opaque green
            $  plot_lines_values
            .~ [[ (d, v) | (d, _, v) <- prices' ]]
            $  plot_lines_title
            .~ "price 2"
            $  def

    layout =
        layoutlr_title
            .~ "Price History"
            $  layoutlr_left_axis
            .  laxis_override
            .~ axisGridHide
            $  layoutlr_right_axis
            .  laxis_override
            .~ axisGridHide
            $  layoutlr_x_axis
            .  laxis_override
            .~ axisGridHide
            $  layoutlr_plots
            .~ [Left (toPlot price1), Right (toPlot price2)]
            $  layoutlr_grid_last
            .~ False
            $  def



drawChart :: Ref Widget -> IO ()
drawChart widget = do
    rectangle' <- getRectangle widget
    let (x', y', w', h') = fromRectangle rectangle'
    withFlClip rectangle' $
        renderToWidgetEC widget $ do
            layoutlr_title .= "Price History"
            layoutlr_left_axis . laxis_override .= axisGridHide
            layoutlr_right_axis . laxis_override .= axisGridHide
            plotLeft (line "price 1" [[ (d, v) | (d, v, _) <- prices' ]])
            plotRight (line "price 2" [[ (d, v) | (d, _, v) <- prices' ]])



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