-----------------------------------------------------------------------------
-- |
-- Module      :  Window
-- Copyright   :  (c) 2011-18 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 Xmobar.X11.Window where

import Prelude
import Control.Applicative ((<$>))
import Control.Monad (when, unless)
import Graphics.X11.Xlib hiding (textExtents)
import Graphics.X11.Xlib.Extras
import Graphics.X11.Xinerama
import Foreign.C.Types (CLong)

import Data.Function (on)
import Data.List (maximumBy)
import Data.Maybe (fromMaybe)
import System.Posix.Process (getProcessID)

import Xmobar.Config.Types
import Xmobar.X11.Text

-- $window

-- | Creates a window with the attribute override_redirect set to True.
-- Windows Managers should not touch this kind of windows.
newWindow :: Display -> Screen -> Window -> Rectangle -> Bool -> IO Window
newWindow :: Display -> Screen -> Window -> Rectangle -> Bool -> IO Window
newWindow dpy :: Display
dpy scr :: Screen
scr rw :: Window
rw (Rectangle x :: Position
x y :: Position
y w :: Window
w h :: Window
h) o :: Bool
o = do
  let visual :: Visual
visual = Screen -> Visual
defaultVisualOfScreen Screen
scr
      attrmask :: Window
attrmask = if Bool
o then Window
cWOverrideRedirect else 0
  (Ptr SetWindowAttributes -> IO Window) -> IO Window
forall a. (Ptr SetWindowAttributes -> IO a) -> IO a
allocaSetWindowAttributes ((Ptr SetWindowAttributes -> IO Window) -> IO Window)
-> (Ptr SetWindowAttributes -> IO Window) -> IO Window
forall a b. (a -> b) -> a -> b
$
         \attributes :: Ptr SetWindowAttributes
attributes -> do
           Ptr SetWindowAttributes -> Bool -> IO ()
set_override_redirect Ptr SetWindowAttributes
attributes Bool
o
           Display
-> Window
-> Position
-> Position
-> Window
-> Window
-> CInt
-> CInt
-> CInt
-> Visual
-> Window
-> Ptr SetWindowAttributes
-> IO Window
createWindow Display
dpy Window
rw Position
x Position
y Window
w Window
h 0 (Screen -> CInt
defaultDepthOfScreen Screen
scr)
                        CInt
inputOutput Visual
visual Window
attrmask Ptr SetWindowAttributes
attributes

-- | The function to create the initial window
createWin :: Display -> XFont -> Config -> IO (Rectangle,Window)
createWin :: Display -> XFont -> Config -> IO (Rectangle, Window)
createWin d :: Display
d fs :: XFont
fs c :: Config
c = do
  let dflt :: Window
dflt = Display -> Window
defaultScreen Display
d
  [Rectangle]
srs <- Display -> IO [Rectangle]
getScreenInfo Display
d
  Window
rootw <- Display -> Window -> IO Window
rootWindow Display
d Window
dflt
  (as :: Position
as,ds :: Position
ds) <- XFont -> String -> IO (Position, Position)
textExtents XFont
fs "0"
  let ht :: Position
ht = Position
as Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Position
ds Position -> Position -> Position
forall a. Num a => a -> a -> a
+ 4
      r :: Rectangle
r = Config -> XPosition -> [Rectangle] -> Window -> Rectangle
setPosition Config
c (Config -> XPosition
position Config
c) [Rectangle]
srs (Position -> Window
forall a b. (Integral a, Num b) => a -> b
fromIntegral Position
ht)
  Window
win <- Display -> Screen -> Window -> Rectangle -> Bool -> IO Window
newWindow  Display
d (Display -> Screen
defaultScreenOfDisplay Display
d) Window
rootw Rectangle
r (Config -> Bool
overrideRedirect Config
c)
  Config -> Display -> Window -> IO ()
setProperties Config
c Display
d Window
win
  Rectangle -> Config -> Display -> Window -> [Rectangle] -> IO ()
setStruts Rectangle
r Config
c Display
d Window
win [Rectangle]
srs
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Config -> Bool
lowerOnStart Config
c) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Display -> Window -> IO ()
lowerWindow Display
d Window
win
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Config -> Bool
hideOnStart Config
c) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Rectangle -> Config -> Display -> Window -> IO ()
showWindow Rectangle
r Config
c Display
d Window
win
  (Rectangle, Window) -> IO (Rectangle, Window)
