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