module System.Taffybar.SimpleClock ( textClockNew ) where
import Control.Monad.Trans ( MonadIO, liftIO )
import Data.Time.Format
import Data.Time.LocalTime
import Graphics.UI.Gtk
import System.Locale
import System.Taffybar.Widgets.PollingLabel
getCurrentTime :: TimeLocale -> String -> IO String
getCurrentTime timeLocale fmt = do
zt <- getZonedTime
return $ formatTime timeLocale fmt zt
makeCalendar :: IO Window
makeCalendar = do
container <- windowNew
cal <- calendarNew
containerAdd container cal
return container
toggleCalendar w c = liftIO $ do
isVis <- get c widgetVisible
case isVis of
True -> widgetHideAll c
False -> do
windowSetKeepAbove c True
windowStick c
windowSetTypeHint c WindowTypeHintTooltip
windowSetSkipTaskbarHint c True
windowSetSkipPagerHint c True
Just topLevel <- widgetGetAncestor w gTypeWindow
let topLevelWindow = castToWindow topLevel
windowSetTransientFor c topLevelWindow
widgetShowAll c
return True
textClockNew :: Maybe TimeLocale
-> String
-> Double
-> IO Widget
textClockNew userLocale fmt updateSeconds = do
let timeLocale = maybe defaultTimeLocale id userLocale
l <- pollingLabelNew "" updateSeconds (getCurrentTime timeLocale fmt)
ebox <- eventBoxNew
containerAdd ebox l
eventBoxSetVisibleWindow ebox False
cal <- makeCalendar
_ <- on ebox buttonPressEvent (toggleCalendar l cal)
widgetShowAll ebox
return (toWidget ebox)