ProgressBar.hs

-- |This module provides a ''progress bar'' widget which stores a
-- progress value between 0 and 100 inclusive and supports a text
-- label.  Use the 'schedule' function to modify the progress bar's
-- state from a thread.
module Graphics.Vty.Widgets.ProgressBar
    ( ProgressBar
    , newProgressBar
    , setProgress
    , setProgressTextAlignment
    , setProgressText
    , addProgress
    , getProgress
    , onProgressChange
    )
where

import Control.Monad
import Graphics.Vty
import Graphics.Vty.Widgets.Core
import Graphics.Vty.Widgets.Events
import Graphics.Vty.Widgets.Text
import Graphics.Vty.Widgets.Alignment

data ProgressBar = ProgressBar { progressBarAmount :: Int
                               , onChangeHandlers :: Handlers Int
                               , progressBarText :: String
                               , progressBarTextAlignment :: Alignment
                               }

instance Show ProgressBar where
    show p = concat [ "ProgressBar { "
                    , ", " ++ (show $ progressBarAmount p)
                    , ", ... }"
                    ]

-- |Create a new progress bar with the specified completed and
-- uncompleted attributes, respectively.  The foreground of the
-- attributes will be used to show the progress bar's label, if any.
newProgressBar :: Attr -> Attr -> IO (Widget ProgressBar)
newProgressBar completeAttr incompleteAttr = do
  chs <- newHandlers
  t <- plainText ""
  let initSt = ProgressBar 0 chs "" AlignCenter
  wRef <- newWidget initSt $ \w ->
          w { growHorizontal_ = const $ return True
            , render_ =
                \this size ctx -> do
                  -- Divide the available width according to the
                  -- progress value
                  prog <- progressBarAmount <~~ this
                  txt <- progressBarText <~~ this
                  al <- progressBarTextAlignment <~~ this

                  let complete_width = fromEnum $ (toRational prog / toRational (100.0 :: Double)) *
                                       (toRational $ fromEnum $ region_width size)

                      full_width = fromEnum $ region_width size
                      full_str = take full_width $ mkStr txt al

                      mkStr s AlignLeft = s ++ replicate (full_width - length txt) ' '
                      mkStr s AlignRight = replicate (full_width - length txt) ' ' ++ s
                      mkStr s AlignCenter = concat [ half
                                                   , s
                                                   , half
                                                   , if length half * 2 < (full_width + length txt)
                                                     then " "
                                                     else ""
                                                   ]
                          where
                            half = replicate ((full_width - length txt) `div` 2) ' '

                      (complete_str, incomplete_str) = ( take complete_width full_str
                                                       , drop complete_width full_str
                                                       )

                  setTextWithAttrs t [ (complete_str, completeAttr)
                                     , (incomplete_str, incompleteAttr)
                                     ]
                  render t size ctx
            }

  setProgress wRef 0
  return wRef

-- |Register a handler to be invoked when the progress bar's progress
-- value changes.  The handler will be passed the new progress value.
onProgressChange :: Widget ProgressBar -> (Int -> IO ()) -> IO ()
onProgressChange = addHandler (onChangeHandlers <~~)

-- |Set the progress bar's progress value.  Values outside the allowed
-- range will be ignored.
setProgress :: Widget ProgressBar -> Int -> IO ()
setProgress p amt =
    when (amt >= 0 && amt <= 100) $ do
      updateWidgetState p $ \st -> st { progressBarAmount = amt }
      fireEvent p (onChangeHandlers <~~) amt

-- |Set the progress bar's text label alignment.
setProgressTextAlignment :: Widget ProgressBar -> Alignment -> IO ()
setProgressTextAlignment p al =
    updateWidgetState p $ \st -> st { progressBarTextAlignment = al }

-- |Set the progress bar's text label.
setProgressText :: Widget ProgressBar -> String -> IO ()
setProgressText p s =
    updateWidgetState p $ \st -> st { progressBarText = s }

-- |Get the progress bar's current progress value.
getProgress :: Widget ProgressBar -> IO Int
getProgress = (progressBarAmount <~~)

-- |Add a delta value to the progress bar's current value.
addProgress :: Widget ProgressBar -> Int -> IO ()
addProgress p amt = do
  cur <- getProgress p
  let newAmt = cur + amt
  when (newAmt >= 0 && newAmt <= 100) $
       setProgress p newAmt