Some cleanup in taskbar render function
This commit is contained in:
parent
cc55ee7678
commit
fcb645e610
1 changed files with 63 additions and 57 deletions
|
@ -214,66 +214,16 @@ instance WidgetClass Taskbar where
|
||||||
|
|
||||||
forM_ (zip [0..] desktopWindows) $ \(i, window) -> do
|
forM_ (zip [0..] desktopWindows) $ \(i, window) -> do
|
||||||
let style = (if window == activeWindow then activeTaskStyle else normalTaskStyle) config
|
let style = (if window == activeWindow then activeTaskStyle else normalTaskStyle) config
|
||||||
(r, g, b, a) = taskColor style
|
h' = h - (borderV $ margin $ desktopBorder ds) - 2*(borderWidth $ desktopBorder ds) - (borderV $ padding $ desktopBorder ds)
|
||||||
leftBorder = (borderLeft $ margin $ taskBorder style) + (borderWidth $ taskBorder style) + (borderLeft $ padding $ taskBorder style)
|
|
||||||
rightBorder = (borderRight $ margin $ taskBorder style) + (borderWidth $ taskBorder style) + (borderRight $ padding $ taskBorder style)
|
|
||||||
hd = h - (borderV $ margin $ desktopBorder ds) - 2*(borderWidth $ desktopBorder ds) - (borderV $ padding $ desktopBorder ds)
|
|
||||||
h' = hd - (borderV $ margin $ taskBorder style)
|
|
||||||
mstate = M.lookup window windowStates
|
mstate = M.lookup window windowStates
|
||||||
micons = M.lookup window windowIcons
|
micons = M.lookup window windowIcons
|
||||||
mscaledIconRef = M.lookup window windowScaledIcons
|
mscaledIconRef = M.lookup window windowScaledIcons
|
||||||
x = dx + i*windowWidth
|
x = dx + i*windowWidth
|
||||||
|
y = (borderTop $ margin $ desktopBorder ds) + (borderWidth $ desktopBorder ds) + (borderTop $ padding $ desktopBorder ds)
|
||||||
|
|
||||||
case (mstate, micons, mscaledIconRef) of
|
case (mstate, micons, mscaledIconRef) of
|
||||||
(Just state, Just icons, Just scaledIconRef) -> do
|
(Just state, Just icons, Just scaledIconRef) ->
|
||||||
save
|
renderTask state icons scaledIconRef style x y windowWidth h'
|
||||||
translate 0 $ fromIntegral $ ((borderTop $ margin $ desktopBorder ds) + (borderWidth $ desktopBorder ds) + (borderTop $ padding $ desktopBorder ds))
|
|
||||||
save
|
|
||||||
drawBorder (taskBorder style) x 0 windowWidth hd
|
|
||||||
clip
|
|
||||||
|
|
||||||
setSourceRGBA r g b a
|
|
||||||
renderText (taskFont style) (fromIntegral (x + leftBorder + h' + 3)) 0 (windowWidth - leftBorder - h' - 3 - rightBorder) hd $ windowTitle state
|
|
||||||
|
|
||||||
restore
|
|
||||||
|
|
||||||
mscaledIcon <- liftIO $ readIORef scaledIconRef
|
|
||||||
scaledIcon <- case mscaledIcon of
|
|
||||||
Just (size, icon) | size == h' -> do
|
|
||||||
return $ Just icon
|
|
||||||
_ -> do
|
|
||||||
case bestIcon icons of
|
|
||||||
Just icon -> do
|
|
||||||
scaledIcon <- liftIO $ createSimilarSurface icon ContentColorAlpha h' h'
|
|
||||||
renderWith scaledIcon $ do
|
|
||||||
imageW <- imageSurfaceGetWidth icon
|
|
||||||
imageH <- imageSurfaceGetHeight icon
|
|
||||||
|
|
||||||
let scalef = (fromIntegral h')/(fromIntegral $ max imageW imageH)
|
|
||||||
|
|
||||||
case True of
|
|
||||||
_ | imageH < imageW -> translate 0 (fromIntegral (imageW-imageH)*scalef/2)
|
|
||||||
| otherwise -> translate (fromIntegral (imageH-imageW)*scalef/2) 0
|
|
||||||
|
|
||||||
downscaled scalef icon
|
|
||||||
paint
|
|
||||||
liftIO $ writeIORef scaledIconRef $ Just (h', scaledIcon)
|
|
||||||
return $ Just scaledIcon
|
|
||||||
|
|
||||||
Nothing -> return Nothing
|
|
||||||
|
|
||||||
case scaledIcon of
|
|
||||||
Just icon -> do
|
|
||||||
save
|
|
||||||
translate (fromIntegral $ x + leftBorder) (fromIntegral $ borderTop $ margin $ taskBorder style)
|
|
||||||
taskIconStyle style icon
|
|
||||||
paint
|
|
||||||
restore
|
|
||||||
|
|
||||||
Nothing ->
|
|
||||||
return ()
|
|
||||||
|
|
||||||
restore
|
|
||||||
|
|
||||||
_ -> return ()
|
_ -> return ()
|
||||||
|
|
||||||
|
@ -283,7 +233,7 @@ instance WidgetClass Taskbar where
|
||||||
|
|
||||||
|
|
||||||
handleMessage _ priv m = case (fromMessage m) of
|
handleMessage _ priv m = case (fromMessage m) of
|
||||||
Just (WindowListUpdate windows windowStates icons scaledIcons screens) -> priv {taskbarWindows = windows
|
Just (WindowListUpdate windows windowStates icons scaledIcons screens) -> priv { taskbarWindows = windows
|
||||||
, taskbarWindowStates = windowStates
|
, taskbarWindowStates = windowStates
|
||||||
, taskbarWindowIcons = icons
|
, taskbarWindowIcons = icons
|
||||||
, taskbarWindowScaledIcons = scaledIcons
|
, taskbarWindowScaledIcons = scaledIcons
|
||||||
|
@ -309,9 +259,65 @@ renderText font x y w h text = do
|
||||||
moveTo ((fromIntegral x) + ((fromIntegral w) - textWidth)/2) ((fromIntegral y) + ((fromIntegral h) - textHeight)/2)
|
moveTo ((fromIntegral x) + ((fromIntegral w) - textWidth)/2) ((fromIntegral y) + ((fromIntegral h) - textHeight)/2)
|
||||||
showLayout layout
|
showLayout layout
|
||||||
|
|
||||||
bestIcon :: [(Int, Surface)] -> Maybe Surface
|
renderTask :: WindowState -> [(Int, Surface)] -> IORef (Maybe (Int, Surface)) -> TaskStyle -> Int -> Int -> Int -> Int -> Render ()
|
||||||
bestIcon icons = fmap snd . listToMaybe $ sortBy compareIcons icons
|
renderTask state icons scaledIconRef style x y w h = do
|
||||||
|
let (r, g, b, a) = taskColor style
|
||||||
|
leftBorder = (borderLeft $ margin $ taskBorder style) + (borderWidth $ taskBorder style) + (borderLeft $ padding $ taskBorder style)
|
||||||
|
rightBorder = (borderRight $ margin $ taskBorder style) + (borderWidth $ taskBorder style) + (borderRight $ padding $ taskBorder style)
|
||||||
|
h' = h - (borderV $ margin $ taskBorder style)
|
||||||
|
|
||||||
|
save
|
||||||
|
drawBorder (taskBorder style) x y w h
|
||||||
|
clip
|
||||||
|
|
||||||
|
setSourceRGBA r g b a
|
||||||
|
renderText (taskFont style) (fromIntegral (x + leftBorder + h' + 3)) y (w - leftBorder - h' - 3 - rightBorder) h $ windowTitle state
|
||||||
|
|
||||||
|
restore
|
||||||
|
|
||||||
|
mscaledIcon <- liftIO $ readIORef scaledIconRef
|
||||||
|
scaledIcon <- case mscaledIcon of
|
||||||
|
Just (size, icon) | size == h' -> do
|
||||||
|
return $ Just icon
|
||||||
|
_ -> do
|
||||||
|
scaledIcon <- createScaledIcon icons h'
|
||||||
|
liftIO $ writeIORef scaledIconRef $ fmap ((,) h') scaledIcon
|
||||||
|
return scaledIcon
|
||||||
|
|
||||||
|
case scaledIcon of
|
||||||
|
Just icon -> do
|
||||||
|
save
|
||||||
|
translate (fromIntegral $ x + leftBorder) (fromIntegral $ y + (borderTop $ margin $ taskBorder style))
|
||||||
|
taskIconStyle style icon
|
||||||
|
paint
|
||||||
|
restore
|
||||||
|
|
||||||
|
_ -> return ()
|
||||||
|
|
||||||
|
|
||||||
|
createScaledIcon :: [(Int, Surface)] -> Int -> Render (Maybe Surface)
|
||||||
|
createScaledIcon icons h = do
|
||||||
|
case bestIcon of
|
||||||
|
Just icon -> do
|
||||||
|
scaledIcon <- liftIO $ createSimilarSurface icon ContentColorAlpha h h
|
||||||
|
renderWith scaledIcon $ do
|
||||||
|
imageW <- imageSurfaceGetWidth icon
|
||||||
|
imageH <- imageSurfaceGetHeight icon
|
||||||
|
|
||||||
|
let scalef = (fromIntegral h)/(fromIntegral $ max imageW imageH)
|
||||||
|
|
||||||
|
case True of
|
||||||
|
_ | imageH < imageW -> translate 0 (fromIntegral (imageW-imageH)*scalef/2)
|
||||||
|
| otherwise -> translate (fromIntegral (imageH-imageW)*scalef/2) 0
|
||||||
|
|
||||||
|
downscaled scalef icon
|
||||||
|
paint
|
||||||
|
return $ Just scaledIcon
|
||||||
|
|
||||||
|
_ -> return Nothing
|
||||||
|
|
||||||
where
|
where
|
||||||
|
bestIcon = fmap snd . listToMaybe $ sortBy compareIcons icons
|
||||||
compareIcons = flip (compare `on` fst)
|
compareIcons = flip (compare `on` fst)
|
||||||
|
|
||||||
|
|
||||||
|
|
Reference in a new issue