summaryrefslogtreecommitdiffstats
path: root/lib/Phi/Widgets
diff options
context:
space:
mode:
authorMatthias Schiffer <mschiffer@universe-factory.net>2011-08-21 19:34:16 +0200
committerMatthias Schiffer <mschiffer@universe-factory.net>2011-08-21 19:34:16 +0200
commit42c14fa1ca9d47ae32766aaa2aa995c684b7e9cb (patch)
tree7c12e75cf89573c2d3ecb8c0c4fcc4ccbc56b24d /lib/Phi/Widgets
parentddca7c3ec59a5b7c62a11afe225de40edbde85ff (diff)
downloadphi-42c14fa1ca9d47ae32766aaa2aa995c684b7e9cb.tar
phi-42c14fa1ca9d47ae32766aaa2aa995c684b7e9cb.zip
Make render function return cachable surface slices
Diffstat (limited to 'lib/Phi/Widgets')
-rw-r--r--lib/Phi/Widgets/AlphaBox.hs26
-rw-r--r--lib/Phi/Widgets/Clock.hs49
-rw-r--r--lib/Phi/Widgets/Systray.hs19
-rw-r--r--lib/Phi/Widgets/Taskbar.hs75
4 files changed, 97 insertions, 72 deletions
diff --git a/lib/Phi/Widgets/AlphaBox.hs b/lib/Phi/Widgets/AlphaBox.hs
index eacda5a..cd540e3 100644
--- a/lib/Phi/Widgets/AlphaBox.hs
+++ b/lib/Phi/Widgets/AlphaBox.hs
@@ -12,11 +12,11 @@ import Control.Monad
import Graphics.Rendering.Cairo
-data AlphaBox w d = (Widget w d) => AlphaBox !Double !w
-deriving instance Show (AlphaBox w d)
-deriving instance Eq (AlphaBox w d)
+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 d => Widget (AlphaBox w d) d where
+instance Eq s => Widget (AlphaBox w s c) s () where
initWidget (AlphaBox _ w) = initWidget w
minSize (AlphaBox _ w) = minSize w
@@ -25,21 +25,25 @@ instance Eq d => Widget (AlphaBox w d) d where
layout (AlphaBox _ w) = layout w
- render (AlphaBox alpha w) d x y width height screen = do
- renderWithSimilarSurface ContentColorAlpha width height $ \surface -> do
- renderWith surface $ do
- render w d x y width height screen
+ render (AlphaBox alpha w) s x y width height screen = do
+ surfaces <- render w s x y width height screen
+ 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
+ renderWith surf' $ do
+ setOperator OperatorSource
+ withPatternForSurface surf setSource
+ paint
setOperator OperatorDestIn
setSourceRGBA 0 0 0 alpha
paint
- withPatternForSurface surface setSource
- paint
+ return (updated, SurfaceSlice x surf')
handleMessage (AlphaBox _ w) = handleMessage w
-alphaBox :: (Widget w d) => Double -> w -> AlphaBox w d
+alphaBox :: (Widget w s c) => Double -> w -> AlphaBox w s c
alphaBox = AlphaBox
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
diff --git a/lib/Phi/Widgets/Systray.hs b/lib/Phi/Widgets/Systray.hs
index 6812018..662c6a7 100644
--- a/lib/Phi/Widgets/Systray.hs
+++ b/lib/Phi/Widgets/Systray.hs
@@ -47,7 +47,7 @@ data SystrayMessage = AddIcon !Window !Window | RemoveIcon !Window | RenderIcon
deriving (Show, Typeable)
-instance Widget Systray SystrayState where
+instance Widget Systray SystrayState () where
initWidget (Systray) phi dispvar = do
phi' <- dupPhi phi
forkIO $ systrayRunner phi' dispvar
@@ -61,15 +61,20 @@ instance Widget Systray SystrayState where
weight _ = 0
- render Systray (SystrayState phi systrayScreen reset lastResetRef icons) x y w h screen = case True of
- _ | screen == systrayScreen -> do
- lastReset <- liftIO $ readIORef lastResetRef
- liftIO $ writeIORef lastResetRef reset
+ render Systray (SystrayState phi systrayScreen reset lastResetRef icons) x y w h screen = do
+ when (screen == systrayScreen) $ do
+ lastReset <- readIORef lastResetRef
+ 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)
-
- | otherwise -> return ()
+
+ surface <- createImageSurface FormatARGB32 w h
+ renderWith surface $ do
+ setOperator OperatorClear
+ paint
+ return [(True, SurfaceSlice 0 surface)]
+
handleMessage _ priv@(SystrayState phi screen reset lastReset icons) m = case (fromMessage m) of
Just (AddIcon midParent window) -> SystrayState phi screen reset lastReset ((SystrayIconState midParent window):icons)
diff --git a/lib/Phi/Widgets/Taskbar.hs b/lib/Phi/Widgets/Taskbar.hs
index c17ac36..fbf7da8 100644
--- a/lib/Phi/Widgets/Taskbar.hs
+++ b/lib/Phi/Widgets/Taskbar.hs
@@ -166,7 +166,7 @@ data TaskbarMessage = WindowListUpdate ![Xlib.Window] !(M.Map Window WindowState
instance Show (IORef a) where
show _ = "IORef <?>"
-instance Widget Taskbar TaskbarState where
+instance Widget Taskbar TaskbarState () where
initWidget (Taskbar _) phi dispvar = do
phi' <- dupPhi phi
forkIO $ taskbarRunner phi' dispvar
@@ -204,41 +204,50 @@ instance Widget Taskbar TaskbarState where
desktopsWidth = sum $ map dwidth desktopNumbers
windowWidth = if windowCount == 0 then 0 else min (taskMaxSize config) ((w - desktopsWidth) `div` windowCount)
-
- flip (flip foldM_ 0) desktops $ \nwindows (desktop, desktopWindows) -> do
- let dstyle' = dstyle desktop
- dx = dleftwidth desktop + (sum $ map dwidth $ take desktop [0..]) + nwindows*windowWidth
-
- case dstyle' of
- Just ds -> do
- let (r, g, b, a) = desktopColor ds
- save
- drawBorder (desktopBorder ds) (dx - dleftwidth desktop) 0 (dwidth desktop + windowWidth * length desktopWindows) h
- clip
-
- setSourceRGBA r g b a
- renderText (desktopFont ds) (fromIntegral (dx - dlabelwidth desktop - gap desktop ds)) 0 (dlabelwidth desktop) h $ show (desktop+1)
-
- restore
-
- forM_ (zip [0..] desktopWindows) $ \(i, window) -> do
- let style = (if window == activeWindow then activeTaskStyle else normalTaskStyle) config
- h' = h - (borderV $ margin $ desktopBorder ds) - 2*(borderWidth $ desktopBorder ds) - (borderV $ padding $ desktopBorder ds)
- mstate = M.lookup window windowStates
- micons = M.lookup window windowIcons
- mscaledIconRef = M.lookup window windowScaledIcons
- x = dx + i*windowWidth
- y = (borderTop $ margin $ desktopBorder ds) + (borderWidth $ desktopBorder ds) + (borderTop $ padding $ desktopBorder ds)
+
+ surface <- createImageSurface FormatARGB32 w h
+ renderWith surface $ do
+ setOperator OperatorClear
+ paint
+
+ setOperator OperatorOver
+
+ flip (flip foldM_ 0) desktops $ \nwindows (desktop, desktopWindows) -> do
+ let dstyle' = dstyle desktop
+ dx = dleftwidth desktop + (sum $ map dwidth $ take desktop [0..]) + nwindows*windowWidth
+
+ case dstyle' of
+ Just ds -> do
+ let (r, g, b, a) = desktopColor ds
+ save
+ drawBorder (desktopBorder ds) (dx - dleftwidth desktop) 0 (dwidth desktop + windowWidth * length desktopWindows) h
+ clip
- case (mstate, micons, mscaledIconRef) of
- (Just state, Just icons, Just scaledIconRef) ->
- renderTask state icons scaledIconRef style x y windowWidth h'
-
- _ -> return ()
+ setSourceRGBA r g b a
+ renderText (desktopFont ds) (fromIntegral (dx - dlabelwidth desktop - gap desktop ds)) 0 (dlabelwidth desktop) h $ show (desktop+1)
+
+ restore
+
+ forM_ (zip [0..] desktopWindows) $ \(i, window) -> do
+ let style = (if window == activeWindow then activeTaskStyle else normalTaskStyle) config
+ h' = h - (borderV $ margin $ desktopBorder ds) - 2*(borderWidth $ desktopBorder ds) - (borderV $ padding $ desktopBorder ds)
+ mstate = M.lookup window windowStates
+ micons = M.lookup window windowIcons
+ mscaledIconRef = M.lookup window windowScaledIcons
+ x = dx + i*windowWidth
+ y = (borderTop $ margin $ desktopBorder ds) + (borderWidth $ desktopBorder ds) + (borderTop $ padding $ desktopBorder ds)
+
+ case (mstate, micons, mscaledIconRef) of
+ (Just state, Just icons, Just scaledIconRef) ->
+ renderTask state icons scaledIconRef style x y windowWidth h'
+
+ _ -> return ()
- _ -> return ()
+ _ -> return ()
- return $ nwindows + length desktopWindows
+ return $ nwindows + length desktopWindows
+
+ return [(True, SurfaceSlice 0 surface)]
handleMessage _ priv m = case (fromMessage m) of