module Manatee.Toolkit.Widget.Outputbar where
import Control.Concurrent.STM
import Graphics.UI.Gtk
import Manatee.Toolkit.General.Functor
import Manatee.Toolkit.General.Maybe
import Manatee.Toolkit.General.STM
import Manatee.Toolkit.Gtk.Box
data Outputbar =
Outputbar {outputbarFrame :: Frame
,outputbarLabel :: Label
,outputbarHandlerId :: TVar (Maybe HandlerId)
}
outputbarBackgroundColor :: Color
outputbarBackgroundColor = Color 62720 62720 46336
outputbarNew :: IO Outputbar
outputbarNew = do
frame <- frameNew
set frame [frameShadowType := ShadowNone]
box <- hBoxNew False 0
label <- labelNew $ Just ""
id <- newTVarIO Nothing
frame `containerAdd` box
boxPackStart box label PackNatural 0
return $ Outputbar frame label id
outputbarShow :: BoxClass box => box -> Outputbar -> String -> IO ()
outputbarShow box bar str = do
let frame = outputbarFrame bar
label = outputbarLabel bar
handlerId = outputbarHandlerId bar
id <- readTVarIO handlerId
id ?>= timeoutRemove
labelSetText label str
width <- labelGetMaxWidthChars label
set label [labelAttributes := [AttrBackground 0 width outputbarBackgroundColor]]
childNumber <- (<<<=) length containerGetChildren box
boxTryPack box frame PackNatural (Just $ pred childNumber) Nothing
widgetShowAll frame
newId <- timeoutAdd (box `containerRemove` frame >> return False) 10000
modifyTVarIO handlerId (const $ Just newId)