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

    import           Control.Concurrent
    import           Control.Monad
    import           Control.Monad.IO.Class
    import qualified GI.Cairo.Render as C
    import           GI.Cairo.Render.Connector
    import           GI.Gtk hiding (widgetGetAllocatedSize)
    import           System.Taffybar.Util
    import           System.Taffybar.Widget.Util

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

    data BarDirection = HORIZONTAL | VERTICAL

    data BarConfig
      = BarConfig {
         -- | Color of the border drawn around the widget
          BarConfig -> (Double, Double, Double)
    barBorderColor :: (Double, Double, Double)
         -- | The background color of the widget
        , BarConfig -> Double -> (Double, Double, Double)
    barBackgroundColor :: Double -> (Double, Double, Double)
         -- | A function to determine the color of the widget for the current data point
        , BarConfig -> Double -> (Double, Double, Double)
    barColor :: Double -> (Double, Double, Double)
         -- | Number of pixels of padding around the widget
        , BarConfig -> Int
    barPadding :: Int
        , BarConfig -> Int
    barWidth :: Int
        , BarConfig -> BarDirection
    barDirection :: BarDirection}
      | BarConfigIO { BarConfig -> IO (Double, Double, Double)
    barBorderColorIO :: IO (Double, Double, Double)
                    , BarConfig -> Double -> IO (Double, Double, Double)
    barBackgroundColorIO :: Double -> IO (Double, Double, Double)
                    , BarConfig -> Double -> IO (Double, Double, Double)
    barColorIO :: Double -> IO (Double, Double, Double)
                    , barPadding :: Int
                    , 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 :: (Double -> (Double, Double, Double)) -> BarConfig
    defaultBarConfig c :: Double -> (Double, Double, Double)
    c =
      BarConfig :: (Double, Double, Double)
    -> (Double -> (Double, Double, Double))
    -> (Double -> (Double, Double, Double))
    -> Int
    -> Int
    -> BarDirection
    -> BarConfig
    BarConfig
      { barBorderColor :: (Double, Double, Double)
    barBorderColor = (0.5, 0.5, 0.5)
      , barBackgroundColor :: Double -> (Double, Double, Double)
    barBackgroundColor = (Double, Double, Double) -> Double -> (Double, Double, Double)
    forall a b. a -> b -> a
    const (0, 0, 0)
      , barColor :: Double -> (Double, Double, Double)
    barColor = Double -> (Double, Double, Double)
    c
      , barPadding :: Int
    barPadding = 2
      , barWidth :: Int
    barWidth = 15
      , barDirection :: BarDirection
    barDirection = BarDirection
    VERTICAL
      }

    defaultBarConfigIO :: (Double -> IO (Double, Double, Double)) -> BarConfig
    defaultBarConfigIO :: (Double -> IO (Double, Double, Double)) -> BarConfig
    defaultBarConfigIO c :: Double -> IO (Double, Double, Double)
    c =
      BarConfigIO :: IO (Double, Double, Double)
    -> (Double -> IO (Double, Double, Double))
    -> (Double -> IO (Double, Double, Double))
    -> Int
    -> Int
    -> BarDirection
    -> BarConfig
    BarConfigIO
      { barBorderColorIO :: IO (Double, Double, Double)
    barBorderColorIO = (Double, Double, Double) -> IO (Double, Double, Double)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (0.5, 0.5, 0.5)
      , barBackgroundColorIO :: Double -> IO (Double, Double, Double)
    barBackgroundColorIO = \_ -> (Double, Double, Double) -> IO (Double, Double, Double)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (0, 0, 0)
      , barColorIO :: Double -> IO (Double, Double, Double)
    barColorIO = Double -> IO (Double, Double, Double)
    c
      , barPadding :: Int
    barPadding = 2
      , barWidth :: Int
    barWidth = 15
      , barDirection :: BarDirection
    barDirection = BarDirection
    VERTICAL
      }

    verticalBarSetPercent :: VerticalBarHandle -> Double -> IO ()
    verticalBarSetPercent :: VerticalBarHandle -> Double -> IO ()
    verticalBarSetPercent (VBH mv :: MVar VerticalBarState
    mv) pct :: Double
    pct = do
      VerticalBarState
    s <- MVar VerticalBarState -> IO VerticalBarState
    forall a. MVar a -> IO a
    readMVar MVar VerticalBarState
    mv
      let drawArea :: DrawingArea
    drawArea = VerticalBarState -> DrawingArea
    barCanvas VerticalBarState
    s
      Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (VerticalBarState -> Bool
    barIsBootstrapped VerticalBarState
    s) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
        MVar VerticalBarState
    -> (VerticalBarState -> IO VerticalBarState) -> IO ()
    forall a. MVar a -> (a -> IO a) -> IO ()
    modifyMVar_ MVar VerticalBarState
    mv (\s' :: VerticalBarState
    s' -> VerticalBarState -> IO VerticalBarState
    forall (m :: * -> *) a. Monad m => a -> m a
    return VerticalBarState
    s' { barPercent :: Double
    barPercent = Double -> Double -> Double -> Double
    clamp 0 1 Double
    pct })
        IO () -> IO ()
    postGUIASync (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ DrawingArea -> IO ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadIO m, IsWidget a) =>
    a -> m ()
    widgetQueueDraw DrawingArea
    drawArea

    clamp :: Double -> Double -> Double -> Double
    clamp :: Double -> Double -> Double -> Double
    clamp lo :: Double
    lo hi :: Double
    hi d :: Double
    d = Double -> Double -> Double
    forall a. Ord a => a -> a -> a
    max Double
    lo (Double -> Double) -> Double -> Double
    forall a b. (a -> b) -> a -> b
    $ Double -> Double -> Double
    forall a. Ord a => a -> a -> a
    min Double
    hi Double
    d

    liftedBackgroundColor :: BarConfig -> Double -> IO (Double, Double, Double)
    liftedBackgroundColor :: BarConfig -> Double -> IO (Double, Double, Double)
    liftedBackgroundColor bc :: BarConfig
    bc pct :: Double
    pct =
      case BarConfig
    bc of
        BarConfig { barBackgroundColor :: BarConfig -> Double -> (Double, Double, Double)
    barBackgroundColor = Double -> (Double, Double, Double)
    bcolor } -> (Double, Double, Double) -> IO (Double, Double, Double)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Double -> (Double, Double, Double)
    bcolor Double
    pct)
        BarConfigIO { barBackgroundColorIO :: BarConfig -> Double -> IO (Double, Double, Double)
    barBackgroundColorIO = Double -> IO (Double, Double, Double)
    bcolor } -> Double -> IO (Double, Double, Double)
    bcolor Double
    pct

    liftedBorderColor :: BarConfig -> IO (Double, Double, Double)
    liftedBorderColor :: BarConfig -> IO (Double, Double, Double)
    liftedBorderColor bc :: BarConfig
    bc =
      case BarConfig
    bc of
        BarConfig { barBorderColor :: BarConfig -> (Double, Double, Double)
    barBorderColor = (Double, Double, Double)
    border } -> (Double, Double, Double) -> IO (Double, Double, Double)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Double, Double, Double)
    border
        BarConfigIO { barBorderColorIO :: BarConfig -> IO (Double, Double, Double)
    barBorderColorIO = IO (Double, Double, Double)
    border } -> IO (Double, Double, Double)
    border

    liftedBarColor :: BarConfig -> Double -> IO (Double, Double, Double)
    liftedBarColor :: BarConfig -> Double -> IO (Double, Double, Double)
    liftedBarColor bc :: BarConfig
    bc pct :: Double
    pct =
      case BarConfig
    bc of
        BarConfig { barColor :: BarConfig -> Double -> (Double, Double, Double)
    barColor = Double -> (Double, Double, Double)
    c } -> (Double, Double, Double) -> IO (Double, Double, Double)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Double -> (Double, Double, Double)
    c Double
    pct)
        BarConfigIO { barColorIO :: BarConfig -> Double -> IO (Double, Double, Double)
    barColorIO = Double -> IO (Double, Double, Double)
    c } -> Double -> IO (Double, Double, Double)
    c Double
    pct

    renderFrame_ :: Double -> BarConfig -> Int -> Int -> C.Render ()
    renderFrame_ :: Double -> BarConfig -> Int -> Int -> Render ()
    renderFrame_ pct :: Double
    pct cfg :: BarConfig
    cfg width :: Int
    width height :: Int
    height = do
      let fwidth :: Double
    fwidth = Int -> Double
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    width
          fheight :: Double
    fheight = Int -> Double
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    height

      -- Now draw the user's requested background, respecting padding
      (bgR :: Double
    bgR, bgG :: Double
    bgG, bgB :: Double
    bgB) <- IO (Double, Double, Double) -> Render (Double, Double, Double)
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    C.liftIO (IO (Double, Double, Double) -> Render (Double, Double, Double))
    -> IO (Double, Double, Double) -> Render (Double, Double, Double)
    forall a b. (a -> b) -> a -> b
    $ BarConfig -> Double -> IO (Double, Double, Double)
    liftedBackgroundColor BarConfig
    cfg Double
    pct
      let pad :: Int
    pad = BarConfig -> Int
    barPadding BarConfig
    cfg
          fpad :: Double
    fpad = Int -> Double
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    pad
      Double -> Double -> Double -> Render ()
    C.setSourceRGB Double
    bgR Double
    bgG Double
    bgB
      Double -> Double -> Double -> Double -> Render ()
    C.rectangle Double
    fpad Double
    fpad (Double
    fwidth Double -> Double -> Double
    forall a. Num a => a -> a -> a
    - 2 Double -> Double -> Double
    forall a. Num a => a -> a -> a
    * Double
    fpad) (Double
    fheight Double -> Double -> Double
    forall a. Num a => a -> a -> a
    - 2 Double -> Double -> Double
    forall a. Num a => a -> a -> a
    * Double
    fpad)
      Render ()
    C.fill

      -- Now draw a nice frame
      (frameR :: Double
    frameR, frameG :: Double
    frameG, frameB :: Double
    frameB) <- IO (Double, Double, Double) -> Render (Double, Double, Double)
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    C.liftIO (IO (Double, Double, Double) -> Render (Double, Double, Double))
    -> IO (Double, Double, Double) -> Render (Double, Double, Double)
    forall a b. (a -> b) -> a -> b
    $ BarConfig -> IO (Double, Double, Double)
    liftedBorderColor BarConfig
    cfg
      Double -> Double -> Double -> Render ()
    C.setSourceRGB Double
    frameR Double
    frameG Double
    frameB
      Double -> Render ()
    C.setLineWidth 1.0
      Double -> Double -> Double -> Double -> Render ()
    C.rectangle (Double
    fpad Double -> Double -> Double
    forall a. Num a => a -> a -> a
    + 0.5) (Double
    fpad Double -> Double -> Double
    forall a. Num a => a -> a -> a
    + 0.5) (Double
    fwidth Double -> Double -> Double
    forall a. Num a => a -> a -> a
    - 2 Double -> Double -> Double
    forall a. Num a => a -> a -> a
    * Double
    fpad Double -> Double -> Double
    forall a. Num a => a -> a -> a
    - 1) (Double
    fheight Double -> Double -> Double
    forall a. Num a => a -> a -> a
    - 2 Double -> Double -> Double
    forall a. Num a => a -> a -> a
    * Double
    fpad Double -> Double -> Double
    forall a. Num a => a -> a -> a
    - 1)
      Render ()
    C.stroke

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

      Double -> BarConfig -> Int -> Int -> Render ()
    renderFrame_ Double
    pct BarConfig
    cfg Int
    width Int
    height

      -- After we draw the frame, transform the coordinate space so that
      -- we only draw within the frame.
      Double -> Double -> Render ()
    C.translate (Int -> Double
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    pad Double -> Double -> Double
    forall a. Num a => a -> a -> a
    + 1) (Int -> Double
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    pad Double -> Double -> Double
    forall a. Num a => a -> a -> a
    + 1)
      let xS :: Double
    xS = Int -> Double
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int
    width Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - 2 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    pad Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - 2) Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    / Int -> Double
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    width
          yS :: Double
    yS = Int -> Double
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int
    height Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - 2 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    pad Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - 2) Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    / Int -> Double
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    height
      Double -> Double -> Render ()
    C.scale Double
    xS Double
    yS

      (r :: Double
    r, g :: Double
    g, b :: Double
    b) <- IO (Double, Double, Double) -> Render (Double, Double, Double)
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    C.liftIO (IO (Double, Double, Double) -> Render (Double, Double, Double))
    -> IO (Double, Double, Double) -> Render (Double, Double, Double)
    forall a b. (a -> b) -> a -> b
    $ BarConfig -> Double -> IO (Double, Double, Double)
    liftedBarColor BarConfig
    cfg Double
    pct
      Double -> Double -> Double -> Render ()
    C.setSourceRGB Double
    r Double
    g Double
    b
      Double -> Double -> Render ()
    C.translate 0 Double
    newOrigin
      Double -> Double -> Double -> Double -> Render ()
    C.rectangle 0 0 Double
    activeWidth Double
    activeHeight
      Render ()
    C.fill

    drawBar :: MVar VerticalBarState -> DrawingArea -> C.Render ()
    drawBar :: MVar VerticalBarState -> DrawingArea -> Render ()
    drawBar mv :: MVar VerticalBarState
    mv drawArea :: DrawingArea
    drawArea = do
      (w :: Int
    w, h :: Int
    h) <- DrawingArea -> Render (Int, Int)
    forall self (m :: * -> *).
    (IsWidget self, MonadIO m) =>
    self -> m (Int, Int)
    widgetGetAllocatedSize DrawingArea
    drawArea
      VerticalBarState
    s <- IO VerticalBarState -> Render VerticalBarState
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO VerticalBarState -> Render VerticalBarState)
    -> IO VerticalBarState -> Render VerticalBarState
    forall a b. (a -> b) -> a -> b
    $ do
             VerticalBarState
    s <- MVar VerticalBarState -> IO VerticalBarState
    forall a. MVar a -> IO a
    readMVar MVar VerticalBarState
    mv
             MVar VerticalBarState
    -> (VerticalBarState -> IO VerticalBarState) -> IO ()
    forall a. MVar a -> (a -> IO a) -> IO ()
    modifyMVar_ MVar VerticalBarState
    mv (\s' :: VerticalBarState
    s' -> VerticalBarState -> IO VerticalBarState
    forall (m :: * -> *) a. Monad m => a -> m a
    return VerticalBarState
    s' { barIsBootstrapped :: Bool
    barIsBootstrapped = Bool
    True })
             VerticalBarState -> IO VerticalBarState
    forall (m :: * -> *) a. Monad m => a -> m a
    return VerticalBarState
    s
      Double -> BarConfig -> Int -> Int -> Render ()
    renderBar (VerticalBarState -> Double
    barPercent VerticalBarState
    s) (VerticalBarState -> BarConfig
    barConfig VerticalBarState
    s) Int
    w Int
    h

    verticalBarNew :: MonadIO m => BarConfig -> m (GI.Gtk.Widget, VerticalBarHandle)
    verticalBarNew :: BarConfig -> m (Widget, VerticalBarHandle)
    verticalBarNew cfg :: BarConfig
    cfg = IO (Widget, VerticalBarHandle) -> m (Widget, VerticalBarHandle)
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (Widget, VerticalBarHandle) -> m (Widget, VerticalBarHandle))
    -> IO (Widget, VerticalBarHandle) -> m (Widget, VerticalBarHandle)
    forall a b. (a -> b) -> a -> b
    $ do
      DrawingArea
    drawArea <- IO DrawingArea
    forall (m :: * -> *). (HasCallStack, MonadIO m) => m DrawingArea
    drawingAreaNew
      MVar VerticalBarState
    mv <-
        VerticalBarState -> IO (MVar VerticalBarState)
    forall a. a -> IO (MVar a)
    newMVar
          VerticalBarState :: Bool -> Double -> DrawingArea -> BarConfig -> VerticalBarState
    VerticalBarState
          { barIsBootstrapped :: Bool
    barIsBootstrapped = Bool
    False
          , barPercent :: Double
    barPercent = 0
          , barCanvas :: DrawingArea
    barCanvas = DrawingArea
    drawArea
          , barConfig :: BarConfig
    barConfig = BarConfig
    cfg
          }
      DrawingArea -> Int32 -> Int32 -> IO ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadIO m, IsWidget a) =>
    a -> Int32 -> Int32 -> m ()
    widgetSetSizeRequest DrawingArea
    drawArea (Int -> Int32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Int32) -> Int -> Int32
    forall a b. (a -> b) -> a -> b
    $ BarConfig -> Int
    barWidth BarConfig
    cfg) (-1)
      SignalHandlerId
    _ <- DrawingArea -> WidgetDrawCallback -> IO SignalHandlerId
    forall a (m :: * -> *).
    (IsWidget a, MonadIO m) =>
    a -> WidgetDrawCallback -> m SignalHandlerId
    onWidgetDraw DrawingArea
    drawArea (WidgetDrawCallback -> IO SignalHandlerId)
    -> WidgetDrawCallback -> IO SignalHandlerId
    forall a b. (a -> b) -> a -> b
    $ \ctx :: Context
    ctx -> Render () -> Context -> IO ()
    forall (m :: * -> *) a. MonadIO m => Render a -> Context -> m a
    renderWithContext (MVar VerticalBarState -> DrawingArea -> Render ()
    drawBar MVar VerticalBarState
    mv DrawingArea
    drawArea) Context
    ctx IO () -> IO Bool -> IO Bool
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Bool -> IO Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True
      Box
    box <- Orientation -> Int32 -> IO Box
    forall (m :: * -> *).
    (HasCallStack, MonadIO m) =>
    Orientation -> Int32 -> m Box
    boxNew Orientation
    OrientationHorizontal 1
      Box -> DrawingArea -> Bool -> Bool -> Word32 -> IO ()
    forall (m :: * -> *) a b.
    (HasCallStack, MonadIO m, IsBox a, IsWidget b) =>
    a -> b -> Bool -> Bool -> Word32 -> m ()
    boxPackStart Box
    box DrawingArea
    drawArea Bool
    True Bool
    True 0
      Box -> IO ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadIO m, IsWidget a) =>
    a -> m ()
    widgetShowAll Box
    box
      Widget
    giBox <- Box -> IO Widget
    forall (m :: * -> *) o. (MonadIO m, IsWidget o) => o -> m Widget
    toWidget Box
    box
      (Widget, VerticalBarHandle) -> IO (Widget, VerticalBarHandle)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Widget
    giBox, MVar VerticalBarState -> VerticalBarHandle
    VBH MVar VerticalBarState
    mv)