forall (m :: * -> *) a. Monad m => a -> m a
return (Rectangle
r,Window
win)

-- | Updates the size and position of the window
repositionWin :: Display -> Window -> XFont -> Config -> IO Rectangle
repositionWin :: Display -> Window -> XFont -> Config -> IO Rectangle
repositionWin d :: Display
d win :: Window
win fs :: XFont
fs c :: Config
c = do
  [Rectangle]
srs <- Display -> IO [Rectangle]
getScreenInfo Display
d
  (as :: Position
as,ds :: Position
ds) <- XFont -> String -> IO (Position, Position)
textExtents XFont
fs "0"
  let ht :: Position
ht = Position
as Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Position
ds Position -> Position -> Position
forall a. Num a => a -> a -> a
+ 4
      r :: Rectangle
r = Config -> XPosition -> [Rectangle] -> Window -> Rectangle
setPosition Config
c (Config -> XPosition
position Config
c) [Rectangle]
srs (Position -> Window
forall a b. (Integral a, Num b) => a -> b
fromIntegral Position
ht)
  Display
-> Window -> Position -> Position -> Window -> Window -> IO ()
moveResizeWindow Display
d Window
win (Rectangle -> Position
rect_x Rectangle
r) (Rectangle -> Position
rect_y Rectangle
r) (Rectangle -> Window
rect_width Rectangle
r) (Rectangle -> Window
rect_height Rectangle
r)
  Rectangle -> Config -> Display -> Window -> [Rectangle] -> IO ()
setStruts Rectangle
r Config
c Display
d Window
win [Rectangle]
srs
  Rectangle -> IO Rectangle
forall (m :: * -> *) a. Monad m => a -> m a
return Rectangle
r

fi :: (Integral a, Num b) => a -> b
fi :: a -> b
fi = a -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral

setPosition :: Config -> XPosition -> [Rectangle] -> Dimension -> Rectangle
setPosition :: Config -> XPosition -> [Rectangle] -> Window -> Rectangle
setPosition c :: Config
c p :: XPosition
p rs :: [Rectangle]
rs ht :: Window
ht =
  case XPosition
p' of
    Top -> Position -> Position -> Window -> Window -> Rectangle
Rectangle Position
rx Position
ry Window
rw Window
h
    TopP l :: Int
l r :: Int
r -> Position -> Position -> Window -> Window -> Rectangle
Rectangle (Position
rx Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Int -> Position
forall a b. (Integral a, Num b) => a -> b
fi Int
l) Position
ry (Window
rw Window -> Window -> Window
forall a. Num a => a -> a -> a
- Int -> Window
forall a b. (Integral a, Num b) => a -> b
fi Int
l Window -> Window -> Window
forall a. Num a => a -> a -> a
- Int -> Window
forall a b. (Integral a, Num b) => a -> b
fi Int
r) Window
h
    TopW a :: Align
a i :: Int
i -> Position -> Position -> Window -> Window -> Rectangle
Rectangle (Align -> Int -> Position
forall b. Integral b => Align -> b -> Position
ax Align
a Int
i) Position
ry (Int -> Window
nw Int
i) Window
h
    TopSize a :: Align
a i :: Int
i ch :: Int
ch -> Position -> Position -> Window -> Window -> Rectangle
Rectangle (Align -> Int -> Position
forall b. Integral b => Align -> b -> Position
ax Align
a Int
i) Position
ry (Int -> Window
nw Int
i) (Int -> Window
forall a. Integral a => a -> Window
mh Int
ch)
    Bottom -> Position -> Position -> Window -> Window -> Rectangle
Rectangle Position
rx Position
ny Window
rw Window
h
    BottomW a :: Align
a i :: Int
i -> Position -> Position -> Window -> Window -> Rectangle
Rectangle (Align -> Int -> Position
forall b. Integral b => Align -> b -> Position
ax Align
a Int
i) Position
ny (Int -> Window
nw Int
i) Window
h
    BottomP l :: Int
