summaryrefslogtreecommitdiffhomepage
diff options
context:
space:
mode:
-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 ()