summaryrefslogtreecommitdiffstats
path: root/lib/Phi/Widgets/Clock.hs
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Phi/Widgets/Clock.hs')
-rw-r--r--lib/Phi/Widgets/Clock.hs56
1 files changed, 25 insertions, 31 deletions
diff --git a/lib/Phi/Widgets/Clock.hs b/lib/Phi/Widgets/Clock.hs
index 12906c0..38b6c41 100644
--- a/lib/Phi/Widgets/Clock.hs
+++ b/lib/Phi/Widgets/Clock.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE MultiParamTypeClasses, DeriveDataTypeable #-}
+{-# LANGUAGE MultiParamTypeClasses, DeriveDataTypeable, TypeSynonymInstances, FlexibleInstances #-}
module Phi.Widgets.Clock ( ClockConfig(..)
, defaultClockConfig
@@ -43,7 +43,7 @@ data ClockState = ClockState !ZonedTime deriving (Show, Eq)
data ClockMessage = UpdateTime !ZonedTime deriving (Show, Typeable)
-instance Widget Clock ClockState () where
+instance Widget Clock ClockState (RenderCache Clock ClockState) where
initWidget (Clock _) phi _ = do
forkIO $ forever $ do
time <- getZonedTime
@@ -54,38 +54,32 @@ instance Widget Clock ClockState () where
time <- getZonedTime
return $ ClockState time
-
+
+ initCache _ = createRenderCache $ \(Clock config) (ClockState time) _ _ w h _ -> do
+ let (r, g, b, a) = fontColor config
+ str = formatTime defaultTimeLocale (clockFormat config) time
+ setSourceRGBA r g b a
+
+ layout <- createLayout ""
+ (_, PangoRectangle _ _ textWidth textHeight) <- liftIO $ do
+ layoutSetMarkup layout str
+ layoutSetAlignment layout AlignCenter
+ layoutSetSpacing layout $ lineSpacing config
+ layoutGetExtents layout
+
+ let scalef = min 1 ((fromIntegral w)/textWidth)
+ when (scalef < 1) $ do
+ scale scalef scalef
+ updateLayout layout
+
+ (_, PangoRectangle _ _ textWidth' textHeight') <- liftIO $ layoutGetExtents layout
+
+ moveTo (((fromIntegral w)/scalef - textWidth')/2) (((fromIntegral h)/scalef - textHeight')/2)
+ showLayout layout
minSize (Clock config) _ _ _ = clockSize config
- render (Clock config) (ClockState time) _ _ w h _ = do
- surface <- createImageSurface FormatARGB32 w h
- renderWith surface $ do
- setOperator OperatorClear
- paint
-
- setOperator OperatorOver
- let (r, g, b, a) = fontColor config
- str = formatTime defaultTimeLocale (clockFormat config) time
- setSourceRGBA r g b a
-
- layout <- createLayout ""
- (_, PangoRectangle _ _ textWidth textHeight) <- liftIO $ do
- layoutSetMarkup layout str
- layoutSetAlignment layout AlignCenter
- layoutSetSpacing layout $ lineSpacing config
- layoutGetExtents layout
-
- let scalef = min 1 ((fromIntegral w)/textWidth)
- when (scalef < 1) $ do
- scale scalef scalef
- updateLayout layout
-
- (_, PangoRectangle _ _ textWidth' textHeight') <- liftIO $ layoutGetExtents layout
-
- moveTo (((fromIntegral w)/scalef - textWidth')/2) (((fromIntegral h)/scalef - textHeight')/2)
- showLayout layout
- return [(True, SurfaceSlice 0 surface)]
+ render = renderCached
handleMessage _ priv m = case (fromMessage m) of
Just (UpdateTime time) -> ClockState time