From 42c14fa1ca9d47ae32766aaa2aa995c684b7e9cb Mon Sep 17 00:00:00 2001
From: Matthias Schiffer <mschiffer@universe-factory.net>
Date: Sun, 21 Aug 2011 19:34:16 +0200
Subject: Make render function return cachable surface slices

---
 lib/Phi/Widgets/Clock.hs | 49 +++++++++++++++++++++++++++---------------------
 1 file changed, 28 insertions(+), 21 deletions(-)

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

diff --git a/lib/Phi/Widgets/Clock.hs b/lib/Phi/Widgets/Clock.hs
index bee8d39..12906c0 100644
--- a/lib/Phi/Widgets/Clock.hs
+++ b/lib/Phi/Widgets/Clock.hs
@@ -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 () where
   initWidget (Clock _) phi _ = do
     forkIO $ forever $ do
       time <- getZonedTime
@@ -59,26 +59,33 @@ instance Widget Clock ClockState where
   minSize (Clock config) _ _ _ = clockSize config
   
   render (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
+    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)]
   
   handleMessage _ priv m = case (fromMessage m) of
     Just (UpdateTime time) -> ClockState time
-- 
cgit v1.2.3