summaryrefslogtreecommitdiffhomepage
diff options
context:
space:
mode:
authorJochen Keil <jochen.keil@gmail.com>2012-08-08 20:24:53 +0200
committerJochen Keil <jochen.keil@gmail.com>2012-08-09 10:41:19 +0200
commita52c4a076807ae04db67894aebd741924ff9f926 (patch)
tree70707de6379dbcb1e4ffa85f092420897ba195d8
parentaa507d0bda3919e1885edb327b855908f2aafcb8 (diff)
downloadxmobar-a52c4a076807ae04db67894aebd741924ff9f926.tar.gz
xmobar-a52c4a076807ae04db67894aebd741924ff9f926.tar.bz2
Modularize Window handling functions
These functions are about creation, positioning and property setting of the xmobar window. An own module does them justice and eases the task of adding functions for revealing/hiding and toggling the window.
-rw-r--r--src/Window.hs137
-rw-r--r--src/Xmobar.hs130
2 files changed, 139 insertions, 128 deletions
diff --git a/src/Window.hs b/src/Window.hs
new file mode 100644
index 0000000..34ecbf4
--- /dev/null
+++ b/src/Window.hs
@@ -0,0 +1,137 @@
+module Window where
+
+import Prelude hiding (catch)
+import Graphics.X11.Xlib hiding (textExtents, textWidth)
+import Graphics.X11.Xlib.Extras
+import Graphics.X11.Xinerama
+
+import Control.Monad.Reader
+import Data.Maybe(fromMaybe)
+import System.Posix.Process (getProcessID)
+
+import Config
+import XUtil
+
+-- $window
+
+-- | The function to create the initial window
+createWin :: Display -> XFont -> Config -> IO (Rectangle,Window)
+createWin d fs c = do
+ let dflt = defaultScreen d
+ srs <- getScreenInfo d
+ rootw <- rootWindow d dflt
+ (as,ds) <- textExtents fs "0"
+ let ht = as + ds + 4
+ (r,o) = setPosition (position c) srs (fi ht)
+ win <- newWindow d (defaultScreenOfDisplay d) rootw r o
+ setProperties r c d win srs
+ when (lowerOnStart c) (lowerWindow d win)
+ mapWindow d win
+ return (r,win)
+
+-- | Updates the size and position of the window
+repositionWin :: Display -> Window -> XFont -> Config -> IO Rectangle
+repositionWin d win fs c = do
+ srs <- getScreenInfo d
+ (as,ds) <- textExtents fs "0"
+ let ht = as + ds + 4
+ (r,_) = setPosition (position c) srs (fi ht)
+ moveResizeWindow d win (rect_x r) (rect_y r) (rect_width r) (rect_height r)
+ setProperties r c d win srs
+ return r
+
+setPosition :: XPosition -> [Rectangle] -> Dimension -> (Rectangle,Bool)
+setPosition p rs ht =
+ case p' of
+ Top -> (Rectangle rx ry rw h, True)
+ TopW a i -> (Rectangle (ax a i) ry (nw i) h, True)
+ TopSize a i ch -> (Rectangle (ax a i) ry (nw i) (mh ch), True)
+ Bottom -> (Rectangle rx ny rw h, True)
+ BottomW a i -> (Rectangle (ax a i) ny (nw i) h, True)
+ BottomSize a i ch -> (Rectangle (ax a i) (ny' ch) (nw i) (mh ch), True)
+ Static cx cy cw ch -> (Rectangle (fi cx) (fi cy) (fi cw) (fi ch), True)
+ OnScreen _ p'' -> setPosition p'' [scr] ht
+ where
+ (scr@(Rectangle rx ry rw rh), p') =
+ case p of OnScreen i x -> (fromMaybe (head rs) $ safeIndex i rs, x)
+ _ -> (head rs, p)
+ ny = ry + fi (rh - ht)
+ center i = rx + fi (div (remwid i) 2)
+ right i = rx + fi (remwid i)
+ remwid i = rw - pw (fi i)
+ ax L = const rx
+ ax R = right
+ ax C = center
+ pw i = rw * min 100 i `div` 100
+ nw = fi . pw . fi
+ h = fi ht
+ mh h' = max (fi h') h
+ ny' h' = ry + fi (rh - mh h')
+ safeIndex i = lookup i . zip [0..]
+
+setProperties :: Rectangle -> Config -> Display -> Window -> [Rectangle] -> IO ()
+setProperties r c d w srs = do
+ a1 <- internAtom d "_NET_WM_STRUT_PARTIAL" False
+ c1 <- internAtom d "CARDINAL" False
+ a2 <- internAtom d "_NET_WM_WINDOW_TYPE" False
+ c2 <- internAtom d "ATOM" False
+ v <- internAtom d "_NET_WM_WINDOW_TYPE_DOCK" False
+ p <- internAtom d "_NET_WM_PID" False
+
+ setTextProperty d w "xmobar" wM_CLASS
+ setTextProperty d w "xmobar" wM_NAME
+
+ changeProperty32 d w a1 c1 propModeReplace $ map fi $
+ getStrutValues r (position c) (getRootWindowHeight srs)
+ changeProperty32 d w a2 c2 propModeReplace [fromIntegral v]
+
+ getProcessID >>= changeProperty32 d w p c1 propModeReplace . return . fromIntegral
+
+getRootWindowHeight :: [Rectangle] -> Int
+getRootWindowHeight srs = maximum (map getMaxScreenYCoord srs)
+ where
+ getMaxScreenYCoord sr = fi (rect_y sr) + fi (rect_height sr)
+
+getStrutValues :: Rectangle -> XPosition -> Int -> [Int]
+getStrutValues r@(Rectangle x y w h) p rwh =
+ case p of
+ OnScreen _ p' -> getStrutValues r p' rwh
+ Top -> [0, 0, st, 0, 0, 0, 0, 0, nx, nw, 0, 0]
+ TopW _ _ -> [0, 0, st, 0, 0, 0, 0, 0, nx, nw, 0, 0]
+ TopSize {} -> [0, 0, st, 0, 0, 0, 0, 0, nx, nw, 0, 0]
+ Bottom -> [0, 0, 0, sb, 0, 0, 0, 0, 0, 0, nx, nw]
+ BottomW _ _ -> [0, 0, 0, sb, 0, 0, 0, 0, 0, 0, nx, nw]
+ BottomSize {} -> [0, 0, 0, sb, 0, 0, 0, 0, 0, 0, nx, nw]
+ Static {} -> getStaticStrutValues p rwh
+ where st = fi y + fi h
+ sb = rwh - fi y
+ nx = fi x
+ nw = fi (x + fi w - 1)
+
+-- get some reaonable strut values for static placement.
+getStaticStrutValues :: XPosition -> Int -> [Int]
+getStaticStrutValues (Static cx cy cw ch) rwh
+ -- if the yPos is in the top half of the screen, then assume a Top
+ -- placement, otherwise, it's a Bottom placement
+ | cy < (rwh `div` 2) = [0, 0, st, 0, 0, 0, 0, 0, xs, xe, 0, 0]
+ | otherwise = [0, 0, 0, sb, 0, 0, 0, 0, 0, 0, xs, xe]
+ where st = cy + ch
+ sb = rwh - cy
+ xs = cx -- a simple calculation for horizontal (x) placement
+ xe = xs + cw
+getStaticStrutValues _ _ = [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]
+
+drawBorder :: Border -> Display -> Drawable -> GC -> Pixel
+ -> Dimension -> Dimension -> IO ()
+drawBorder b d p gc c wi ht = case b of
+ NoBorder -> return ()
+ TopB -> drawBorder (TopBM 0) d p gc c w h
+ BottomB -> drawBorder (BottomBM 0) d p gc c w h
+ FullB -> drawBorder (FullBM 0) d p gc c w h
+ TopBM m -> sf >> drawLine d p gc 0 (fi m) (fi w) 0
+ BottomBM m -> let rw = fi h - fi m in
+ sf >> drawLine d p gc 0 rw (fi w) rw
+ FullBM m -> let pad = 2 * fi m; mp = fi m in
+ sf >> drawRectangle d p gc mp mp (w - pad) (h - pad)
+ where sf = setForeground d gc c
+ (w, h) = (wi - 1, ht - 1)
diff --git a/src/Xmobar.hs b/src/Xmobar.hs
index c348f99..0b744de 100644
--- a/src/Xmobar.hs
+++ b/src/Xmobar.hs
@@ -41,15 +41,13 @@ import Control.Concurrent
import Control.Concurrent.STM
import Control.Exception hiding (handle)
import Data.Bits
-import Data.Maybe(fromMaybe)
-import Data.Typeable (Typeable)
-import System.Posix.Process (getProcessID)
-import System.Posix.Signals
import Config
import Parsers
import Commands
import Runnable
+import Signal
+import Window
import XUtil
-- $main
@@ -197,115 +195,6 @@ startCommand (com,s,ss)
return (Just h,var)
where is = s ++ "Updating..." ++ ss
--- $window
-
--- | The function to create the initial window
-createWin :: Display -> XFont -> Config -> IO (Rectangle,Window)
-createWin d fs c = do
- let dflt = defaultScreen d
- srs <- getScreenInfo d
- rootw <- rootWindow d dflt
- (as,ds) <- textExtents fs "0"
- let ht = as + ds + 4
- (r,o) = setPosition (position c) srs (fi ht)
- win <- newWindow d (defaultScreenOfDisplay d) rootw r o
- setProperties r c d win srs
- when (lowerOnStart c) (lowerWindow d win)
- mapWindow d win
- return (r,win)
-
--- | Updates the size and position of the window
-repositionWin :: Display -> Window -> XFont -> Config -> IO Rectangle
-repositionWin d win fs c = do
- srs <- getScreenInfo d
- (as,ds) <- textExtents fs "0"
- let ht = as + ds + 4
- (r,_) = setPosition (position c) srs (fi ht)
- moveResizeWindow d win (rect_x r) (rect_y r) (rect_width r) (rect_height r)
- setProperties r c d win srs
- return r
-
-setPosition :: XPosition -> [Rectangle] -> Dimension -> (Rectangle,Bool)
-setPosition p rs ht =
- case p' of
- Top -> (Rectangle rx ry rw h, True)
- TopW a i -> (Rectangle (ax a i) ry (nw i) h, True)
- TopSize a i ch -> (Rectangle (ax a i) ry (nw i) (mh ch), True)
- Bottom -> (Rectangle rx ny rw h, True)
- BottomW a i -> (Rectangle (ax a i) ny (nw i) h, True)
- BottomSize a i ch -> (Rectangle (ax a i) (ny' ch) (nw i) (mh ch), True)
- Static cx cy cw ch -> (Rectangle (fi cx) (fi cy) (fi cw) (fi ch), True)
- OnScreen _ p'' -> setPosition p'' [scr] ht
- where
- (scr@(Rectangle rx ry rw rh), p') =
- case p of OnScreen i x -> (fromMaybe (head rs) $ safeIndex i rs, x)
- _ -> (head rs, p)
- ny = ry + fi (rh - ht)
- center i = rx + fi (div (remwid i) 2)
- right i = rx + fi (remwid i)
- remwid i = rw - pw (fi i)
- ax L = const rx
- ax R = right
- ax C = center
- pw i = rw * min 100 i `div` 100
- nw = fi . pw . fi
- h = fi ht
- mh h' = max (fi h') h
- ny' h' = ry + fi (rh - mh h')
- safeIndex i = lookup i . zip [0..]
-
-setProperties :: Rectangle -> Config -> Display -> Window -> [Rectangle] -> IO ()
-setProperties r c d w srs = do
- a1 <- internAtom d "_NET_WM_STRUT_PARTIAL" False
- c1 <- internAtom d "CARDINAL" False
- a2 <- internAtom d "_NET_WM_WINDOW_TYPE" False
- c2 <- internAtom d "ATOM" False
- v <- internAtom d "_NET_WM_WINDOW_TYPE_DOCK" False
- p <- internAtom d "_NET_WM_PID" False
-
- setTextProperty d w "xmobar" wM_CLASS
- setTextProperty d w "xmobar" wM_NAME
-
- changeProperty32 d w a1 c1 propModeReplace $ map fi $
- getStrutValues r (position c) (getRootWindowHeight srs)
- changeProperty32 d w a2 c2 propModeReplace [fromIntegral v]
-
- getProcessID >>= changeProperty32 d w p c1 propModeReplace . return . fromIntegral
-
-getRootWindowHeight :: [Rectangle] -> Int
-getRootWindowHeight srs = maximum (map getMaxScreenYCoord srs)
- where
- getMaxScreenYCoord sr = fi (rect_y sr) + fi (rect_height sr)
-
-getStrutValues :: Rectangle -> XPosition -> Int -> [Int]
-getStrutValues r@(Rectangle x y w h) p rwh =
- case p of
- OnScreen _ p' -> getStrutValues r p' rwh
- Top -> [0, 0, st, 0, 0, 0, 0, 0, nx, nw, 0, 0]
- TopW _ _ -> [0, 0, st, 0, 0, 0, 0, 0, nx, nw, 0, 0]
- TopSize {} -> [0, 0, st, 0, 0, 0, 0, 0, nx, nw, 0, 0]
- Bottom -> [0, 0, 0, sb, 0, 0, 0, 0, 0, 0, nx, nw]
- BottomW _ _ -> [0, 0, 0, sb, 0, 0, 0, 0, 0, 0, nx, nw]
- BottomSize {} -> [0, 0, 0, sb, 0, 0, 0, 0, 0, 0, nx, nw]
- Static {} -> getStaticStrutValues p rwh
- where st = fi y + fi h
- sb = rwh - fi y
- nx = fi x
- nw = fi (x + fi w - 1)
-
--- get some reaonable strut values for static placement.
-getStaticStrutValues :: XPosition -> Int -> [Int]
-getStaticStrutValues (Static cx cy cw ch) rwh
- -- if the yPos is in the top half of the screen, then assume a Top
- -- placement, otherwise, it's a Bottom placement
- | cy < (rwh `div` 2) = [0, 0, st, 0, 0, 0, 0, 0, xs, xe, 0, 0]
- | otherwise = [0, 0, 0, sb, 0, 0, 0, 0, 0, 0, xs, xe]
- where st = cy + ch
- sb = rwh - cy
- xs = cx -- a simple calculation for horizontal (x) placement
- xe = xs + cw
-getStaticStrutValues _ _ = [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]
-
updateWin :: TVar [String] -> X ()
updateWin v = do
xc <- ask
@@ -346,21 +235,6 @@ drawInWin (Rectangle _ _ wid ht) ~[left,center,right] = do
-- resync
io $ sync d True
-drawBorder :: Border -> Display -> Drawable -> GC -> Pixel
- -> Dimension -> Dimension -> IO ()
-drawBorder b d p gc c wi ht = case b of
- NoBorder -> return ()
- TopB -> drawBorder (TopBM 0) d p gc c w h
- BottomB -> drawBorder (BottomBM 0) d p gc c w h
- FullB -> drawBorder (FullBM 0) d p gc c w h
- TopBM m -> sf >> drawLine d p gc 0 (fi m) (fi w) 0
- BottomBM m -> let rw = fi h - fi m in
- sf >> drawLine d p gc 0 rw (fi w) rw
- FullBM m -> let pad = 2 * fi m; mp = fi m in
- sf >> drawRectangle d p gc mp mp (w - pad) (h - pad)
- where sf = setForeground d gc c
- (w, h) = (wi - 1, ht - 1)
-
-- | An easy way to print the stuff we need to print
printStrings :: Drawable -> GC -> XFont -> Position
-> Align -> [(String, String, Position)] -> X ()