From b66d6690d8a062053268b3246a2a55cbff46410d Mon Sep 17 00:00:00 2001 From: Matthias Schiffer Date: Sat, 16 Jul 2011 15:55:31 +0200 Subject: Taskbar: Sort windows by screen --- lib/Phi/Border.hs | 4 +- lib/Phi/Widget.hs | 50 +++++++---- lib/Phi/Widgets/Clock.hs | 2 +- lib/Phi/Widgets/Taskbar.hs | 214 +++++++++++++++++++++++++++------------------ lib/Phi/X11.hs | 4 +- src/Phi.hs | 11 +-- 6 files changed, 175 insertions(+), 110 deletions(-) diff --git a/lib/Phi/Border.hs b/lib/Phi/Border.hs index 7de66ea..791845d 100644 --- a/lib/Phi/Border.hs +++ b/lib/Phi/Border.hs @@ -79,10 +79,10 @@ instance WidgetClass Border where width' = width - borderH m - 2*bw - borderH p height' = height - borderV m - 2*bw - borderV p - render (Border config _) (BorderState widgetStates) w h = do + render (Border config _) (BorderState widgetStates) w h screen = do drawBorder config 0 0 w h clip - renderWidgets widgetStates + renderWidgets widgetStates screen handleMessage _ (BorderState widgetStates) m = BorderState $ handleMessageWidgets m widgetStates diff --git a/lib/Phi/Widget.hs b/lib/Phi/Widget.hs index 218dea1..48ab536 100644 --- a/lib/Phi/Widget.hs +++ b/lib/Phi/Widget.hs @@ -3,6 +3,8 @@ module Phi.Widget ( Display(..) , withDisplay , getAtoms + , getScreens + , unionArea , Widget(..) , WidgetClass(..) , WidgetState(..) @@ -19,24 +21,42 @@ import Control.Monad.IO.Class import Data.Traversable -import qualified Graphics.X11.Xlib +import qualified Graphics.X11.Xlib as Xlib import Graphics.Rendering.Cairo import Phi.Phi import Phi.X11.Atoms -data Display = Display (MVar Graphics.X11.Xlib.Display) Atoms +data Display = Display (MVar Xlib.Display) Atoms [Xlib.Rectangle] -withDisplay :: MonadIO m => Display -> (Graphics.X11.Xlib.Display -> m a) -> m a -withDisplay (Display dispvar _) f = do +withDisplay :: MonadIO m => Display -> (Xlib.Display -> m a) -> m a +withDisplay (Display dispvar _ _) f = do disp <- liftIO $ takeMVar dispvar a <- f disp liftIO $ putMVar dispvar disp return a getAtoms :: Display -> Atoms -getAtoms (Display _ atoms) = atoms +getAtoms (Display _ atoms _) = atoms + +getScreens :: Display -> [Xlib.Rectangle] +getScreens (Display _ _ screens) = screens + +unionArea :: Xlib.Rectangle -> Xlib.Rectangle -> Int +unionArea a b = fromIntegral $ uw*uh + where + uw = max 0 $ (min ax2 bx2) - (max ax1 bx1) + uh = max 0 $ (min ay2 by2) - (max ay1 by1) + + Xlib.Rectangle ax1 ay1 aw ah = a + Xlib.Rectangle bx1 by1 bw bh = b + + ax2 = ax1 + fromIntegral aw + ay2 = ay1 + fromIntegral ah + + bx2 = bx1 + fromIntegral bw + by2 = by1 + fromIntegral bh class Show a => WidgetClass a where @@ -52,7 +72,7 @@ class Show a => WidgetClass a where layout :: a -> WidgetData a -> Int -> Int -> WidgetData a layout _ priv _ _ = priv - render :: a -> WidgetData a -> Int -> Int -> Render () + render :: a -> WidgetData a -> Int -> Int -> Xlib.Rectangle -> Render () handleMessage :: a -> WidgetData a -> Message -> WidgetData a handleMessage _ priv _ = priv @@ -102,16 +122,16 @@ layoutWidgets widgets x y width height = snd $ mapAccumL layoutWidgetAndX x widg nneg :: (Num a, Ord a) => a -> a nneg x = max 0 x -renderWidgets :: [WidgetState] -> Render () -renderWidgets widgets = forM_ widgets $ \WidgetState { stateWidget = widget - , stateX = x - , stateY = y - , stateWidth = w - , stateHeight = h - , statePrivateData = priv } -> do +renderWidgets :: [WidgetState] -> Xlib.Rectangle -> Render () +renderWidgets widgets screen = forM_ widgets $ \WidgetState { stateWidget = widget + , stateX = x + , stateY = y + , stateWidth = w + , stateHeight = h + , statePrivateData = priv } -> do save translate (fromIntegral x) (fromIntegral y) - render widget priv w h + render widget priv w h screen restore handleMessageWidgets :: Message -> [WidgetState] -> [WidgetState] @@ -127,7 +147,7 @@ instance WidgetClass Separator where minSize (Separator s _) = s weight (Separator _ w) = w - render _ _ _ _ = return () + render _ _ _ _ _ = return () separator :: Int -> Float -> Widget separator s w = Widget $ Separator s w diff --git a/lib/Phi/Widgets/Clock.hs b/lib/Phi/Widgets/Clock.hs index 3e88b0e..7172f77 100644 --- a/lib/Phi/Widgets/Clock.hs +++ b/lib/Phi/Widgets/Clock.hs @@ -57,7 +57,7 @@ instance WidgetClass Clock where minSize (Clock config ) = clockSize config - render (Clock config) (ClockState time) w h = do + render (Clock config) (ClockState time) w h _ = do time <- liftIO getZonedTime let (r, g, b, a) = fontColor config str = formatTime defaultTimeLocale (clockFormat config) time diff --git a/lib/Phi/Widgets/Taskbar.hs b/lib/Phi/Widgets/Taskbar.hs index 4377224..caa7599 100644 --- a/lib/Phi/Widgets/Taskbar.hs +++ b/lib/Phi/Widgets/Taskbar.hs @@ -122,6 +122,7 @@ data TaskbarState = TaskbarState { taskbarActiveWindow :: !Window , taskbarWindows :: ![Window] , taskbarWindowStates :: !(M.Map Window WindowState) , taskbarWindowIcons :: !(M.Map Window [(Int, Surface)]) + , taskbarWindowScreens :: !(M.Map Window Xlib.Rectangle) } deriving Show data WindowState = WindowState { windowTitle :: !String @@ -129,7 +130,7 @@ data WindowState = WindowState { windowTitle :: !String , windowVisible :: !Bool } deriving (Show, Eq) -data TaskbarMessage = WindowListUpdate [Xlib.Window] (M.Map Window WindowState) (M.Map Window [(Int, Surface)]) +data TaskbarMessage = WindowListUpdate [Xlib.Window] (M.Map Window WindowState) (M.Map Window [(Int, Surface)]) (M.Map Window Xlib.Rectangle) | DesktopCountUpdate Int | CurrentDesktopUpdate Int | ActiveWindowUpdate Window @@ -141,7 +142,7 @@ instance WidgetClass Taskbar where initWidget (Taskbar _) phi dispvar = do forkIO $ taskbarRunner phi dispvar - return $ TaskbarState 0 0 (-1) [] M.empty M.empty + return $ TaskbarState 0 0 (-1) [] M.empty M.empty M.empty minSize _ = 0 @@ -153,9 +154,11 @@ instance WidgetClass Taskbar where , taskbarWindows = windows , taskbarWindowStates = windowStates , taskbarWindowIcons = windowIcons - } w h = do - let desktopNumbers = take desktopCount [0..] - desktops = map (\desktop -> (desktop, filter (fromMaybe False . fmap (windowOnDesktop desktop) . flip M.lookup windowStates) windows)) desktopNumbers + , taskbarWindowScreens = windowScreens + } w h screen = do + let screenWindows = filter ((== Just screen) . flip M.lookup windowScreens) windows + desktopNumbers = take desktopCount [0..] + desktops = map (\desktop -> (desktop, filter (fromMaybe False . fmap (windowOnDesktop desktop) . flip M.lookup windowStates) screenWindows)) 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 @@ -166,75 +169,73 @@ instance WidgetClass Taskbar where 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 desktopsWidth = sum $ map dwidth desktopNumbers - windowWidth = min (taskMaxSize config) ((w - desktopsWidth) `div` windowCount) + desktopsWidth = sum $ map dwidth desktopNumbers + windowWidth = if windowCount == 0 then 0 else min (taskMaxSize config) ((w - desktopsWidth) `div` windowCount) + + 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 (desktopBorder ds) (dx - dleftwidth desktop) 0 (dwidth desktop + windowWidth * length desktopWindows) h + clip + + setSourceRGBA r g b a + renderText (desktopFont ds) (fromIntegral (dx - dlabelwidth desktop - gap desktop ds)) 0 (dlabelwidth desktop) h $ show (desktop+1) + + restore + _ -> return () - flip (flip foldM_ 0) desktops $ \nwindows (desktop, desktopWindows) -> do - let dstyle' = dstyle desktop - dx = dleftwidth desktop + (sum $ map dwidth $ take desktop [0..]) + nwindows*windowWidth + 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 dstyle' of - Just ds -> do - let (r, g, b, a) = desktopColor ds + case (mstate, micons) of + (Just state, Just icons) -> do save - drawBorder (desktopBorder ds) (dx - dleftwidth desktop) 0 (dwidth desktop + windowWidth * length desktopWindows) h + drawBorder (taskBorder style) x 0 windowWidth h clip setSourceRGBA r g b a - renderText (desktopFont ds) (fromIntegral (dx - dlabelwidth desktop - gap desktop ds)) 0 (dlabelwidth desktop) h $ show (desktop+1) + renderText (taskFont style) (fromIntegral (x + leftBorder + h' + 3)) 0 (windowWidth - leftBorder - h' - 3 - rightBorder) h $ windowTitle state restore - _ -> 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 + 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 (WindowListUpdate windows windowStates icons screens) -> priv {taskbarWindows = windows, taskbarWindowStates = windowStates, taskbarWindowIcons = icons, taskbarWindowScreens = screens} Just (DesktopCountUpdate count) -> priv {taskbarDesktopCount = count} Just (CurrentDesktopUpdate current) -> priv {taskbarCurrentDesktop = current} Just (ActiveWindowUpdate window) -> priv {taskbarActiveWindow = window} @@ -267,29 +268,31 @@ windowOnDesktop desktop state = (windowVisible state) && (desktop == windowDeskt taskbarRunner :: Phi -> Display -> IO () taskbarRunner phi dispvar = do - (windows, states, icons) <- liftIO $ withDisplay dispvar $ \disp -> do - (windows, states, icons) <- getWindowStates disp (getAtoms dispvar) [] M.empty M.empty + let screens = getScreens dispvar + (windows, states, icons, windowScreens) <- liftIO $ withDisplay dispvar $ \disp -> do + (windows, states, icons, windowScreens) <- getWindowStates disp screens (getAtoms dispvar) [] M.empty 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 $ WindowListUpdate windows states icons windowScreens sendMessage phi $ DesktopCountUpdate desktopCount sendMessage phi $ CurrentDesktopUpdate current sendMessage phi $ ActiveWindowUpdate activeWindow - return (windows, states, icons) + return (windows, states, icons, windowScreens) sendMessage phi Repaint - flip evalStateT (windows, states, icons) $ forever $ do + flip evalStateT (windows, states, icons, windowScreens) $ forever $ do m <- receiveMessage phi case (fromMessage m) of - Just event@XExtras.PropertyEvent {} -> - handlePropertyUpdate phi dispvar event + Just event -> + handleEvent phi dispvar event _ -> return () -handlePropertyUpdate :: Phi -> Display -> XExtras.Event -> StateT ([Window], M.Map Window WindowState, M.Map Window [(Int, Surface)]) IO () -handlePropertyUpdate phi dispvar XExtras.PropertyEvent {XExtras.ev_atom = atom, XExtras.ev_window = window} = do +handleEvent :: Phi -> Display -> XExtras.Event -> StateT ([Window], M.Map Window WindowState, M.Map Window [(Int, Surface)], M.Map Window Xlib.Rectangle) IO () +handleEvent phi dispvar XExtras.PropertyEvent {XExtras.ev_atom = atom, XExtras.ev_window = window} = do let atoms = getAtoms dispvar + let screens = getScreens dispvar when (elem atom $ map ($ atoms) [ atom_NET_ACTIVE_WINDOW , atom_NET_NUMBER_OF_DESKTOPS @@ -317,23 +320,23 @@ handlePropertyUpdate phi dispvar XExtras.PropertyEvent {XExtras.ev_atom = atom, 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 + (windows, windowStates, icons, windowScreens) <- get + (windows', windowStates', icons', windowScreens') <- liftIO $ getWindowStates disp screens atoms windows windowStates icons windowScreens when (windows /= windows') $ do - sendMessage phi $ WindowListUpdate windows' windowStates' icons' + sendMessage phi $ WindowListUpdate windows' windowStates' icons' windowScreens' sendMessage phi Repaint - put (windows', windowStates', icons') + put (windows', windowStates', icons', windowScreens') else do - (windows, windowStates, icons) <- get + (windows, windowStates, icons, windowScreens) <- get when (elem window windows) $ do when (atom == atom_NET_WM_ICON atoms) $ do icon <- liftIO $ getWindowIcons disp atoms window let icons' = M.insert window icon icons - sendMessage phi $ WindowListUpdate windows windowStates icons' + sendMessage phi $ WindowListUpdate windows windowStates icons' windowScreens sendMessage phi Repaint - put (windows, windowStates, icons') + put (windows, windowStates, icons', windowScreens) when (atom /= atom_NET_WM_ICON atoms) $ do let windowState = M.lookup window windowStates @@ -341,14 +344,31 @@ handlePropertyUpdate phi dispvar XExtras.PropertyEvent {XExtras.ev_atom = atom, when (windowState /= (Just windowState')) $ do let windowStates' = M.insert window windowState' windowStates - sendMessage phi $ WindowListUpdate windows windowStates' icons + sendMessage phi $ WindowListUpdate windows windowStates' icons windowScreens sendMessage phi Repaint - put (windows, windowStates', icons) + put (windows, windowStates', icons, windowScreens) + +handleEvent phi dispvar XExtras.ConfigureEvent {XExtras.ev_window = window} = do + let screens = getScreens dispvar + + (windows, windowStates, icons, windowScreens) <- get + when (elem window windows) $ withDisplay dispvar $ \disp -> do + let screen = M.lookup window windowScreens + screen' <- liftIO $ getWindowScreen disp screens window + when (screen /= (Just screen')) $ do + let windowScreens' = M.insert window screen' windowScreens + sendMessage phi $ WindowListUpdate windows windowStates icons windowScreens' + sendMessage phi Repaint + put (windows, windowStates, icons, windowScreens') + +handleEvent _ _ _ = return () + 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 @@ -357,21 +377,24 @@ 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 -getWindowStates :: Xlib.Display -> Atoms -> [Window] -> M.Map Window WindowState -> M.Map Window [(Int, Surface)] - -> IO ([Window], M.Map Window WindowState, M.Map Window [(Int, Surface)]) -getWindowStates disp atoms oldWindows windowStates windowIcons = do +getWindowStates :: Xlib.Display -> [Xlib.Rectangle] -> Atoms -> [Window] -> M.Map Window WindowState -> M.Map Window [(Int, Surface)] -> M.Map Window Xlib.Rectangle + -> IO ([Window], M.Map Window WindowState, M.Map Window [(Int, Surface)], M.Map Window Xlib.Rectangle) +getWindowStates disp screens atoms oldWindows windowStates windowIcons windowScreens = do windows <- getWindowList disp atoms oldWindows let windowStates' = map (\w -> (w, M.lookup w windowStates)) windows windowIcons' = map (\w -> (w, M.lookup w windowIcons)) windows + windowScreens' = map (\w -> (w, M.lookup w windowScreens)) windows newWindowStates <- mapM getWindowState' windowStates' newWindowIcons <- mapM getWindowIcons' windowIcons' + newWindowScreens <- mapM getWindowScreen' windowScreens' - return (windows, M.fromList newWindowStates, M.fromList newWindowIcons) + return (windows, M.fromList newWindowStates, M.fromList newWindowIcons, M.fromList newWindowScreens) where getWindowState' (window, Just windowState) = return (window, windowState) getWindowState' (window, Nothing) = do + Xlib.selectInput disp window $ Xlib.propertyChangeMask .|. Xlib.structureNotifyMask windowState <- getWindowState disp atoms window return (window, windowState) @@ -379,10 +402,15 @@ getWindowStates disp atoms oldWindows windowStates windowIcons = do getWindowIcons' (window, Nothing) = do icons <- getWindowIcons disp atoms window return (window, icons) + + getWindowScreen' (window, Just screen) = return (window, screen) + getWindowScreen' (window, Nothing) = do + screen <- getWindowScreen disp screens window + return (window, screen) + getWindowState :: Xlib.Display -> Atoms -> Window -> IO WindowState getWindowState disp atoms window = do - Xlib.selectInput disp window Xlib.propertyChangeMask netwmname <- liftM (fmap (decode . map fromIntegral)) $ XExtras.getWindowProperty8 disp (atom_NET_WM_NAME atoms) window wmname <- case netwmname of Just name -> return name @@ -399,6 +427,7 @@ getWindowState disp atoms window = do getWindowIcons :: Xlib.Display -> Atoms -> Window -> IO [(Int, Surface)] getWindowIcons disp atoms window = XExtras.getWindowProperty32 disp (atom_NET_WM_ICON atoms) window >>= readIcons . fromMaybe [] + readIcons :: [CLong] -> IO [(Int, Surface)] readIcons (width:height:iconData) = do if ((fromIntegral $ length iconData) < (width*height)) then return [] else do @@ -429,6 +458,21 @@ premultiply c = a .|. r .|. g .|. b g = pm gmask b = pm bmask + +getWindowScreen :: Xlib.Display -> [Xlib.Rectangle] -> Window -> IO Xlib.Rectangle +getWindowScreen disp screens window = do + (_, _, _, width, height, _, _) <- Xlib.getGeometry disp window + (ret, x, y, _) <- Xlib.translateCoordinates disp window (Xlib.defaultRootWindow disp) 0 0 + + case ret of + True -> do + let windowRect = Xlib.Rectangle x y width height + screen = maximumBy (compare `on` unionArea windowRect) screens + return screen + False -> + return $ head screens + + showWindow :: Xlib.Display -> Atoms -> Window -> IO Bool showWindow disp atoms window = do states <- liftM (map fromIntegral . fromMaybe []) $ XExtras.getWindowProperty32 disp (atom_NET_WM_STATE atoms) window diff --git a/lib/Phi/X11.hs b/lib/Phi/X11.hs index 709d04a..24f0986 100644 --- a/lib/Phi/X11.hs +++ b/lib/Phi/X11.hs @@ -86,7 +86,7 @@ runPhi xconfig config widgets = do screens <- liftIO $ phiXScreenInfo xconfig disp dispmvar <- liftIO $ newMVar disp - let dispvar = Widget.Display dispmvar atoms + let dispvar = Widget.Display dispmvar atoms screens widgetStates <- liftIO $ mapM (Widget.createWidgetState phi dispvar) widgets Widget.withDisplay dispvar $ \disp -> do @@ -172,7 +172,7 @@ updatePanels disp redraw = do setSource pattern paint restore - Widget.renderWidgets layoutedWidgets + Widget.renderWidgets layoutedWidgets $ panelScreenArea panel return panel' diff --git a/src/Phi.hs b/src/Phi.hs index 417d8f8..ea35633 100644 --- a/src/Phi.hs +++ b/src/Phi.hs @@ -12,15 +12,16 @@ main = do runPhi defaultXConfig defaultPanelConfig { panelPosition = Bottom } [theTaskbar, brightBorder [theClock]] where - normalTaskBorder = BorderConfig (BorderWidth 2 (-4) 2 7) 1 (BorderWidth 0 5 0 5) (0.9, 0.9, 0.9, 0.65) (0.45, 0.45, 0.45, 0.8) 5 0 - activeTaskBorder = normalTaskBorder {borderColor = (1, 1, 1, 0.65), backgroundColor = (0, 0, 0, 0.8)} + normalTaskBorder = BorderConfig (BorderWidth 2 (-3) 2 7) 1 (BorderWidth 0 5 0 5) (0.9, 0.9, 0.9, 0.8) (0.45, 0.45, 0.45, 1) 5 0 + activeTaskBorder = normalTaskBorder { borderColor = (1, 1, 1, 0.8) + , backgroundColor = (0, 0, 0, 1) + } normalDesktopBorder = normalTaskBorder { margin = BorderWidth 2 3 2 3 , padding = BorderWidth 0 2 0 2 - , borderColor = (0.75, 0.75, 0.75, 0.5) + , borderColor = (0.7, 0.7, 0.7, 0.8) , backgroundColor = (1, 1, 1, 0.8) } - currentDesktopBorder = normalDesktopBorder { borderColor = (0.75, 0.75, 0.75, 0.8) - , backgroundColor = (0.2, 0.2, 0.2, 0.9) + currentDesktopBorder = normalDesktopBorder { backgroundColor = (0.2, 0.2, 0.2, 0.8) } taskStyle = TaskStyle { taskFont = "Sans 7" , taskColor = (1, 1, 1, 1) -- cgit v1.2.3