summaryrefslogtreecommitdiffstats
path: root/lib/Phi/Widgets
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Phi/Widgets')
-rw-r--r--lib/Phi/Widgets/AlphaBox.hs13
-rw-r--r--lib/Phi/Widgets/Clock.hs56
-rw-r--r--lib/Phi/Widgets/Systray.hs8
-rw-r--r--lib/Phi/Widgets/Taskbar.hs5
4 files changed, 43 insertions, 39 deletions
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
generated by cgit v1.2.3 (git 2.25.1) at 2024-05-19 16:58:04 +0200