l r :: Int
r -> Position -> Position -> Window -> Window -> Rectangle
Rectangle (Position
rx Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Int -> Position
forall a b. (Integral a, Num b) => a -> b
fi Int
l) Position
ny (Window
rw Window -> Window -> Window
forall a. Num a => a -> a -> a
- Int -> Window
forall a b. (Integral a, Num b) => a -> b
fi Int
l Window -> Window -> Window
forall a. Num a => a -> a -> a
- Int -> Window
forall a b. (Integral a, Num b) => a -> b
fi Int
r) Window
h
    BottomSize a :: Align
a i :: Int
i ch :: Int
ch  -> Position -> Position -> Window -> Window -> Rectangle
Rectangle (Align -> Int -> Position
forall b. Integral b => Align -> b -> Position
ax Align
a Int
i) (Int -> Position
forall a. Integral a => a -> Position
ny' Int
ch) (Int -> Window
nw Int
i) (Int -> Window
forall a. Integral a => a -> Window
mh Int
ch)
    Static cx :: Int
cx cy :: Int
cy cw :: Int
cw ch :: Int
ch -> Position -> Position -> Window -> Window -> Rectangle
Rectangle (Int -> Position
forall a b. (Integral a, Num b) => a -> b
fi Int
cx) (Int -> Position
forall a b. (Integral a, Num b) => a -> b
fi Int
cy) (Int -> Window
forall a b. (Integral a, Num b) => a -> b
fi Int
cw) (Int -> Window
forall a b. (Integral a, Num b) => a -> b
fi Int
ch)
    OnScreen _ p'' :: XPosition
