From 8222c6041d2e2ed5258aa0f9188d2011a17285c9 Mon Sep 17 00:00:00 2001 From: Matthias Schiffer Date: Sun, 21 Aug 2011 21:39:26 +0200 Subject: Add a lot of caching framework --- lib/Phi/Widgets/AlphaBox.hs | 13 ++++++++--- lib/Phi/Widgets/Clock.hs | 56 ++++++++++++++++++++------------------------- lib/Phi/Widgets/Systray.hs | 8 ++++--- lib/Phi/Widgets/Taskbar.hs | 5 ++-- 4 files changed, 43 insertions(+), 39 deletions(-) (limited to 'lib/Phi/Widgets') diff --git a/lib/Phi/Widgets/AlphaBox.hs b/lib/Phi/Widgets/AlphaBox.hs index cd540e3..508f9d4 100644 --- a/lib/Phi/Widgets/AlphaBox.hs +++ b/lib/Phi/Widgets/AlphaBox.hs @@ -8,6 +8,7 @@ import Phi.Types import Phi.Widget import Control.Monad +import Control.Monad.State.Strict import Graphics.Rendering.Cairo @@ -16,8 +17,11 @@ data AlphaBox w s c = (Widget w s c) => AlphaBox !Double !w deriving instance Show (AlphaBox w s c) deriving instance Eq (AlphaBox w s c) -instance Eq s => Widget (AlphaBox w s c) s () where +data AlphaBoxCache w s c = (Widget w s c) => AlphaBoxCache !c + +instance Eq s => Widget (AlphaBox w s c) s (AlphaBoxCache w s c) where initWidget (AlphaBox _ w) = initWidget w + initCache (AlphaBox _ w) = AlphaBoxCache $ initCache w minSize (AlphaBox _ w) = minSize w @@ -26,10 +30,13 @@ instance Eq s => Widget (AlphaBox w s c) s () where layout (AlphaBox _ w) = layout w render (AlphaBox alpha w) s x y width height screen = do - surfaces <- render w s x y width height screen + AlphaBoxCache c <- get + (surfaces, c') <- liftIO $ flip runStateT c $ render w s x y width height screen + put $ AlphaBoxCache c' + let surfacesWidths = zipWith (\(updated, SurfaceSlice x surf) x' -> (updated, x, x'-x, surf)) surfaces (map (\(_, SurfaceSlice x _) -> x) (tail surfaces) ++ [width]) forM surfacesWidths $ \(updated, x, surfWidth, surf) -> do - surf' <- createImageSurface FormatARGB32 surfWidth height + surf' <- liftIO $ createImageSurface FormatARGB32 surfWidth height renderWith surf' $ do setOperator OperatorSource withPatternForSurface surf setSource 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 diff --git a/lib/Phi/Widgets/Systray.hs b/lib/Phi/Widgets/Systray.hs index 662c6a7..7e7ec63 100644 --- a/lib/Phi/Widgets/Systray.hs +++ b/lib/Phi/Widgets/Systray.hs @@ -55,6 +55,8 @@ instance Widget Systray SystrayState () where lastReset <- newIORef 0 return $ SystrayState phi (head . getScreens $ dispvar) 0 lastReset [] + initCache _ = () + minSize _ (SystrayState _ systrayScreen _ _ icons) height screen = case True of _ | screen == systrayScreen -> max 0 $ (length icons)*(height+2)-1 | otherwise -> 0 @@ -63,13 +65,13 @@ instance Widget Systray SystrayState () where render Systray (SystrayState phi systrayScreen reset lastResetRef icons) x y w h screen = do when (screen == systrayScreen) $ do - lastReset <- readIORef lastResetRef - writeIORef lastResetRef reset + lastReset <- liftIO $ readIORef lastResetRef + liftIO $ writeIORef lastResetRef reset forM_ (zip [0..] icons) $ \(i, SystrayIconState midParent window) -> do let x' = x + i*(h+2) sendMessage phi $ RenderIcon midParent window x' y h h (lastReset /= reset) - surface <- createImageSurface FormatARGB32 w h + surface <- liftIO $ createImageSurface FormatARGB32 w h renderWith surface $ do setOperator OperatorClear paint diff --git a/lib/Phi/Widgets/Taskbar.hs b/lib/Phi/Widgets/Taskbar.hs index fbf7da8..4c4b9c2 100644 --- a/lib/Phi/Widgets/Taskbar.hs +++ b/lib/Phi/Widgets/Taskbar.hs @@ -172,7 +172,8 @@ instance Widget Taskbar TaskbarState () where forkIO $ taskbarRunner phi' dispvar return $ TaskbarState 0 0 (-1) [] M.empty M.empty M.empty M.empty - + + initCache _ = () minSize _ _ _ _ = 0 weight _ = 1 @@ -205,7 +206,7 @@ instance Widget Taskbar TaskbarState () where desktopsWidth = sum $ map dwidth desktopNumbers windowWidth = if windowCount == 0 then 0 else min (taskMaxSize config) ((w - desktopsWidth) `div` windowCount) - surface <- createImageSurface FormatARGB32 w h + surface <- liftIO $ createImageSurface FormatARGB32 w h renderWith surface $ do setOperator OperatorClear paint -- cgit v1.2.3