summaryrefslogtreecommitdiffstats
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/Phi/Widgets/Taskbar.hs153
-rw-r--r--lib/Phi/X11/AtomList.hs1
2 files changed, 105 insertions, 49 deletions
diff --git a/lib/Phi/Widgets/Taskbar.hs b/lib/Phi/Widgets/Taskbar.hs
index 4f85e71..4377224 100644
--- a/lib/Phi/Widgets/Taskbar.hs
+++ b/lib/Phi/Widgets/Taskbar.hs
@@ -4,6 +4,7 @@ module Phi.Widgets.Taskbar ( IconStyle
, idIconStyle
, desaturateIconStyle
, TaskStyle(..)
+ , DesktopStyle(..)
, TaskbarConfig(..)
, defaultTaskbarConfig
, taskbar
@@ -47,7 +48,7 @@ import Phi.X11.Atoms
type IconStyle = Surface -> Render ()
instance Show IconStyle where
- show _ = "IconStyle"
+ show _ = "IconStyle <?>"
idIconStyle :: IconStyle
idIconStyle = flip withPatternForSurface setSource
@@ -83,24 +84,31 @@ data TaskStyle = TaskStyle { taskFont :: !String
, taskIconStyle :: !IconStyle
} deriving Show
+data DesktopStyle = DesktopStyle { desktopFont :: !String
+ , desktopLabelWidth :: !Int
+ , desktopLabelGap :: !Int
+ , desktopColor :: !Color
+ , desktopBorder :: !BorderConfig
+ } deriving Show
+
data TaskbarConfig = TaskbarConfig { taskMaxSize :: !Int
- , showDesktops :: !Bool
, normalTaskStyle :: !TaskStyle
, activeTaskStyle :: !TaskStyle
+ , desktopStyle :: !(Maybe (DesktopStyle, DesktopStyle))
} deriving Show
defaultStyle :: TaskStyle
defaultStyle = TaskStyle { taskFont = "Sans 8"
, taskColor = (0, 0, 0, 1)
- , taskBorder = defaultBorderConfig
+ , taskBorder = defaultBorderConfig { backgroundColor = (0.75, 0.75, 0.75, 1) }
, taskIconStyle = idIconStyle
}
defaultTaskbarConfig :: TaskbarConfig
defaultTaskbarConfig = TaskbarConfig { taskMaxSize = 150
- , showDesktops = False
, normalTaskStyle = defaultStyle
, activeTaskStyle = defaultStyle {taskBorder = defaultBorderConfig { borderColor = (1, 1, 1, 1) }}
+ , desktopStyle = Nothing
}
data Taskbar = Taskbar TaskbarConfig deriving Show
@@ -108,11 +116,12 @@ data Taskbar = Taskbar TaskbarConfig deriving Show
instance Show Surface where
show _ = "Surface <?>"
-data TaskbarState = TaskbarState { taskbarActiveWindow :: !Window
- , taskbarDesktopCount :: !Int
- , taskbarWindows :: ![Window]
- , taskbarWindowStates :: !(M.Map Window WindowState)
- , taskbarWindowIcons :: !(M.Map Window [(Int, Surface)])
+data TaskbarState = TaskbarState { taskbarActiveWindow :: !Window
+ , taskbarDesktopCount :: !Int
+ , taskbarCurrentDesktop :: !Int
+ , taskbarWindows :: ![Window]
+ , taskbarWindowStates :: !(M.Map Window WindowState)
+ , taskbarWindowIcons :: !(M.Map Window [(Int, Surface)])
} deriving Show
data WindowState = WindowState { windowTitle :: !String
@@ -122,6 +131,7 @@ data WindowState = WindowState { windowTitle :: !String
data TaskbarMessage = WindowListUpdate [Xlib.Window] (M.Map Window WindowState) (M.Map Window [(Int, Surface)])
| DesktopCountUpdate Int
+ | CurrentDesktopUpdate Int
| ActiveWindowUpdate Window
deriving (Show, Typeable)
@@ -131,7 +141,7 @@ instance WidgetClass Taskbar where
initWidget (Taskbar _) phi dispvar = do
forkIO $ taskbarRunner phi dispvar
- return $ TaskbarState 0 0 [] M.empty M.empty
+ return $ TaskbarState 0 0 (-1) [] M.empty M.empty
minSize _ = 0
@@ -139,69 +149,103 @@ instance WidgetClass Taskbar where
render (Taskbar config) TaskbarState { taskbarActiveWindow = activeWindow
, taskbarDesktopCount = desktopCount
+ , taskbarCurrentDesktop = currentDesktop
, 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
+ let desktopNumbers = take desktopCount [0..]
+ desktops = map (\desktop -> (desktop, filter (fromMaybe False . fmap (windowOnDesktop desktop) . flip M.lookup windowStates) windows)) desktopNumbers
+ windowCount = sum $ map (length . snd) $ desktops
+ dstyle d = fmap (if d == currentDesktop then snd else fst) $ desktopStyle config
+ dlabelwidth d = fromMaybe 0 $ fmap desktopLabelWidth $ dstyle d
+ gap d ds = if null (snd $ desktops !! d) then 0 else desktopLabelGap ds
+ dleftwidth d = fromMaybe 0 $ fmap (\ds@DesktopStyle {desktopBorder = border}
+ -> (borderLeft $ margin border) + (borderWidth border) + (borderLeft $ padding border)
+ + dlabelwidth d + gap d ds) $ dstyle d
+ dwidth d = fromMaybe 0 $ fmap (\ds@DesktopStyle {desktopBorder = border}
+ -> (borderH $ margin border) + 2*(borderWidth border) + (borderH $ padding border)
+ + dlabelwidth d + gap d ds) $ dstyle d
+
when (windowCount /= 0) $ do
- let windowWidth = min (taskMaxSize config) (w `div` windowCount)
+ let desktopsWidth = sum $ map dwidth desktopNumbers
+ windowWidth = min (taskMaxSize config) ((w - desktopsWidth) `div` windowCount)
- forM_ (zip [0..] $ join $ map snd 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)
- 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
+ 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 (taskBorder style) (i*windowWidth) 0 windowWidth h
+ drawBorder (desktopBorder ds) (dx - dleftwidth desktop) 0 (dwidth desktop + windowWidth * length desktopWindows) h
clip
setSourceRGBA r g b a
- renderText style (fromIntegral (i*windowWidth + leftBorder + h' + 3)) 0 (windowWidth - leftBorder - h' - 3 - rightBorder) h $ windowTitle state
+ renderText (desktopFont ds) (fromIntegral (dx - dlabelwidth desktop - gap desktop ds)) 0 (dlabelwidth desktop) h $ show (desktop+1)
restore
-
- case bestIcon h' icons of
- Just icon -> do
- save
- translate (fromIntegral $ i*windowWidth + leftBorder) (fromIntegral $ borderTop $ margin $ taskBorder style)
- imageW <- imageSurfaceGetWidth icon
- imageH <- imageSurfaceGetHeight icon
-
- let scalef = (fromIntegral h')/(fromIntegral $ max imageW imageH)
- scale scalef scalef
-
- when (imageH < imageW) $
- translate 0 $ (fromIntegral (imageW-imageH))/2
-
- taskIconStyle style icon
- paint
- restore
-
- Nothing -> return ()
-
_ -> return ()
+ 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)
+ h' = h - (borderV $ margin $ taskBorder style)
+ mstate = M.lookup window windowStates
+ micons = M.lookup window windowIcons
+ x = dx + i*windowWidth
+
+ case (mstate, micons) of
+ (Just state, Just icons) -> do
+ save
+ drawBorder (taskBorder style) x 0 windowWidth h
+ clip
+
+ setSourceRGBA r g b a
+ renderText (taskFont style) (fromIntegral (x + leftBorder + h' + 3)) 0 (windowWidth - leftBorder - h' - 3 - rightBorder) h $ windowTitle state
+
+ restore
+
+ case bestIcon h' icons of
+ Just icon -> do
+ save
+ translate (fromIntegral $ x + leftBorder) (fromIntegral $ borderTop $ margin $ taskBorder style)
+ imageW <- imageSurfaceGetWidth icon
+ imageH <- imageSurfaceGetHeight icon
+
+ let scalef = (fromIntegral h')/(fromIntegral $ max imageW imageH)
+ scale scalef scalef
+
+ when (imageH < imageW) $
+ translate 0 $ (fromIntegral (imageW-imageH))/2
+
+ taskIconStyle style icon
+ paint
+ restore
+
+ Nothing -> return ()
+
+ _ -> return ()
+
+ return $ nwindows + length desktopWindows
+
handleMessage _ priv m = case (fromMessage m) of
Just (WindowListUpdate windows windowStates icons) -> priv {taskbarWindows = windows, taskbarWindowStates = windowStates, taskbarWindowIcons = icons}
Just (DesktopCountUpdate count) -> priv {taskbarDesktopCount = count}
+ Just (CurrentDesktopUpdate current) -> priv {taskbarCurrentDesktop = current}
Just (ActiveWindowUpdate window) -> priv {taskbarActiveWindow = window}
_ -> priv
-renderText :: TaskStyle -> Int -> Int -> Int -> Int -> String -> Render ()
-renderText style x y w h text = do
+renderText :: String -> Int -> Int -> Int -> Int -> String -> Render ()
+renderText font x y w h text = do
layout <- createLayout ""
(_, PangoRectangle _ _ textWidth textHeight) <- liftIO $ do
- layoutSetMarkup layout $ "<span font='" ++ (taskFont style) ++ "'>" ++ (escapeMarkup text) ++ "</span>"
+ layoutSetMarkup layout $ "<span font='" ++ font ++ "'>" ++ (escapeMarkup text) ++ "</span>"
layoutSetWidth layout $ Just $ fromIntegral w
layoutSetEllipsize layout EllipsizeEnd
@@ -226,9 +270,11 @@ taskbarRunner phi dispvar = do
(windows, states, icons) <- liftIO $ withDisplay dispvar $ \disp -> do
(windows, states, icons) <- getWindowStates disp (getAtoms dispvar) [] M.empty M.empty
desktopCount <- getDesktopCount disp (getAtoms dispvar)
+ current <- getCurrentDesktop disp (getAtoms dispvar)
activeWindow <- getActiveWindow disp (getAtoms dispvar)
sendMessage phi $ WindowListUpdate windows states icons
sendMessage phi $ DesktopCountUpdate desktopCount
+ sendMessage phi $ CurrentDesktopUpdate current
sendMessage phi $ ActiveWindowUpdate activeWindow
return (windows, states, icons)
sendMessage phi Repaint
@@ -247,6 +293,7 @@ handlePropertyUpdate phi dispvar XExtras.PropertyEvent {XExtras.ev_atom = atom,
when (elem atom $ map ($ atoms) [ atom_NET_ACTIVE_WINDOW
, atom_NET_NUMBER_OF_DESKTOPS
+ , atom_NET_CURRENT_DESKTOP
, atom_NET_CLIENT_LIST
, atom_NET_WM_ICON
, atom_NET_WM_NAME
@@ -265,6 +312,10 @@ handlePropertyUpdate phi dispvar XExtras.PropertyEvent {XExtras.ev_atom = atom,
desktopCount <- liftIO $ getDesktopCount disp atoms
sendMessage phi $ DesktopCountUpdate desktopCount
sendMessage phi Repaint
+ when (atom == atom_NET_CURRENT_DESKTOP atoms) $ do
+ current <- liftIO $ getCurrentDesktop disp atoms
+ sendMessage phi $ CurrentDesktopUpdate current
+ sendMessage phi Repaint
when (atom == atom_NET_CLIENT_LIST atoms) $ do
(windows, windowStates, icons) <- get
(windows', windowStates', icons') <- liftIO $ getWindowStates disp atoms windows windowStates icons
@@ -298,6 +349,10 @@ getDesktopCount :: Xlib.Display -> Atoms -> IO Int
getDesktopCount disp atoms =
liftM (fromIntegral . fromMaybe 0 . join . fmap listToMaybe) $ XExtras.getWindowProperty32 disp (atom_NET_NUMBER_OF_DESKTOPS atoms) $ Xlib.defaultRootWindow disp
+getCurrentDesktop :: Xlib.Display -> Atoms -> IO Int
+getCurrentDesktop disp atoms =
+ liftM (fromIntegral . fromMaybe (-1) . join . fmap listToMaybe) $ XExtras.getWindowProperty32 disp (atom_NET_CURRENT_DESKTOP atoms) $ Xlib.defaultRootWindow disp
+
getActiveWindow :: Xlib.Display -> Atoms -> IO Window
getActiveWindow disp atoms =
liftM (fromIntegral . fromMaybe 0 . join . fmap listToMaybe) $ XExtras.getWindowProperty32 disp (atom_NET_ACTIVE_WINDOW atoms) $ Xlib.defaultRootWindow disp
diff --git a/lib/Phi/X11/AtomList.hs b/lib/Phi/X11/AtomList.hs
index dc5eac1..d18be71 100644
--- a/lib/Phi/X11/AtomList.hs
+++ b/lib/Phi/X11/AtomList.hs
@@ -22,6 +22,7 @@ atoms = [ "UTF8_STRING"
, "_NET_WM_STRUT_PARTIAL"
, "_NET_ACTIVE_WINDOW"
, "_NET_NUMBER_OF_DESKTOPS"
+ , "_NET_CURRENT_DESKTOP"
, "_NET_CLIENT_LIST"
, "_MOTIF_WM_HINTS"
, "_XROOTPMAP_ID"
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-22 01:06:35 +0100