p'' -> Config -> XPosition -> [Rectangle] -> Window -> Rectangle
setPosition Config
c XPosition
p'' [Rectangle
scr] Window
ht
  where
    (scr :: Rectangle
scr@(Rectangle rx :: Position
rx ry :: Position
ry rw :: Window
rw rh :: Window
rh), p' :: XPosition
p') =
      case XPosition
p of OnScreen i :: Int
i x :: XPosition
x -> (Rectangle -> Maybe Rectangle -> Rectangle
forall a. a -> Maybe a -> a
fromMaybe ([Rectangle] -> Rectangle
picker [Rectangle]
rs) (Maybe Rectangle -> Rectangle) -> Maybe Rectangle -> Rectangle
forall a b. (a -> b) -> a -> b
$ Int -> [Rectangle] -> Maybe Rectangle
forall a b. (Eq a, Num a, Enum a) => a -> [b] -> Maybe b
safeIndex Int
i [Rectangle]
rs, XPosition
x)
                _ -> ([Rectangle] -> Rectangle
picker [Rectangle]
rs, XPosition
p)
    ny :: Position
ny = Position
ry Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Window -> Position
forall a b. (Integral a, Num b) => a -> b
fi (Window
rh Window -> Window -> Window
forall a. Num a => a -> a -> a
- Window
ht)
    center :: a -> Position
center i :: a
i = Position
rx Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Window -> Position
forall a b. (Integral a, Num b) => a -> b
fi (Window -> Window -> Window
forall a. Integral a => a -> a -> a
div (a -> Window
forall a. Integral a => a -> Window
remwid a
i) 2)
    right :: a -> Position
right  i :: a
i = Position
rx Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Window -> Position
forall a b. (Integral a, Num b) => a -> b
fi (a -> Window
forall a. Integral a => a -> Window
remwid a
i)
    remwid :: a -> Window
remwid i :: a
i = Window
rw Window -> Window -> Window
forall a. Num a => a -> a -> a
- Window -> Window
pw (a -> Window
forall a b. (Integral a, Num b) => a -> b
fi a
i)
    ax :: Align -> b -> Position
ax L = Position -> b -> Position
forall a b. a -> b -> a
const Position
rx
    ax R = b -> Position
forall a. Integral a => a -> Position
right
    ax C = b -> Position
forall a. Integral a => a -> Position
center
    pw :: Window -> Window
pw i :: Window
i = Window
rw Window -> Window -> Window
forall a. Num a => a -> a -> a
* Window -> Window -> Window
forall a. Ord a => a -> a -> a
min 100 Window
i Window -> Window -> Window
forall a. Integral a => a -> a -> a
`div` 100
    nw :: Int -> Window
nw = Window -> Window
forall a b. (Integral a, Num b) => a -> b
fi (Window -> Window) -> (Int -> Window) -> Int -> Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window -> Window
pw (Window -> Window) -> (Int -> Window) -> Int -> Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Window
forall a b. (Integral a, Num b) => a -> b
fi
    h :: Window
h = Window -> Window
forall a b. (Integral a, Num b) => a -> b
fi Window
ht
    mh :: a -> Window
mh h' :: a
h' = Window -> Window -> Window
forall a. Ord a => a -> a -> a
max (a -> Window
forall a b. (Integral a, Num b) => a -> b
fi a
h') Window
h
    ny' :: a -> Position
ny' h' :: a
h' = Position
ry Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Window -> Position
forall a b. (Integral a, Num b) => a -> b
fi (Window
rh Window -> Window -> Window
forall a. Num a => a -> a -> a
- a -> Window
forall a. Integral a => a -> Window
mh a
h')
    safeIndex :: a -> [b] -> Maybe b
safeIndex i :: a
i = a -> [(a, b)] -> Maybe b
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup a
i ([(a, b)] -> Maybe b) -> ([b] -> [(a, b)]) -> [b] -> Maybe b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [b] -> [(a, b)]
forall a b. [a] -> [b] -> [(a, b)]
zip [0..]
    picker :: [Rectangle] -> Rectangle
picker = if Config -> Bool
pickBroadest Config
c
             then (Rectangle -> Rectangle -> Ordering) -> [Rectangle] -> Rectangle
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy (Window -> Window -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Window -> Window -> Ordering)
-> (Rectangle -> Window) -> Rectangle -> Rectangle -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Rectangle -> Window
rect_width)
             else [Rectangle] -> Rectangle
forall a. [a] -> a
head

setProperties :: Config -> Display -> Window -> IO ()
setProperties :: Config -> Display -> Window -> IO ()
setProperties c :: Config
c d :: Display
d w :: Window
w = do
  let mkatom :: String -> IO Window
mkatom n :: String
n = Display -> String -> Bool -> IO Window
internAtom Display
d String
n Bool
False
  Window
card <- String -> IO Window
mkatom "CARDINAL"
  Window
atom <- String -> IO Window
mkatom "ATOM"

  Display -> Window -> String -> Window -> IO ()
setTextProperty Display
d Window
w (Config -> String
wmClass Config
c) Window
wM_CLASS
  Display -> Window -> String -> Window -> IO ()
setTextProperty Display
d Window
w (Config -> String
wmName Config
c) Window
wM_NAME

  Window
wtype <- String -> IO Window
mkatom "_NET_WM_WINDOW_TYPE"
  Window
dock <- String -> IO Window
mkatom "_NET_WM_WINDOW_TYPE_DOCK"
  Display -> Window -> Window -> Window -> CInt -> [CLong] -> IO ()
changeProperty32 Display
d Window
w Window
wtype Window
atom CInt
propModeReplace [Window -> CLong
forall a b. (Integral a, Num b) => a -> b
fi Window
dock]

  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Config -> Bool
allDesktops Config
c) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    Window
desktop <- String -> IO Window
mkatom "_NET_WM_DESKTOP"
    Display -> Window -> Window -> Window -> CInt -> [CLong] -> IO ()
changeProperty32 Display
d Window
w Window
desktop Window
card CInt
propModeReplace [0xffffffff]

  Window
pid  <- String -> IO Window
mkatom "_NET_WM_PID"
  IO ProcessID
getProcessID IO ProcessID -> (ProcessID -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Display -> Window -> Window -> Window -> CInt -> [CLong] -> IO ()
changeProperty32 Display
d Window
w Window
pid Window
card CInt
propModeReplace ([CLong] -> IO ()) -> (ProcessID -> [CLong]) -> ProcessID -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CLong -> [CLong]
forall (m :: * -> *) a. Monad m => a -> m a
return (CLong -> [CLong]) -> (ProcessID -> CLong) -> ProcessID -> [CLong]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProcessID -> CLong
forall a b. (Integral a, Num b) => a -> b
fi

setStruts' :: Display -> Window -> [Foreign.C.Types.CLong] -> IO ()
setStruts' :: Display -> Window -> [CLong] -> IO ()
setStruts' d :: Display
d w :: Window
w svs :: [CLong]
svs = do
  let mkatom :: String -> IO Window
mkatom n :: String
n = Display -> String -> Bool -> IO Window
internAtom Display
d String
n Bool
False
  Window
card <- String -> IO Window
mkatom "CARDINAL"
  Window
pstrut <- String -> IO Window
mkatom "_NET_WM_STRUT_PARTIAL"
  Window
strut <- String -> IO Window
mkatom "_NET_WM_STRUT"
  Display -> Window -> Window -> Window -> CInt -> [CLong] -> IO ()
changeProperty32 Display
d Window
w Window
pstrut Window
card CInt
propModeReplace [CLong]
svs
  Display -> Window -> Window -> Window -> CInt -> [CLong] -> IO ()
changeProperty32 Display
d Window
w Window
strut Window
card CInt
propModeReplace (Int -> [CLong] -> [CLong]
forall a. Int -> [a] -> [a]
take 4 [CLong]
svs)

setStruts :: Rectangle -> Config -> Display -> Window -> [Rectangle] -> IO ()
setStruts :: Rectangle -> Config -> Display -> Window -> [Rectangle] -> IO ()
setStruts r :: Rectangle
r c :: Config
c d :: Display
d w :: Window
w rs :: [Rectangle]
rs = do
  let svs :: [CLong]
svs = (Int -> CLong) -> [Int] -> [CLong]
forall a b. (a -> b) -> [a] -> [b]
map Int -> CLong
forall a b. (Integral a, Num b) => a -> b
fi ([Int] -> [CLong]) -> [Int] -> [CLong]
forall a b. (a -> b) -> a -> b
$ Rectangle -> XPosition -> Int -> [Int]
getStrutValues Rectangle
r (Config -> XPosition
position Config
c) ([Rectangle] -> Int
getRootWindowHeight [Rectangle]
rs)
  Display -> Window -> [CLong] -> IO ()
setStruts' Display
d Window
w [CLong]
svs

getRootWindowHeight :: [Rectangle] -> Int
getRootWindowHeight :: [Rectangle] -> Int
getRootWindowHeight srs :: [Rectangle]
srs = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ((Rectangle -> Int) -> [Rectangle] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Rectangle -> Int
forall a. Num a => Rectangle -> a
getMaxScreenYCoord [Rectangle]
srs)
  where
    getMaxScreenYCoord :: Rectangle -> a
getMaxScreenYCoord sr :: Rectangle
sr = Position -> a
forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> Position
rect_y Rectangle
sr) a -> a -> a
forall a. Num a => a -> a -> a
+ Window -> a
forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> Window
rect_height Rectangle
sr)

