module Graphics.Vty.Widgets.ProgressBar
( ProgressBar
, newProgressBar
, setProgress
, setProgressTextAlignment
, setProgressText
, addProgress
, getProgress
, onProgressChange
)
where
import Control.Monad
import qualified Data.Text as T
import Graphics.Vty
import Graphics.Vty.Widgets.Core
import Graphics.Vty.Widgets.Events
import Graphics.Vty.Widgets.Text
import Graphics.Vty.Widgets.Alignment
import Graphics.Vty.Widgets.Util
import Graphics.Vty.Widgets.TextClip
import Text.Trans.Tokenize
data ProgressBar = ProgressBar { progressBarAmount :: Int
, onChangeHandlers :: Handlers Int
, progressBarText :: T.Text
, progressBarTextAlignment :: Alignment
, progCompleteAttr :: Attr
, progIncompleteAttr :: Attr
, progTextWidget :: Widget FormattedText
}
instance Show ProgressBar where
show p = concat [ "ProgressBar { "
, ", " ++ (show $ progressBarAmount p)
, ", ... }"
]
newProgressBar :: Attr -> Attr -> IO (Widget ProgressBar)
newProgressBar completeAttr incompleteAttr = do
chs <- newHandlers
t <- plainText T.empty
let initSt = ProgressBar 0 chs T.empty AlignCenter completeAttr incompleteAttr t
wRef <- newWidget initSt $ \w ->
w { growHorizontal_ = const $ return True
, render_ =
\this size ctx -> renderProgressBar size ctx =<< getState this
, getCursorPosition_ = const $ return Nothing
}
setProgress wRef 0
return wRef
renderProgressBar :: DisplayRegion -> RenderContext -> ProgressBar -> IO Image
renderProgressBar size ctx st = do
let prog = progressBarAmount st
txt = progressBarText st
al = progressBarTextAlignment st
complete_width =
Phys $ fromEnum $ (toRational prog / toRational (100.0 :: Double)) *
(toRational $ fromEnum $ regionWidth size)
full_width = Phys $ fromEnum $ regionWidth size
full_str = truncateText full_width $ mkStr txt al
mkStr s AlignLeft =
let diff = fromEnum $ full_width textWidth txt
in T.concat [ s
, T.pack $ replicate diff ' '
]
mkStr s AlignRight =
let diff = fromEnum $ full_width textWidth txt
in T.concat [ T.pack $ replicate diff ' '
, s
]
mkStr s AlignCenter =
T.concat [ half
, s
, half
, trailingSpc
]
where
diff = fromEnum $ full_width textWidth txt
half = T.pack $ replicate (diff `div` 2) ' '
used_width = textWidth half * 2 + textWidth txt
trailingSpc =
if used_width < full_width
then T.singleton ' '
else T.empty
(leftPart, _, _) = clip1d 0 complete_width full_str
charCount = T.length leftPart
(complete_str, incomplete_str) = ( T.take charCount full_str
, T.drop charCount full_str
)
setTextWithAttrs (progTextWidget st)
[ (complete_str, progCompleteAttr st)
, (incomplete_str, progIncompleteAttr st)
]
render (progTextWidget st) size ctx
onProgressChange :: Widget ProgressBar -> (Int -> IO ()) -> IO ()
onProgressChange = addHandler (onChangeHandlers <~~)
setProgress :: Widget ProgressBar -> Int -> IO ()
setProgress p amt =
when (amt >= 0 && amt <= 100) $ do
updateWidgetState p $ \st -> st { progressBarAmount = amt }
fireEvent p (onChangeHandlers <~~) amt
setProgressTextAlignment :: Widget ProgressBar -> Alignment -> IO ()
setProgressTextAlignment p al =
updateWidgetState p $ \st -> st { progressBarTextAlignment = al }
setProgressText :: Widget ProgressBar -> T.Text -> IO ()
setProgressText p s =
updateWidgetState p $ \st -> st { progressBarText = s }
getProgress :: Widget ProgressBar -> IO Int
getProgress = (progressBarAmount <~~)
addProgress :: Widget ProgressBar -> Int -> IO ()
addProgress p amt = do
cur <- getProgress p
let newAmt = cur + amt
when (newAmt >= 0 && newAmt <= 100) $
setProgress p newAmt