Make render function return cachable surface slices
This commit is contained in:
parent
ddca7c3ec5
commit
42c14fa1ca
8 changed files with 234 additions and 161 deletions
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
||||
case (mstate, micons, mscaledIconRef) of
|
||||
(Just state, Just icons, Just scaledIconRef) ->
|
||||
renderTask state icons scaledIconRef style x y windowWidth h'
|
||||
|
||||
_ -> return ()
|
||||
|
||||
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
|
||||
|
||||
_ -> return ()
|
||||
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)
|
||||
|
||||
case (mstate, micons, mscaledIconRef) of
|
||||
(Just state, Just icons, Just scaledIconRef) ->
|
||||
renderTask state icons scaledIconRef style x y windowWidth h'
|
||||
|
||||
_ -> return ()
|
||||
|
||||
_ -> return ()
|
||||
|
||||
return $ nwindows + length desktopWindows
|
||||
return $ nwindows + length desktopWindows
|
||||
|
||||
return [(True, SurfaceSlice 0 surface)]
|
||||
|
||||
|
||||
handleMessage _ priv m = case (fromMessage m) of
|
||||
|
|
|
|||
Reference in a new issue