getStrutValues :: Rectangle -> XPosition -> Int -> [Int]
getStrutValues :: Rectangle -> XPosition -> Int -> [Int]
getStrutValues r :: Rectangle
r@(Rectangle x :: Position
x y :: Position
y w :: Window
w h :: Window
h) p :: XPosition
p rwh :: Int
rwh =
  case XPosition
p of
    OnScreen _ p' :: XPosition
p'   -> Rectangle -> XPosition -> Int -> [Int]
getStrutValues Rectangle
r XPosition
p' Int
rwh
    Top             -> [0, 0, Int
st,  0, 0, 0, 0, 0, Int
nx, Int
nw,  0,  0]
    TopP    _ _     -> [0, 0, Int
st,  0, 0, 0, 0, 0, Int
nx, Int
nw,  0,  0]
    TopW    _ _     -> [0, 0, Int
st,  0, 0, 0, 0, 0, Int
nx, Int
nw,  0,  0]
    TopSize      {} -> [0, 0, Int
st,  0, 0, 0, 0, 0, Int
nx, Int
nw,  0,  0]
    Bottom          -> [0, 0,  0, Int
sb, 0, 0, 0, 0,  0,  0, Int
nx, Int
nw]
    BottomP _ _     -> [0, 0,  0, Int
sb, 0, 0, 0, 0,  0,  0, Int
nx, Int
nw]
    BottomW _ _     -> [0, 0,  0, Int
sb, 0, 0, 0, 0,  0,  0, Int
nx, Int
nw]
    BottomSize   {} -> [0, 0,  0, Int
sb, 0, 0, 0, 0,  0,  0, Int
nx, Int
nw]
    Static       {} -> XPosition -> Int -> [Int]
getStaticStrutValues XPosition
p Int
rwh
  where st :: Int
