Chart-tests-1.9.3: tests/GtkTestPicking.hs

module GtkTestPicking where

import Graphics.Rendering.Chart
import Graphics.Rendering.Chart.Layout(layoutLRToRenderable)
import Graphics.Rendering.Chart.Grid
import Graphics.Rendering.Chart.Backend.Cairo
import qualified Graphics.UI.Gtk as G
import qualified Graphics.UI.Gtk.Gdk.Events as GE
import qualified Graphics.Rendering.Cairo as C

import Data.Time.LocalTime
import Data.Colour
import Data.Colour.Names
import Data.Colour.SRGB
import Data.Default.Class
import Control.Lens
import Data.IORef
import System.Environment(getArgs)
import Prices(prices2)

type PickType = LayoutPick LocalTime Double Double

chart :: [(LocalTime,Double,Double)]
      -> Bool -> Double -> Renderable (LayoutPick LocalTime Double Double)
chart prices showMinMax lwidth = layoutLRToRenderable layout
  where

    lineStyle c = line_width .~ 3 * lwidth
                $ line_color .~ c
                $ def ^. plot_lines_style

    limitLineStyle c = line_width .~ lwidth
                $ line_color .~ opaque c
                $ line_dashes .~ [5,10]
                $ def ^. plot_lines_style

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

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

    (min1,max1) = (minimum [v | (_,v,_) <- prices],maximum [v | (_,v,_) <- prices])
    (min2,max2) = (minimum [v | (_,_,v) <- prices],maximum [v | (_,_,v) <- prices])
    limits | showMinMax = [ Left $ hlinePlot "min/max" (limitLineStyle blue) min1,
                            Left $ hlinePlot "" (limitLineStyle blue) max1,
                            Right $ hlinePlot "min/max" (limitLineStyle green) min2,
                            Right $ hlinePlot "" (limitLineStyle green) max2 ]
           | otherwise  = []

    bg = opaque $ sRGB 0 0 0.25
    fg = opaque white
    fg1 = opaque $ sRGB 0.0 0.0 0.15

    layout = layoutlr_title .~"Price History"
           $ layoutlr_background .~ solidFillStyle bg
           $ layoutlr_axes_styles %~ (axis_grid_style .~ solidLine 1 fg1)
           $ 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)] ++ limits)
           $ layoutlr_grid_last .~ False
           $ layoutlr_foreground .~ fg
           $ def

updateCanvas :: Renderable a -> G.DrawingArea -> IORef (Maybe (PickFn a)) -> IO Bool
updateCanvas chart canvas pickfv = do
    win <- G.widgetGetDrawWindow canvas
    (width, height) <- G.widgetGetSize canvas
    let sz = (fromIntegral width,fromIntegral height)
    pickf <- G.renderWithDrawable win $ runBackend (defaultEnv bitmapAlignmentFns) (render chart sz)
    writeIORef pickfv (Just pickf)
    return True

createRenderableWindow :: (Show a) => Renderable a -> Int -> Int -> IO G.Window
createRenderableWindow chart windowWidth windowHeight = do
    pickfv <- newIORef Nothing
    window <- G.windowNew
    canvas <- G.drawingAreaNew
    G.widgetSetSizeRequest window windowWidth windowHeight
    G.onExpose canvas $ const (updateCanvas chart canvas pickfv)
    G.onButtonPress canvas $ \(GE.Button{GE.eventX=x,GE.eventY=y}) -> do
        print (x,y)
        (Just pickf) <- readIORef pickfv
        print (pickf (Point x y))
        return True
    G.set window [G.containerChild G.:= canvas]
    return window

chartWindow = do
    window <- createRenderableWindow (chart prices2 True 1.00) 640 480
    G.onDestroy window G.mainQuit
    G.widgetShowAll window
    G.mainGUI

gridWindow = do
    window <- createRenderableWindow (gridToRenderable testgrid) 640 480
    G.onDestroy window G.mainQuit
    G.widgetShowAll window
    G.mainGUI
  where
    testgrid :: Grid (Renderable String)
    testgrid = aboveN
        [ besideN [ f "AAAAA", e, f "BBBBB" ]
        , besideN [ f "CCCCC", e, f "DDDDD" ]
        ]
    f s = tval $ setPickFn (const (Just s)) $ label def HTA_Centre VTA_Centre s
    e = tval $ spacer (20,20)


main = do
  G.initGUI
  chartWindow