diff options
Diffstat (limited to 'lib/Phi')
| -rw-r--r-- | lib/Phi/Widgets/Taskbar.hs | 120 |
1 files changed, 63 insertions, 57 deletions
diff --git a/lib/Phi/Widgets/Taskbar.hs b/lib/Phi/Widgets/Taskbar.hs index d4cbca7..b71efca 100644 --- a/lib/Phi/Widgets/Taskbar.hs +++ b/lib/Phi/Widgets/Taskbar.hs @@ -214,66 +214,16 @@ instance WidgetClass Taskbar where forM_ (zip [0..] desktopWindows) $ \(i, window) -> do let style = (if window == activeWindow then activeTaskStyle else normalTaskStyle) config - (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) - hd = h - (borderV $ margin $ desktopBorder ds) - 2*(borderWidth $ desktopBorder ds) - (borderV $ padding $ desktopBorder ds) - h' = hd - (borderV $ margin $ taskBorder style) + 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) -> do - save - 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 + (Just state, Just icons, Just scaledIconRef) -> + renderTask state icons scaledIconRef style x y windowWidth h' _ -> return () @@ -283,7 +233,7 @@ instance WidgetClass Taskbar where 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 , taskbarWindowIcons = icons , 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) showLayout layout -bestIcon :: [(Int, Surface)] -> Maybe Surface -bestIcon icons = fmap snd . listToMaybe $ sortBy compareIcons icons +renderTask :: WindowState -> [(Int, Surface)] -> IORef (Maybe (Int, Surface)) -> TaskStyle -> Int -> Int -> Int -> Int -> Render () +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 + bestIcon = fmap snd . listToMaybe $ sortBy compareIcons icons compareIcons = flip (compare `on` fst) |