st = Position -> Int
forall a b. (Integral a, Num b) => a -> b
fi Position
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Window -> Int
forall a b. (Integral a, Num b) => a -> b
fi Window
h
        sb :: Int
sb = Int
rwh Int -> Int -> Int
forall a. Num a => a -> a -> a
- Position -> Int
forall a b. (Integral a, Num b) => a -> b
fi Position
y
        nx :: Int
nx = Position -> Int
forall a b. (Integral a, Num b) => a -> b
fi Position
x
        nw :: Int
nw = Position -> Int
forall a b. (Integral a, Num b) => a -> b
fi (Position
x Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Window -> Position
forall a b. (Integral a, Num b) => a -> b
fi Window
w Position -> Position -> Position
forall a. Num a => a -> a -> a
- 1)

-- get some reaonable strut values for static placement.
getStaticStrutValues :: XPosition -> Int -> [Int]
getStaticStrutValues :: XPosition -> Int -> [Int]
getStaticStrutValues (Static cx :: Int
cx cy :: Int
cy cw :: Int
cw ch :: Int
ch) rwh :: Int
rwh
    -- if the yPos is in the top half of the screen, then assume a Top
    -- placement, otherwise, it's a Bottom placement
    | Int
cy Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< (Int
rwh Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 2) = [0, 0, Int
st,  0, 0, 0, 0, 0, Int
xs, Int
xe,  0,  0]
    | Bool
otherwise = [0, 0,  0, Int
sb, 0, 0, 0, 0,  0,  0, Int
xs, Int
xe]
    where st :: Int
st = Int
cy Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ch
          sb :: Int
sb = Int
rwh Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
cy
          xs :: Int
xs = Int
cx -- a simple calculation for horizontal (x) placement
          xe :: Int
xe = Int
xs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
cw
getStaticStrutValues _ _ = [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]

drawBorder :: Border -> Int -> Display -> Drawable -> GC -> Pixel
              -> Dimension -> Dimension -> IO ()
drawBorder :: Border
-> Int
-> Display
-> Window
-> GC
-> Window
-> Window
-> Window
-> IO ()
drawBorder b :: Border
b lw :: Int
lw d :: Display
d p :: Window
p gc :: GC
gc c :: Window
c wi :: Window
wi ht :: Window
ht =  case Border
b of
  NoBorder -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  TopB       -> Border
-> Int
-> Display
-> Window
-> GC
-> Window
-> Window
-> Window
-> IO ()
drawBorder (Int -> Border
TopBM 0) Int
lw Display
d Window
p GC
gc Window
c Window
wi Window
ht
  BottomB    -> Border
-> Int
-> Display
-> Window
-> GC
-> Window
-> Window
-> Window
-> IO ()
drawBorder (Int -> Border
BottomBM 0) Int
lw Display
d Window
p GC
gc Window
c Window
wi Window
ht
  FullB      -> Border
-> Int
-> Display
-> Window
-> GC
-> Window
-> Window
-> Window
-> IO ()
drawBorder (Int -> Border
FullBM 0) Int
lw Display
d Window
p GC
gc Window
c Window
wi Window
ht
  TopBM m :: Int
m    -> IO ()
sf IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
sla IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                 Display
-> Window
-> GC
-> Position
-> Position
-> Position
-> Position
-> IO ()
drawLine Display
d Window
p GC
gc 0 (Int -> Position
forall a b. (Integral a, Num b) => a -> b
fi Int
m Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Position
boff) (Window -> Position
forall a b. (Integral a, Num b) => a -> b
fi Window
wi) (Int -> Position
forall a b. (Integral a, Num b) => a -> b
fi Int
m Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Position
boff)
  BottomBM m :: Int
m -> let rw :: Position
rw = Window -> Position
forall a b. (Integral a, Num b) => a -> b
fi Window
ht Position -> Position -> Position
forall a. Num a => a -> a -> a
- Int -> Position
forall a b. (Integral a, Num b) => a -> b
fi Int
m Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Position
boff in
                 IO ()
sf IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
sla IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Display
-> Window
-> GC
-> Position
-> Position
-> Position
-> Position
-> IO ()
drawLine Display
d Window
p GC
gc 0 Position
rw (Window -> Position
forall a b. (Integral a, Num b) => a -> b
fi Window
wi) Position
rw
  FullBM m :: Int
