    -- | A vertical bar that can plot data in the range [0, 1].  The
    -- colors are configurable.
    module System.Taffybar.Widgets.VerticalBar (
      -- * Types
      VerticalBarHandle,
      BarConfig(..),
      BarDirection(..),
      -- * Accessors/Constructors
      verticalBarNew,
      verticalBarSetPercent,
      defaultBarConfig
      ) where

    import Control.Concurrent
    import qualified Graphics.Rendering.Cairo as C
    import Graphics.UI.Gtk

    newtype VerticalBarHandle = VBH (MVar VerticalBarState)
    data VerticalBarState =
      VerticalBarState { barIsBootstrapped :: Bool
                       , barPercent :: Double
                       , barCanvas :: DrawingArea
                       , barConfig :: BarConfig
                       }

    data BarDirection = HORIZONTAL | VERTICAL

    data BarConfig =
      BarConfig { barBorderColor :: (Double, Double, Double) -- ^ Color of the border drawn around the widget
                , barBackgroundColor :: Double -> (Double, Double, Double) -- ^ The background color of the widget
                , barColor :: Double -> (Double, Double, Double) -- ^ A function to determine the color of the widget for the current data point
                , barPadding :: Int -- ^ Number of pixels of padding around the widget
                , barWidth :: Int
                , barDirection :: BarDirection
                }

    -- | A default bar configuration.  The color of the active portion of
    -- the bar must be specified.
    defaultBarConfig :: (Double -> (Double, Double, Double)) -> BarConfig
    defaultBarConfig c = BarConfig { barBorderColor = (0.5, 0.5, 0.5)
                                   , barBackgroundColor = const (0, 0, 0)
                                   , barColor = c
                                   , barPadding = 2
                                   , barWidth = 15
                                   , barDirection = VERTICAL
                                   }

    verticalBarSetPercent :: VerticalBarHandle -> Double -> IO ()
    verticalBarSetPercent (VBH mv) pct = do
      s <- readMVar mv
      let drawArea = barCanvas s
      case barIsBootstrapped s of
        False -> return ()
        True -> do
          modifyMVar_ mv (\s' -> return s' { barPercent = clamp 0 1 pct })
          postGUIAsync $ widgetQueueDraw drawArea

    clamp :: Double -> Double -> Double -> Double
    clamp lo hi d = max lo $ min hi d

    renderFrame :: Double -> BarConfig -> Int -> Int -> C.Render ()
    renderFrame pct cfg width height = do
      let fwidth = fromIntegral width
          fheight = fromIntegral height

      -- Now draw the user's requested background, respecting padding
      let (bgR, bgG, bgB) = barBackgroundColor cfg pct
          pad = barPadding cfg
          fpad = fromIntegral pad
      C.setSourceRGB bgR bgG bgB
      C.rectangle fpad fpad (fwidth - 2 * fpad) (fheight - 2 * fpad)
      C.fill

      -- Now draw a nice frame
      let (frameR, frameG, frameB) = barBorderColor cfg
      C.setSourceRGB frameR frameG frameB
      C.setLineWidth 1.0
      C.rectangle (fpad + 0.5) (fpad + 0.5) (fwidth - 2 * fpad - 1) (fheight - 2 * fpad - 1)
      C.stroke

    renderBar :: Double -> BarConfig -> Int -> Int -> C.Render ()
    renderBar pct cfg width height = do
      let direction = barDirection cfg
          activeHeight = case direction of
                           VERTICAL   -> pct * (fromIntegral height)
                           HORIZONTAL -> fromIntegral height
          activeWidth  = case direction of
                           VERTICAL   -> fromIntegral width
                           HORIZONTAL -> pct * (fromIntegral width)
          newOrigin    = case direction of
                           VERTICAL -> fromIntegral height - activeHeight
                           HORIZONTAL -> 0
          pad = barPadding cfg

      renderFrame pct cfg width height

      -- After we draw the frame, transform the coordinate space so that
      -- we only draw within the frame.
      C.translate (fromIntegral pad + 1) (fromIntegral pad + 1)
      let xS = fromIntegral (width - 2 * pad - 2) / fromIntegral width
          yS = fromIntegral (height - 2 * pad - 2) / fromIntegral height
      C.scale xS yS

      let (r, g, b) = (barColor cfg) pct
      C.setSourceRGB r g b
      C.translate 0 newOrigin
      C.rectangle 0 0 activeWidth activeHeight
      C.fill

    drawBar :: MVar VerticalBarState -> DrawingArea -> IO ()
    drawBar mv drawArea = do
      (w, h) <- widgetGetSize drawArea
      drawWin <- widgetGetDrawWindow drawArea
      s <- readMVar mv
      let pct = barPercent s
      modifyMVar_ mv (\s' -> return s' { barIsBootstrapped = True })
      renderWithDrawable drawWin (renderBar pct (barConfig s) w h)

    verticalBarNew :: BarConfig -> IO (Widget, VerticalBarHandle)
    verticalBarNew cfg = do
      drawArea <- drawingAreaNew

      mv <- newMVar VerticalBarState { barIsBootstrapped = False
                                     , barPercent = 0
                                     , barCanvas = drawArea
                                     , barConfig = cfg
                                     }

      widgetSetSizeRequest drawArea (barWidth cfg) (-1)
      _ <- on drawArea exposeEvent $ tryEvent $ C.liftIO (drawBar mv drawArea)

      box <- hBoxNew False 1
      boxPackStart box drawArea PackGrow 0
      widgetShowAll box

      return (toWidget box, VBH mv)