module Manatee.Toolkit.Widget.Statusbar where
import Control.Applicative
import Control.Concurrent.STM
import Control.Monad
import Data.Sequence (Seq)
import Graphics.UI.Gtk hiding (Statusbar, statusbarNew)
import Manatee.Toolkit.General.Functor
import Manatee.Toolkit.General.List
import Manatee.Toolkit.General.STM
import Manatee.Toolkit.General.Seq
import Manatee.Toolkit.Gtk.Box
import Manatee.Toolkit.Gtk.Container
import qualified Data.Foldable as F
import qualified Data.Sequence as Seq
import qualified Graphics.UI.Gtk.Display.Statusbar as S
type StatusbarSubitem = S.Statusbar
type StatusbarInfoTable = Seq (String, String)
data Statusbar =
Statusbar {statusbarBox :: HBox
,statusbarInfoSubitem :: StatusbarSubitem
,statusbarInfoTable :: TVar StatusbarInfoTable
,statusbarProgressBar :: ProgressBar}
statusbarNew :: BoxClass b => b -> IO Statusbar
statusbarNew b = do
statusBox <- hBoxNew False 0
boxPackStart (toBox b) statusBox PackNatural 0
Statusbar <$> pure statusBox
<*> statusbarSubitemNew statusBox
<*> newTVarIO Seq.empty
<*> progressBarNew
statusbarClone :: BoxClass b => b -> Statusbar -> IO Statusbar
statusbarClone box oldStatusbar = do
newStatusbar <- statusbarNew box
replaceTVarField newStatusbar oldStatusbar statusbarInfoTable
statusbarInfoSubitemUpdate newStatusbar
return newStatusbar
statusbarGetInfoTable :: Statusbar -> IO StatusbarInfoTable
statusbarGetInfoTable = readTVarIO . statusbarInfoTable
statusbarSubitemNew :: BoxClass b => b -> IO StatusbarSubitem
statusbarSubitemNew b = do
bar <- S.statusbarNew
statusbarSetHasResizeGrip bar False
boxPackStart (toBox b) bar PackGrow 0
return bar
statusbarInfoSubitemSetText :: Statusbar -> String -> IO ()
statusbarInfoSubitemSetText =
statusbarSubitemSetText . statusbarInfoSubitem
statusbarSubitemSetText :: StatusbarSubitem -> String -> IO ()
statusbarSubitemSetText ss str = do
id <- statusbarGetContextId ss str
statusbarPush ss id str
return ()
statusbarInfoItemAdd :: Statusbar -> String -> String -> IO ()
statusbarInfoItemAdd = statusbarInfoItemUpdate
statusbarInfoItemUpdate :: Statusbar -> String -> String -> IO ()
statusbarInfoItemUpdate statusbar item info =
statusbarApplyInfoTable statusbar (replaceOrAdd (\x -> fst x == item) (item, info))
statusbarInfoItemRemove :: Statusbar -> String -> IO ()
statusbarInfoItemRemove statusbar item =
statusbarApplyInfoTable statusbar (deleteMatch (\y -> fst y == item))
statusbarApplyInfoTable :: Statusbar -> (StatusbarInfoTable -> StatusbarInfoTable) -> IO ()
statusbarApplyInfoTable statusbar f = do
modifyTVarIO (statusbarInfoTable statusbar) f
statusbarInfoSubitemUpdate statusbar
statusbarInfoSubitemUpdate :: Statusbar -> IO ()
statusbarInfoSubitemUpdate statusbar = do
infoList <- (<<<=) F.toList (readTVarIO . statusbarInfoTable) statusbar
unlessNull infoList (statusbarInfoSubitemSetText statusbar (concatMap (\x -> snd x ++ " ") infoList))
statusbarProgressUpdate :: Statusbar -> Double -> IO ()
statusbarProgressUpdate (Statusbar {statusbarBox = box
,statusbarProgressBar = progressBar})
progress = do
boxTryPack box progressBar PackNatural Nothing Nothing
widgetShowAll progressBar
set progressBar [progressBarFraction := progress / 100]
progressBarSetText progressBar (show progress ++ "%")
when (progress == 100.0) $
timeoutAdd (do
set progressBar [progressBarFraction := 0]
containerTryRemove box progressBar
return False) 100
>> return ()