m   -> let mp :: Position
mp = Int -> Position
forall a b. (Integral a, Num b) => a -> b
fi Int
m
                    pad :: Window
pad = 2 Window -> Window -> Window
forall a. Num a => a -> a -> a
* Position -> Window
forall a b. (Integral a, Num b) => a -> b
fi Position
mp Window -> Window -> Window
forall a. Num a => a -> a -> a
+  Int -> Window
forall a b. (Integral a, Num b) => a -> b
fi Int
lw
                in IO ()
sf IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
sla IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                     Display
-> Window
-> GC
-> Position
-> Position
-> Window
-> Window
-> IO ()
drawRectangle Display
d Window
p GC
gc Position
mp Position
mp (Window
wi Window -> Window -> Window
forall a. Num a => a -> a -> a
- Window
pad) (Window
ht Window -> Window -> Window
forall a. Num a => a -> a -> a
- Window
pad)
  where sf :: IO ()
sf    = Display -> GC -> Window -> IO ()
setForeground Display
d GC
gc Window
c
        sla :: IO ()
sla   = Display -> GC -> CInt -> CInt -> CInt -> CInt -> IO ()
setLineAttributes Display
d GC
gc (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fi Int
lw) CInt
lineSolid CInt
capNotLast CInt
joinMiter
        boff :: Position
boff  = Border -> Int -> Position
forall a. Integral a => Border -> Int -> a
borderOffset Border
b Int
lw
--        boff' = calcBorderOffset lw :: Int

hideWindow :: Display -> Window -> IO ()
hideWindow :: Display -> Window -> IO ()
hideWindow d :: Display
d w :: Window
w = do
    Display -> Window -> [CLong] -> IO ()
setStruts' Display
d Window
w (Int -> CLong -> [CLong]
forall a. Int -> a -> [a]
replicate 12 0)
    Display -> Window -> IO ()
unmapWindow Display
d Window
w IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Display -> Bool -> IO ()
sync Display
d Bool
False

showWindow :: Rectangle -> Config -> Display -> Window -> IO ()
showWindow :: Rectangle -> Config -> Display -> Window -> IO ()
showWindow r :: Rectangle
r c :: Config
c d :: Display
d w :: Window
w = do
    Display -> Window -> IO ()
mapWindow Display
d Window
w
    Display -> IO [Rectangle]
getScreenInfo Display
d IO [Rectangle] -> ([Rectangle] -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Rectangle -> Config -> Display -> Window -> [Rectangle] -> IO ()
setStruts Rectangle
r Config
c Display
d Window
w
    Display -> Bool -> IO ()
sync Display
d Bool
False

isMapped :: Display -> Window -> IO Bool
isMapped :: Display -> Window -> IO Bool
isMapped d :: Display
d w :: Window
w = WindowAttributes -> Bool
ism (WindowAttributes -> Bool) -> IO WindowAttributes -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Display -> Window -> IO WindowAttributes
getWindowAttributes Display
d Window
w
    where ism :: WindowAttributes -> Bool
ism WindowAttributes { wa_map_state :: WindowAttributes -> CInt
wa_map_state = CInt
wms } = CInt
wms CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
waIsUnmapped

borderOffset :: (Integral a) => Border -> Int -> a
borderOffset :: Border -> Int -> a
borderOffset b :: Border
b lw :: Int
lw =
  case Border
b of
    BottomB    -> a -> a
forall a. Num a => a -> a
negate a
boffs
    BottomBM _ -> a -> a
forall a. Num a => a -> a
negate a
boffs
    TopB       -> a
boffs
    TopBM _    -> a
boffs
    _          -> 0
  where boffs :: a
boffs = Int -> a
forall a. Integral a => Int -> a
calcBorderOffset Int
lw

calcBorderOffset :: (Integral a) => Int -> a
calcBorderOffset :: Int -> a
calcBorderOffset = Double -> a
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Double -> a) -> (Int -> Double) -> Int -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/2) (Double -> Double) -> (Int -> Double) -> Int -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Double
toDouble
  where toDouble :: Int -> Double
toDouble = forall a. Integral a => a -> Double
forall a b. (Integral a, Num b) => a -> b
fi :: (Integral a) => a -> Double