Some more work on the taskbar
This commit is contained in:
parent
c6e57070ab
commit
465d757986
8 changed files with 273 additions and 72 deletions
|
|
@ -4,6 +4,8 @@ module Phi.Border ( BorderWidth(..)
|
|||
, simpleBorderWidth
|
||||
, BorderConfig(..)
|
||||
, defaultBorderConfig
|
||||
, drawBorder
|
||||
, roundRectangle
|
||||
, border
|
||||
) where
|
||||
|
||||
|
|
@ -76,41 +78,46 @@ instance WidgetClass Border where
|
|||
height' = height - borderV m - 2*bw - borderV p
|
||||
|
||||
render (Border config _) (BorderState widgetStates) w h = do
|
||||
newPath
|
||||
arc (x + width - radius) (y + radius) radius (-pi/2) 0
|
||||
arc (x + width - radius) (y + height - radius) radius 0 (pi/2)
|
||||
arc (x + radius) (y + height - radius) radius (pi/2) pi
|
||||
arc (x + radius) (y + radius) radius pi (pi*3/2)
|
||||
closePath
|
||||
|
||||
save
|
||||
setSourceRGBA fr fg fb fa
|
||||
fillPreserve
|
||||
|
||||
setSourceRGBA br bg bb ba
|
||||
setLineWidth $ fromIntegral bw
|
||||
strokePreserve
|
||||
restore
|
||||
|
||||
drawBorder config 0 0 w h
|
||||
clip
|
||||
renderWidgets widgetStates
|
||||
|
||||
where
|
||||
m = margin config
|
||||
bw = borderWidth config
|
||||
p = padding config
|
||||
radius = cornerRadius config
|
||||
|
||||
x = (fromIntegral $ borderLeft m) + (fromIntegral bw)/2
|
||||
y = (fromIntegral $ borderTop m) + (fromIntegral bw)/2
|
||||
width = fromIntegral $ w - borderH m - bw
|
||||
height = fromIntegral $ h - borderV m - bw
|
||||
|
||||
(br, bg, bb, ba) = borderColor config
|
||||
(fr, fg, fb, fa) = backgroundColor config
|
||||
|
||||
handleMessage _ (BorderState widgetStates) m = BorderState $ handleMessageWidgets m widgetStates
|
||||
|
||||
|
||||
drawBorder :: BorderConfig -> Int -> Int -> Int -> Int -> Render ()
|
||||
drawBorder config dx dy w h = do
|
||||
roundRectangle x y width height radius
|
||||
|
||||
save
|
||||
setSourceRGBA fr fg fb fa
|
||||
fillPreserve
|
||||
|
||||
setSourceRGBA br bg bb ba
|
||||
setLineWidth $ fromIntegral bw
|
||||
strokePreserve
|
||||
restore
|
||||
where
|
||||
m = margin config
|
||||
bw = borderWidth config
|
||||
p = padding config
|
||||
radius = cornerRadius config
|
||||
|
||||
x = (fromIntegral dx) + (fromIntegral $ borderLeft m) + (fromIntegral bw)/2
|
||||
y = (fromIntegral dy) + (fromIntegral $ borderTop m) + (fromIntegral bw)/2
|
||||
width = fromIntegral $ w - borderH m - bw
|
||||
height = fromIntegral $ h - borderV m - bw
|
||||
|
||||
(br, bg, bb, ba) = borderColor config
|
||||
(fr, fg, fb, fa) = backgroundColor config
|
||||
|
||||
roundRectangle :: Double -> Double -> Double -> Double -> Double -> Render ()
|
||||
roundRectangle x y width height radius = do
|
||||
newPath
|
||||
arc (x + width - radius) (y + radius) radius (-pi/2) 0
|
||||
arc (x + width - radius) (y + height - radius) radius 0 (pi/2)
|
||||
arc (x + radius) (y + height - radius) radius (pi/2) pi
|
||||
arc (x + radius) (y + radius) radius pi (pi*3/2)
|
||||
closePath
|
||||
|
||||
border :: BorderConfig -> [Widget] -> Widget
|
||||
border config widgets = Widget $ Border config widgets
|
||||
|
|
|
|||
|
|
@ -12,6 +12,8 @@ module Phi.Phi ( Phi
|
|||
|
||||
import Control.Concurrent.Chan
|
||||
import Control.Monad
|
||||
import Control.Monad.IO.Class
|
||||
|
||||
import Data.Typeable
|
||||
|
||||
data Phi = Phi (Chan Message)
|
||||
|
|
@ -24,14 +26,14 @@ data DefaultMessage = Repaint deriving (Typeable, Show)
|
|||
fromMessage :: (Typeable a, Show a) => Message -> Maybe a
|
||||
fromMessage (Message m) = cast m
|
||||
|
||||
initPhi :: IO Phi
|
||||
initPhi = liftM Phi newChan
|
||||
initPhi :: MonadIO m => m Phi
|
||||
initPhi = liftM Phi $ liftIO newChan
|
||||
|
||||
dupPhi :: Phi -> IO Phi
|
||||
dupPhi (Phi chan) = liftM Phi $ dupChan chan
|
||||
dupPhi :: MonadIO m => Phi -> m Phi
|
||||
dupPhi (Phi chan) = liftM Phi $ liftIO $ dupChan chan
|
||||
|
||||
sendMessage :: (Typeable a, Show a) => Phi -> a -> IO ()
|
||||
sendMessage (Phi chan) = writeChan chan . Message
|
||||
sendMessage :: (MonadIO m, Typeable a, Show a) => Phi -> a -> m ()
|
||||
sendMessage (Phi chan) = liftIO . writeChan chan . Message
|
||||
|
||||
receiveMessage :: Phi -> IO Message
|
||||
receiveMessage (Phi chan) = readChan chan
|
||||
receiveMessage :: MonadIO m => Phi -> m Message
|
||||
receiveMessage (Phi chan) = liftIO $ readChan chan
|
||||
|
|
|
|||
|
|
@ -2,6 +2,7 @@
|
|||
|
||||
module Phi.Widget ( Display(..)
|
||||
, withDisplay
|
||||
, getAtoms
|
||||
, Widget(..)
|
||||
, WidgetClass(..)
|
||||
, WidgetState(..)
|
||||
|
|
@ -14,6 +15,7 @@ module Phi.Widget ( Display(..)
|
|||
|
||||
import Control.Concurrent.MVar
|
||||
import Control.Monad
|
||||
import Control.Monad.IO.Class
|
||||
|
||||
import Data.Traversable
|
||||
|
||||
|
|
@ -21,17 +23,21 @@ import qualified Graphics.X11.Xlib
|
|||
import Graphics.Rendering.Cairo
|
||||
|
||||
import Phi.Phi
|
||||
import Phi.X11.Atoms
|
||||
|
||||
|
||||
newtype Display = Display (MVar Graphics.X11.Xlib.Display)
|
||||
data Display = Display (MVar Graphics.X11.Xlib.Display) Atoms
|
||||
|
||||
withDisplay :: Display -> (Graphics.X11.Xlib.Display -> IO a) -> IO a
|
||||
withDisplay (Display dispvar) f = do
|
||||
disp <- takeMVar dispvar
|
||||
withDisplay :: MonadIO m => Display -> (Graphics.X11.Xlib.Display -> m a) -> m a
|
||||
withDisplay (Display dispvar _) f = do
|
||||
disp <- liftIO $ takeMVar dispvar
|
||||
a <- f disp
|
||||
putMVar dispvar disp
|
||||
liftIO $ putMVar dispvar disp
|
||||
return a
|
||||
|
||||
getAtoms :: Display -> Atoms
|
||||
getAtoms (Display _ atoms) = atoms
|
||||
|
||||
|
||||
class Show a => WidgetClass a where
|
||||
type WidgetData a :: *
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
{-# LANGUAGE TypeFamilies #-}
|
||||
{-# LANGUAGE TypeFamilies, DeriveDataTypeable #-}
|
||||
|
||||
module Phi.Widgets.Taskbar ( TaskbarConfig(..)
|
||||
, defaultTaskbarConfig
|
||||
|
|
@ -7,45 +7,225 @@ module Phi.Widgets.Taskbar ( TaskbarConfig(..)
|
|||
|
||||
import Control.Concurrent
|
||||
import Control.Monad
|
||||
import Control.Monad.State
|
||||
import Control.Monad.Trans
|
||||
|
||||
import Data.Char
|
||||
import Data.Maybe
|
||||
import Data.Typeable
|
||||
import Data.Time.LocalTime
|
||||
import Data.Time.Format
|
||||
import qualified Data.Map as M
|
||||
|
||||
import Foreign.C.Types
|
||||
|
||||
import Graphics.Rendering.Cairo
|
||||
|
||||
import Graphics.Rendering.Pango.Cairo
|
||||
import Graphics.Rendering.Pango.Enums (PangoRectangle(..))
|
||||
import Graphics.Rendering.Pango.Layout
|
||||
|
||||
import System.Locale
|
||||
import Graphics.X11.Xlib (Window)
|
||||
import qualified Graphics.X11.Xlib as Xlib
|
||||
import qualified Graphics.X11.Xlib.Extras as XExtras
|
||||
|
||||
import Codec.Binary.UTF8.String
|
||||
|
||||
import Phi.Phi
|
||||
import Phi.Types
|
||||
import Phi.Border
|
||||
import Phi.Widget
|
||||
import Phi.X11.Atoms
|
||||
|
||||
|
||||
data TaskbarConfig = TaskbarConfig deriving Show
|
||||
data TaskbarConfig = TaskbarConfig { taskMaxSize :: !Int
|
||||
, showDesktops :: !Bool
|
||||
, taskBorder :: !BorderConfig
|
||||
, activeTaskBorder :: !BorderConfig
|
||||
} deriving Show
|
||||
|
||||
defaultTaskbarConfig :: TaskbarConfig
|
||||
defaultTaskbarConfig = TaskbarConfig
|
||||
defaultTaskbarConfig = TaskbarConfig { taskMaxSize = 150
|
||||
, showDesktops = False
|
||||
, taskBorder = defaultBorderConfig
|
||||
, activeTaskBorder = defaultBorderConfig { borderColor = (1, 1, 1, 1) }
|
||||
}
|
||||
|
||||
data Taskbar = Taskbar TaskbarConfig deriving Show
|
||||
|
||||
data TaskbarState = TaskbarState deriving Show
|
||||
data TaskbarState = TaskbarState { taskbarActiveWindow :: !Window
|
||||
, taskbarDesktopCount :: !Int
|
||||
, taskbarWindows :: ![Window]
|
||||
, taskbarWindowStates :: !(M.Map Window WindowState)
|
||||
} deriving Show
|
||||
|
||||
data WindowState = WindowState { windowTitle :: !String
|
||||
, windowDesktop :: !Int
|
||||
, windowVisible :: !Bool
|
||||
} deriving (Show, Eq)
|
||||
|
||||
data TaskbarMessage = WindowListUpdate [Xlib.Window] (M.Map Window WindowState)
|
||||
| DesktopCountUpdate Int
|
||||
| ActiveWindowUpdate Window
|
||||
deriving (Show, Typeable)
|
||||
|
||||
instance WidgetClass Taskbar where
|
||||
type WidgetData Taskbar = TaskbarState
|
||||
|
||||
initWidget (Taskbar _) phi dispvar = do
|
||||
return TaskbarState
|
||||
forkIO $ taskbarRunner phi dispvar
|
||||
|
||||
return $ TaskbarState 0 0 [] M.empty
|
||||
|
||||
|
||||
minSize _ = 0
|
||||
weight _ = 1
|
||||
|
||||
render (Taskbar config) _ w h = do
|
||||
return ()
|
||||
render (Taskbar config) TaskbarState {taskbarActiveWindow = activeWindow, taskbarDesktopCount = desktopCount, taskbarWindows = windows, taskbarWindowStates = windowStates} 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
|
||||
drawBorder border (i*windowWidth) 0 windowWidth h
|
||||
|
||||
handleMessage _ priv m = case (fromMessage m) of
|
||||
Just (WindowListUpdate windows windowStates) -> priv {taskbarWindows = windows, taskbarWindowStates = windowStates}
|
||||
Just (DesktopCountUpdate count) -> priv {taskbarDesktopCount = count}
|
||||
Just (ActiveWindowUpdate window) -> priv {taskbarActiveWindow = window}
|
||||
_ -> priv
|
||||
|
||||
|
||||
windowOnDesktop :: Int -> WindowState -> Bool
|
||||
windowOnDesktop desktop state = (windowVisible state) && (desktop == windowDesktop state)
|
||||
|
||||
|
||||
taskbarRunner :: Phi -> Display -> IO ()
|
||||
taskbarRunner phi dispvar = do
|
||||
(windows, tasks) <- liftIO $ withDisplay dispvar $ \disp -> do
|
||||
(windows, tasks) <- getWindowStates disp (getAtoms dispvar) [] M.empty
|
||||
desktopCount <- getDesktopCount disp (getAtoms dispvar)
|
||||
activeWindow <- getActiveWindow disp (getAtoms dispvar)
|
||||
sendMessage phi $ WindowListUpdate windows tasks
|
||||
sendMessage phi $ DesktopCountUpdate desktopCount
|
||||
sendMessage phi $ ActiveWindowUpdate activeWindow
|
||||
return (windows, tasks)
|
||||
sendMessage phi Repaint
|
||||
|
||||
flip evalStateT (windows, tasks) $ forever $ do
|
||||
m <- receiveMessage phi
|
||||
case (fromMessage m) of
|
||||
Just event@XExtras.PropertyEvent {} ->
|
||||
handlePropertyUpdate phi dispvar event
|
||||
_ ->
|
||||
return ()
|
||||
|
||||
handlePropertyUpdate :: Phi -> Display -> XExtras.Event -> StateT ([Window], M.Map Window WindowState) IO ()
|
||||
handlePropertyUpdate phi dispvar XExtras.PropertyEvent {XExtras.ev_atom = atom, XExtras.ev_window = window} = do
|
||||
let atoms = getAtoms dispvar
|
||||
|
||||
when (elem atom $ map ($ atoms) [ atom_NET_ACTIVE_WINDOW
|
||||
, atom_NET_NUMBER_OF_DESKTOPS
|
||||
, atom_NET_CLIENT_LIST
|
||||
, atom_NET_WM_NAME
|
||||
, atomWM_NAME
|
||||
, atom_NET_WM_DESKTOP
|
||||
, atom_NET_WM_STATE
|
||||
]) $ withDisplay dispvar $ \disp -> do
|
||||
let rootwin = Xlib.defaultRootWindow disp
|
||||
if (window == rootwin)
|
||||
then do
|
||||
when (atom == atom_NET_ACTIVE_WINDOW atoms) $ do
|
||||
activeWindow <- liftIO $ getActiveWindow disp atoms
|
||||
sendMessage phi $ ActiveWindowUpdate activeWindow
|
||||
sendMessage phi Repaint
|
||||
when (atom == atom_NET_NUMBER_OF_DESKTOPS atoms) $ do
|
||||
desktopCount <- liftIO $ getDesktopCount disp atoms
|
||||
sendMessage phi $ DesktopCountUpdate desktopCount
|
||||
sendMessage phi Repaint
|
||||
when (atom == atom_NET_CLIENT_LIST atoms) $ do
|
||||
(windows, windowStates) <- get
|
||||
(windows', windowStates') <- liftIO $ getWindowStates disp atoms windows windowStates
|
||||
|
||||
when (windows /= windows' || windowStates /= windowStates') $ do
|
||||
sendMessage phi $ WindowListUpdate windows' windowStates'
|
||||
sendMessage phi Repaint
|
||||
put (windows', windowStates')
|
||||
|
||||
else do
|
||||
(windows, windowStates) <- get
|
||||
when (elem window windows) $ do
|
||||
let windowState = M.lookup window windowStates
|
||||
windowState' <- liftIO $ getWindowState disp atoms window
|
||||
|
||||
when (windowState /= (Just windowState')) $ do
|
||||
let windowStates' = M.insert window windowState' windowStates
|
||||
sendMessage phi $ WindowListUpdate windows windowStates'
|
||||
sendMessage phi Repaint
|
||||
put (windows, windowStates')
|
||||
|
||||
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
|
||||
|
||||
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 -> IO ([Window], M.Map Window WindowState)
|
||||
getWindowStates disp atoms oldWindows windowStates = do
|
||||
windows <- getWindowList disp atoms oldWindows
|
||||
|
||||
let windowStates' = map (\w -> (w, M.lookup w windowStates)) windows
|
||||
|
||||
newWindowStates <- mapM getWindowState' windowStates'
|
||||
|
||||
return (windows, M.fromList newWindowStates)
|
||||
where
|
||||
rootwin = Xlib.defaultRootWindow disp
|
||||
|
||||
getWindowState' (window, Just windowState) = return (window, windowState)
|
||||
getWindowState' (window, Nothing) = do
|
||||
windowState <- getWindowState disp atoms window
|
||||
return (window, windowState)
|
||||
|
||||
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
|
||||
Nothing -> liftM (map unsignedChr . fromMaybe []) $ XExtras.getWindowProperty8 disp (atomWM_NAME atoms) window
|
||||
|
||||
workspace <- liftM (fromIntegral . fromMaybe 0xFFFFFFFF . join . fmap listToMaybe) $ XExtras.getWindowProperty32 disp (atom_NET_WM_DESKTOP atoms) window
|
||||
|
||||
visible <- showWindow disp atoms window
|
||||
|
||||
return $ WindowState wmname workspace visible
|
||||
where
|
||||
unsignedChr = chr . fromIntegral . (fromIntegral :: (CChar -> CUChar))
|
||||
|
||||
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
|
||||
transientForHint <- XExtras.getTransientForHint disp window
|
||||
windowType <- liftM (fromMaybe (atom_NET_WM_WINDOW_TYPE_NORMAL atoms) . fmap fromIntegral . join . fmap listToMaybe) $ XExtras.getWindowProperty32 disp (atom_NET_WM_STATE atoms) window
|
||||
|
||||
return $ not $ or [ elem (atom_NET_WM_STATE_SKIP_TASKBAR atoms) states
|
||||
, transientForHint /= Nothing
|
||||
, elem windowType $ map ($ atoms) [ atom_NET_WM_WINDOW_TYPE_DOCK
|
||||
, atom_NET_WM_WINDOW_TYPE_DESKTOP
|
||||
, atom_NET_WM_WINDOW_TYPE_TOOLBAR
|
||||
, atom_NET_WM_WINDOW_TYPE_MENU
|
||||
, atom_NET_WM_WINDOW_TYPE_SPLASH
|
||||
]
|
||||
]
|
||||
|
||||
|
||||
getWindowList :: Xlib.Display -> Atoms -> [Window] -> IO [Window]
|
||||
getWindowList disp atoms windows = do
|
||||
newWindows <- liftM (map fromIntegral . join . maybeToList) $ XExtras.getWindowProperty32 disp (atom_NET_CLIENT_LIST atoms) $ Xlib.defaultRootWindow disp
|
||||
return $ (filter (flip elem newWindows) windows) ++ (filter (not . flip elem windows) newWindows)
|
||||
|
||||
|
||||
taskbar :: TaskbarConfig -> Widget
|
||||
taskbar config = do
|
||||
|
|
|
|||
|
|
@ -31,6 +31,7 @@ import qualified Phi.Widget as Widget
|
|||
import Phi.X11.Atoms
|
||||
import qualified Phi.Bindings.Util as Util
|
||||
|
||||
|
||||
data XConfig = XConfig { phiXScreenInfo :: !(Display -> IO [Rectangle])
|
||||
}
|
||||
|
||||
|
|
@ -63,13 +64,6 @@ newtype PhiX a = PhiX (StateT PhiState PhiReader a)
|
|||
runPhiX :: PhiConfig -> PhiState -> PhiX a -> IO (a, PhiState)
|
||||
runPhiX config st (PhiX a) = runPhiReader config $ runStateT a st
|
||||
|
||||
withDisplayX :: Widget.Display -> (Display -> PhiX a) -> PhiX a
|
||||
withDisplayX (Widget.Display dispvar) f = do
|
||||
disp <- liftIO $ takeMVar dispvar
|
||||
a <- f disp
|
||||
liftIO $ putMVar dispvar disp
|
||||
return a
|
||||
|
||||
defaultXConfig = XConfig { phiXScreenInfo = getScreenInfo
|
||||
}
|
||||
|
||||
|
|
@ -88,10 +82,11 @@ runPhi xconfig config widgets = do
|
|||
|
||||
screens <- liftIO $ phiXScreenInfo xconfig disp
|
||||
|
||||
dispvar <- liftM Widget.Display $ liftIO $ newMVar disp
|
||||
dispmvar <- liftIO $ newMVar disp
|
||||
let dispvar = Widget.Display dispmvar atoms
|
||||
widgetStates <- liftIO $ mapM (Widget.createWidgetState phi dispvar) widgets
|
||||
|
||||
withDisplayX dispvar $ \disp -> do
|
||||
Widget.withDisplay dispvar $ \disp -> do
|
||||
panels <- mapM (createPanel disp widgetStates) screens
|
||||
|
||||
forM_ panels $ \panel -> do
|
||||
|
|
@ -105,7 +100,7 @@ runPhi xconfig config widgets = do
|
|||
liftIO $ forkIO $ receiveEvents phi dispvar
|
||||
|
||||
forever $ do
|
||||
message <- liftIO $ receiveMessage phi
|
||||
message <- receiveMessage phi
|
||||
handleMessage dispvar message
|
||||
return ()
|
||||
|
||||
|
|
@ -120,13 +115,13 @@ handleMessage dispvar m = do
|
|||
modify $ \state@PhiState {phiPanels = panels} -> state {phiPanels = map (handlePanel m) panels}
|
||||
|
||||
case (fromMessage m) of
|
||||
Just Repaint -> withDisplayX dispvar $ \disp ->
|
||||
Just Repaint -> Widget.withDisplay dispvar $ \disp ->
|
||||
updatePanels disp True
|
||||
_ ->
|
||||
case (fromMessage m) of
|
||||
Just ExposeEvent {} -> withDisplayX dispvar $ \disp ->
|
||||
Just ExposeEvent {} -> Widget.withDisplay dispvar $ \disp ->
|
||||
updatePanels disp False
|
||||
Just event@PropertyEvent {} -> withDisplayX dispvar $ \disp ->
|
||||
Just event@PropertyEvent {} -> Widget.withDisplay dispvar $ \disp ->
|
||||
handlePropertyUpdate disp event
|
||||
_ ->
|
||||
return ()
|
||||
|
|
@ -206,8 +201,8 @@ updateRootImage disp = do
|
|||
let screen = defaultScreen disp
|
||||
visual = defaultVisual disp screen
|
||||
rootwin = defaultRootWindow disp
|
||||
pixmap <- liftM (fromMaybe 0 . listToMaybe . join . catMaybes) $ forM [atom_XROOTPMAP_ID atoms, atom_XROOTMAP_ID atoms] $
|
||||
\atom -> liftIO $ rawGetWindowProperty 32 disp atom rootwin
|
||||
pixmap <- liftM (fromIntegral . fromMaybe 0 . listToMaybe . join . catMaybes) $ forM [atom_XROOTPMAP_ID atoms, atom_XROOTMAP_ID atoms] $
|
||||
\atom -> liftIO $ getWindowProperty32 disp atom rootwin
|
||||
(_, _, _, rootWidth, rootHeight, _, _) <- liftIO $ getGeometry disp rootwin
|
||||
|
||||
-- update surface size
|
||||
|
|
|
|||
|
|
@ -2,9 +2,15 @@ module Phi.X11.AtomList ( atoms
|
|||
) where
|
||||
|
||||
atoms = [ "UTF8_STRING"
|
||||
, "WM_NAME"
|
||||
, "_NET_WM_NAME"
|
||||
, "_NET_WM_WINDOW_TYPE"
|
||||
, "_NET_WM_WINDOW_TYPE_NORMAL"
|
||||
, "_NET_WM_WINDOW_TYPE_DOCK"
|
||||
, "_NET_WM_WINDOW_TYPE_DESKTOP"
|
||||
, "_NET_WM_WINDOW_TYPE_TOOLBAR"
|
||||
, "_NET_WM_WINDOW_TYPE_MENU"
|
||||
, "_NET_WM_WINDOW_TYPE_SPLASH"
|
||||
, "_NET_WM_DESKTOP"
|
||||
, "_NET_WM_STATE"
|
||||
, "_NET_WM_STATE_SKIP_PAGER"
|
||||
|
|
@ -13,6 +19,9 @@ atoms = [ "UTF8_STRING"
|
|||
, "_NET_WM_STATE_BELOW"
|
||||
, "_NET_WM_STRUT"
|
||||
, "_NET_WM_STRUT_PARTIAL"
|
||||
, "_NET_ACTIVE_WINDOW"
|
||||
, "_NET_NUMBER_OF_DESKTOPS"
|
||||
, "_NET_CLIENT_LIST"
|
||||
, "_MOTIF_WM_HINTS"
|
||||
, "_XROOTPMAP_ID"
|
||||
, "_XROOTMAP_ID"
|
||||
|
|
|
|||
|
|
@ -11,7 +11,7 @@ maintainer: mschiffer@universe-factory.net
|
|||
build-type: Simple
|
||||
|
||||
library
|
||||
build-depends: base >= 4, template-haskell, mtl, time, old-locale, X11, cairo, pango
|
||||
build-depends: base >= 4, template-haskell, containers, transformers, mtl, utf8-string, time, old-locale, X11, cairo, pango
|
||||
exposed-modules: Phi.Types, Phi.Phi, Phi.Panel, Phi.Widget, Phi.Border, Phi.X11,
|
||||
Phi.Widgets.Clock, Phi.Widgets.Taskbar
|
||||
other-modules: Phi.X11.Atoms, Phi.X11.AtomList, Phi.Bindings.Util
|
||||
|
|
|
|||
|
|
@ -12,7 +12,9 @@ main = do
|
|||
runPhi defaultXConfig defaultPanelConfig { panelPosition = Bottom }
|
||||
[theTaskbar, brightBorder [theClock]]
|
||||
where
|
||||
theTaskbar = taskbar defaultTaskbarConfig
|
||||
theTaskbar = taskbar defaultTaskbarConfig { taskBorder = BorderConfig (BorderWidth 2 4 2 4) 1 (BorderWidth 0 10 0 10) (0.9, 0.9, 0.9, 0.65) (0.45, 0.45, 0.45, 0.8) 5 0
|
||||
, activeTaskBorder = BorderConfig (BorderWidth 2 4 2 4) 1 (BorderWidth 0 10 0 10) (1, 1, 1, 0.65) (0, 0, 0, 0.8) 5 0
|
||||
}
|
||||
theClock = clock defaultClockConfig { clockFormat = "<span font='Sans 8'>%R</span>\n<span font='Sans 6'>%A %d %B</span>"
|
||||
, lineSpacing = (-2)
|
||||
, clockSize = 75
|
||||
|
|
|
|||
Reference in a new issue