Make taskbar more styleable

1 files changed, 78 insertions, 25 deletions

diff --git a/lib/Phi/Widgets/Taskbar.hs b/lib/Phi/Widgets/Taskbar.hs
index d7907a0..3f3b3c2 100644
--- a/lib/Phi/Widgets/Taskbar.hs
+++ b/lib/Phi/Widgets/Taskbar.hs
@@ -1,6 +1,10 @@
-{-# LANGUAGE TypeFamilies, DeriveDataTypeable #-}
+{-# LANGUAGE TypeFamilies, DeriveDataTypeable, TypeSynonymInstances #-}
 
-module Phi.Widgets.Taskbar ( TaskbarConfig(..)
+module Phi.Widgets.Taskbar ( IconStyle
+                           , idIconStyle
+                           , desaturateIconStyle
+                           , TaskStyle(..)
+                           , TaskbarConfig(..)
                            , defaultTaskbarConfig
                            , taskbar
                            ) where
@@ -41,19 +45,62 @@ import Phi.Widget
 import Phi.X11.Atoms
 
 
-data TaskbarConfig = TaskbarConfig { taskbarFont      :: !String
-                                   , taskMaxSize      :: !Int
+type IconStyle = Surface -> Render ()
+instance Show IconStyle where
+  show _ = "IconStyle"
+
+idIconStyle :: IconStyle
+idIconStyle = flip withPatternForSurface setSource
+
+desaturateIconStyle :: Double -> IconStyle
+desaturateIconStyle v icon = do
+  w <- imageSurfaceGetWidth icon
+  h <- imageSurfaceGetHeight icon
+  
+  renderWithSimilarSurface ContentColorAlpha w h $ \surface1 -> do
+    renderWithSimilarSurface ContentColor w h $ \surface2 -> do
+      renderWith surface1 $ do
+        renderWith surface2 $ do
+          withPatternForSurface icon setSource
+          paint
+          
+          setOperator OperatorHslSaturation
+          setSourceRGBA 0 0 0 (1-v)
+          paint
+        
+        withPatternForSurface surface2 setSource
+        paint
+        
+        setOperator OperatorDestIn
+        withPatternForSurface icon setSource
+        paint
+    
+      withPatternForSurface surface1 setSource
+
+data TaskStyle = TaskStyle { taskFont      :: !String
+                           , taskColor     :: !Color
+                           , taskBorder    :: !BorderConfig
+                           , taskIconStyle :: !IconStyle
+                           } deriving Show
+
+data TaskbarConfig = TaskbarConfig { taskMaxSize      :: !Int
                                    , showDesktops     :: !Bool
-                                   , taskBorder       :: !BorderConfig
-                                   , activeTaskBorder :: !BorderConfig
+                                   , normalTaskStyle  :: !TaskStyle
+                                   , activeTaskStyle  :: !TaskStyle
                                    } deriving Show
 
+defaultStyle :: TaskStyle
+defaultStyle = TaskStyle { taskFont = "Sans 8"
+                         , taskColor = (0, 0, 0, 1)
+                         , taskBorder = defaultBorderConfig
+                         , taskIconStyle = idIconStyle
+                         }
+
 defaultTaskbarConfig :: TaskbarConfig
-defaultTaskbarConfig = TaskbarConfig { taskbarFont = "Sans 7"
-                                     , taskMaxSize = 150
+defaultTaskbarConfig = TaskbarConfig { taskMaxSize = 150
                                      , showDesktops = False
-                                     , taskBorder = defaultBorderConfig
-                                     , activeTaskBorder = defaultBorderConfig { borderColor = (1, 1, 1, 1) }
+                                     , normalTaskStyle = defaultStyle
+                                     , activeTaskStyle = defaultStyle {taskBorder = defaultBorderConfig { borderColor = (1, 1, 1, 1) }}
                                      }
 
 data Taskbar = Taskbar TaskbarConfig deriving Show
@@ -90,35 +137,41 @@ instance WidgetClass Taskbar where
   minSize _ = 0
   weight _ = 1
   
-  render (Taskbar config) TaskbarState {taskbarActiveWindow = activeWindow, taskbarDesktopCount = desktopCount, taskbarWindows = windows, taskbarWindowStates = windowStates, taskbarWindowIcons = windowIcons} w h = do
+  render (Taskbar config) TaskbarState { taskbarActiveWindow = activeWindow
+                                       , taskbarDesktopCount = desktopCount
+                                       , taskbarWindows = windows
+                                       , taskbarWindowStates = windowStates
+                                       , taskbarWindowIcons = windowIcons
+                                       } w h = do
     let desktopWindows = map (\desktop -> (desktop, filter (fromMaybe False . fmap (windowOnDesktop desktop) . flip M.lookup windowStates) windows)) $ take desktopCount [0..]
         windowCount = sum $ map (length . snd) $ desktopWindows
     when (windowCount /= 0) $ do
       let windowWidth = min (taskMaxSize config) (w `div` windowCount)
       
       forM_ (zip [0..] $ join $ map snd desktopWindows) $ \(i, window) -> do
-        let border = if window == activeWindow then activeTaskBorder config else taskBorder config
-            leftBorder = (borderLeft $ margin border) + (borderWidth border) + (borderLeft $ padding border)
-            rightBorder = (borderRight $ margin border) + (borderWidth border) + (borderRight $ padding border)
-            h' = h - (borderV $ margin border)
+        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)
+            h' = h - (borderV $ margin $ taskBorder style)
             mstate = M.lookup window windowStates
             micons = M.lookup window windowIcons
 
         case (mstate, micons) of
           (Just state, Just icons) -> do
             save
-            drawBorder border (i*windowWidth) 0 windowWidth h
+            drawBorder (taskBorder style) (i*windowWidth) 0 windowWidth h
             clip
             
-            setSourceRGB 1 1 1
-            renderText config (fromIntegral (i*windowWidth + leftBorder + h' + 3)) 0 (windowWidth - leftBorder - h' - 3 - rightBorder) h $ windowTitle state
+            setSourceRGBA r g b a
+            renderText style (fromIntegral (i*windowWidth + leftBorder + h' + 3)) 0 (windowWidth - leftBorder - h' - 3 - rightBorder) h $ windowTitle state
             
             restore
             
             case bestIcon h' icons of
-              Just icon -> withPatternForSurface icon $ \pattern -> do
+              Just icon -> do 
                 save
-                translate (fromIntegral $  i*windowWidth + leftBorder) (fromIntegral $ borderTop $ margin border)
+                translate (fromIntegral $  i*windowWidth + leftBorder) (fromIntegral $ borderTop $ margin $ taskBorder style)
                 imageW <- imageSurfaceGetWidth icon
                 imageH <- imageSurfaceGetHeight icon
                 
@@ -127,8 +180,8 @@ instance WidgetClass Taskbar where
                 
                 when (imageH < imageW) $
                   translate 0 $ (fromIntegral (imageW-imageH))/2
-
-                setSource pattern
+                
+                taskIconStyle style icon
                 paint
                 restore
                 
@@ -144,11 +197,11 @@ instance WidgetClass Taskbar where
     _ -> priv
 
 
-renderText :: TaskbarConfig -> Int -> Int -> Int -> Int -> String -> Render ()
-renderText config x y w h text = do
+renderText :: TaskStyle -> Int -> Int -> Int -> Int -> String -> Render ()
+renderText style x y w h text = do
   layout <- createLayout ""
   (_, PangoRectangle _ _ textWidth textHeight) <- liftIO $ do
-    layoutSetMarkup layout $ "<span font='" ++ (taskbarFont config) ++ "'>" ++ (escapeMarkup text) ++ "</span>"
+    layoutSetMarkup layout $ "<span font='" ++ (taskFont style) ++ "'>" ++ (escapeMarkup text) ++ "</span>"
     layoutSetWidth layout $ Just $ fromIntegral w
     layoutSetEllipsize layout EllipsizeEnd