From 8222c6041d2e2ed5258aa0f9188d2011a17285c9 Mon Sep 17 00:00:00 2001
From: Matthias Schiffer <mschiffer@universe-factory.net>
Date: Sun, 21 Aug 2011 21:39:26 +0200
Subject: Add a lot of caching framework

---
 lib/Phi/Widgets/Clock.hs | 56 +++++++++++++++++++++---------------------------
 1 file changed, 25 insertions(+), 31 deletions(-)

(limited to 'lib/Phi/Widgets/Clock.hs')

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
-- 
cgit v1.2.3