Bar.hs

module Test.HUnit.Gui.Bar (Bar, createBar, changeBar)
where

import Control.Concurrent.MVar
import Graphics.Rendering.Cairo (liftIO, Render, setSourceRGB, rectangle, fill)
import Graphics.UI.Gtk hiding (fill)
import Graphics.UI.Gtk.Gdk.EventM
import Test.HUnit.Base

import Test.HUnit.Gui.BarComputations
import Test.HUnit.Gui.Status

data Bar = Bar DrawingArea (MVar Counts)

createBar :: (DrawingArea -> IO ()) -> IO Bar
createBar addToContainer =
    do
      drawingArea <- drawingAreaNew
      counts' <- newMVar emptyCounts
      let bar = Bar drawingArea counts'
      drawingArea `on` exposeEvent $ redrawBar bar
      widgetSetSizeRequest drawingArea 100 20
      addToContainer drawingArea
      return bar
    where
      emptyCounts = Counts 1 0 0 0

redrawBar :: Bar -> EventM EExpose Bool
redrawBar (Bar _ countsRef) = do
  window <- eventWindow
  liftIO $ do
    counts' <- readMVar countsRef
    (width, height) <- drawableGetSize window
    renderWithDrawable window $ drawBar counts' width height
    return True

changeBar :: Bar -> Counts -> IO ()
changeBar (Bar drawingArea countsRef) newCounts = do
  modifyMVar_ countsRef (\_ -> return newCounts)
  widgetQueueResize drawingArea

drawBar :: Counts -> Int -> Int -> Render()
drawBar counts' width height = do
  uncurry3 setSourceRGB $ colorForStatus $ succeeded counts'
  rectangle 0 0 (barWidth counts' width) (fromIntegral height)
  fill

colorForStatus :: Status -> (Double, Double, Double)
colorForStatus Red = (1, 0, 0)
colorForStatus Green = (0, 1, 0)

uncurry3 :: (a -> b -> c -> d) -> (a, b, c) -> d
uncurry3 f (x, y, z) = f x y z