xmobar-0.16: src/Window.hs
-----------------------------------------------------------------------------
-- |
-- Module : Window
-- Copyright : (c) 2011-12 Jose A. Ortega Ruiz
-- : (c) 2012 Jochen Keil
-- License : BSD-style (see LICENSE)
--
-- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org>
-- Stability : unstable
-- Portability : unportable
--
-- Window manipulation functions
--
-----------------------------------------------------------------------------
module Window where
import Prelude
import Control.Monad (when)
import Graphics.X11.Xlib hiding (textExtents, textWidth)
import Graphics.X11.Xlib.Extras
import Graphics.X11.Xinerama
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)
when (not $ hideOnStart c) $ 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
ismapped <- isMapped d w
changeProperty32 d w a1 c1 propModeReplace $
if ismapped
then map fi $ getStrutValues r (position c) (getRootWindowHeight srs)
else replicate 12 0
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)
hideWindow :: Display -> Window -> IO ()
hideWindow d w = do
a <- internAtom d "_NET_WM_STRUT_PARTIAL" False
c <- internAtom d "CARDINAL" False
changeProperty32 d w a c propModeReplace $ replicate 12 0
unmapWindow d w >> sync d False
showWindow :: Rectangle -> Config -> Display -> Window -> IO ()
showWindow r cfg d w = do
srs <- getScreenInfo d
a <- internAtom d "_NET_WM_STRUT_PARTIAL" False
c <- internAtom d "CARDINAL" False
changeProperty32 d w a c propModeReplace $ map fi $
getStrutValues r (position cfg) (getRootWindowHeight srs)
mapWindow d w >> sync d False
isMapped :: Display -> Window -> IO Bool
isMapped d w = fmap ism $ getWindowAttributes d w
where ism (WindowAttributes { wa_map_state = wms }) = wms /= waIsUnmapped