summaryrefslogtreecommitdiffstats
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/Phi/Widgets/Taskbar.hs120
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)