-----------------------------------------------------------------------------
-- |
-- Module      :  Window
-- Copyright   :  (c) 2011-18, 20, 21 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.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 Display
dpy Screen
scr Window
rw (Rectangle Position
x Position
y Dimension
w Dimension
h) Bool
o = do
  let visual :: Visual
visual = Screen -> Visual
defaultVisualOfScreen Screen
scr
      attrmask :: Window
attrmask = if Bool
o then Window
cWOverrideRedirect else Window
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
$
         \Ptr SetWindowAttributes
attributes -> do
           Ptr SetWindowAttributes -> Bool -> IO ()
set_override_redirect Ptr SetWindowAttributes
attributes Bool
o
           Display
-> Window
-> Position
-> Position
-> Dimension
-> Dimension
-> CInt
-> CInt
-> CInt
-> Visual
-> Window
-> Ptr SetWindowAttributes
-> IO Window
createWindow Display
dpy Window
rw Position
x Position
y Dimension
w Dimension
h CInt
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 Display
d XFont
fs Config
c = do
  let dflt :: Dimension
dflt = Display -> Dimension
defaultScreen Display
d
  [Rectangle]
srs <- Display -> IO [Rectangle]
getScreenInfo Display
d
  Window
rootw <- Display -> Dimension -> IO Window
rootWindow Display
d Dimension
dflt
  (Position
as,Position
ds) <- XFont -> String -> IO (Position, Position)
textExtents XFont
fs String
"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
+ Position
4
      r :: Rectangle
r = Config -> XPosition -> [Rectangle] -> Dimension -> Rectangle
setPosition Config
c (Config -> XPosition
position Config
c) [Rectangle]
srs (Position -> Dimension
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 Display
d Window
win XFont
fs Config
c = do
  [Rectangle]
srs <- Display -> IO [Rectangle]
getScreenInfo Display
d
  (Position
as,Position
ds) <- XFont -> String -> IO (Position, Position)
textExtents XFont
fs String
"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
+ Position
4
      r :: Rectangle
r = Config -> XPosition -> [Rectangle] -> Dimension -> Rectangle
setPosition Config
c (Config -> XPosition
position Config
c) [Rectangle]
srs (Position -> Dimension
forall a b. (Integral a, Num b) => a -> b
fromIntegral Position
ht)
  Display
-> Window
-> Position
-> Position
-> Dimension
-> Dimension
-> IO ()
moveResizeWindow Display
d Window
win (Rectangle -> Position
rect_x Rectangle
r) (Rectangle -> Position
rect_y Rectangle
r) (Rectangle -> Dimension
rect_width Rectangle
r) (Rectangle -> Dimension
rect_height Rectangle
r)
  Rectangle -> Config -> Display -> Window -> [Rectangle] -> IO ()
setStruts Rectangle
r Config
c Display
d Window
win [Rectangle]
srs
  Display -> Bool -> IO ()
sync Display
d Bool
False
  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] -> Dimension -> Rectangle
setPosition Config
c XPosition
p [Rectangle]
rs Dimension
ht =
  case XPosition
p' of
    XPosition
Top -> Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
rx Position
ry Dimension
rw Dimension
h
    TopP Int
l Int
r -> Position -> Position -> Dimension -> Dimension -> 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 (Dimension
rw Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
- Int -> Dimension
forall a b. (Integral a, Num b) => a -> b
fi Int
l Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
- Int -> Dimension
forall a b. (Integral a, Num b) => a -> b
fi Int
r) Dimension
h
    TopH Int
ch -> Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
rx Position
ry Dimension
rw (Int -> Dimension
forall a. Integral a => a -> Dimension
mh Int
ch)
    TopW Align
a Int
i -> Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle (Align -> Int -> Position
forall b. Integral b => Align -> b -> Position
ax Align
a Int
i) Position
ry (Int -> Dimension
nw Int
i) Dimension
h
    TopSize Align
a Int
i Int
ch -> Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle (Align -> Int -> Position
forall b. Integral b => Align -> b -> Position
ax Align
a Int
i) Position
ry (Int -> Dimension
nw Int
i) (Int -> Dimension
forall a. Integral a => a -> Dimension
mh Int
ch)
    XPosition
Bottom -> Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
rx Position
ny Dimension
rw Dimension
h
    BottomH Int
ch -> Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
rx (Int -> Position
forall a. Integral a => a -> Position
ny' Int
ch) Dimension
rw (Int -> Dimension
forall a. Integral a => a -> Dimension
mh Int
ch)
    BottomW Align
a Int
i -> Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle (Align -> Int -> Position
forall b. Integral b => Align -> b -> Position
ax Align
a Int
i) Position
ny (Int -> Dimension
nw Int
i) Dimension
h
    BottomP Int
l Int
r -> Position -> Position -> Dimension -> Dimension -> 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 (Dimension
rw Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
- Int -> Dimension
forall a b. (Integral a, Num b) => a -> b
fi Int
l Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
- Int -> Dimension
forall a b. (Integral a, Num b) => a -> b
fi Int
r) Dimension
h
    BottomSize Align
a Int
i Int
ch  -> Position -> Position -> Dimension -> Dimension -> 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 -> Dimension
nw Int
i) (Int -> Dimension
forall a. Integral a => a -> Dimension
mh Int
ch)
    Static Int
cx Int
cy Int
cw Int
ch -> Position -> Position -> Dimension -> Dimension -> 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 -> Dimension
forall a b. (Integral a, Num b) => a -> b
fi Int
cw) (Int -> Dimension
forall a b. (Integral a, Num b) => a -> b
fi Int
ch)
    OnScreen Int
_ XPosition
p'' -> Config -> XPosition -> [Rectangle] -> Dimension -> Rectangle
setPosition Config
c XPosition
p'' [Rectangle
scr] Dimension
ht
  where
    (scr :: Rectangle
scr@(Rectangle Position
rx Position
ry Dimension
rw Dimension
rh), XPosition
p') =
      case XPosition
p of OnScreen Int
i 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)
                XPosition
_ -> ([Rectangle] -> Rectangle
picker [Rectangle]
rs, XPosition
p)
    ny :: Position
ny = Position
ry Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fi (Dimension
rh Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
- Dimension
ht)
    center :: a -> Position
center a
i = Position
rx Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fi (Dimension -> Dimension -> Dimension
forall a. Integral a => a -> a -> a
div (a -> Dimension
forall a. Integral a => a -> Dimension
remwid a
i) Dimension
2)
    right :: a -> Position
right  a
i = Position
rx Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fi (a -> Dimension
forall a. Integral a => a -> Dimension
remwid a
i)
    remwid :: a -> Dimension
remwid a
i = Dimension
rw Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
- Dimension -> Dimension
pw (a -> Dimension
forall a b. (Integral a, Num b) => a -> b
fi a
i)
    ax :: Align -> b -> Position
ax Align
L = Position -> b -> Position
forall a b. a -> b -> a
const Position
rx
    ax Align
R = b -> Position
forall a. Integral a => a -> Position
right
    ax Align
C = b -> Position
forall a. Integral a => a -> Position
center
    pw :: Dimension -> Dimension
pw Dimension
i = Dimension
rw Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
* Dimension -> Dimension -> Dimension
forall a. Ord a => a -> a -> a
min Dimension
100 Dimension
i Dimension -> Dimension -> Dimension
forall a. Integral a => a -> a -> a
`div` Dimension
100
    nw :: Int -> Dimension
nw = Dimension -> Dimension
forall a b. (Integral a, Num b) => a -> b
fi (Dimension -> Dimension) -> (Int -> Dimension) -> Int -> Dimension
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dimension -> Dimension
pw (Dimension -> Dimension) -> (Int -> Dimension) -> Int -> Dimension
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Dimension
forall a b. (Integral a, Num b) => a -> b
fi
    h :: Dimension
h = Dimension -> Dimension
forall a b. (Integral a, Num b) => a -> b
fi Dimension
ht
    mh :: a -> Dimension
mh a
h' = Dimension -> Dimension -> Dimension
forall a. Ord a => a -> a -> a
max (a -> Dimension
forall a b. (Integral a, Num b) => a -> b
fi a
h') Dimension
h
    ny' :: a -> Position
ny' a
h' = Position
ry Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fi (Dimension
rh Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
- a -> Dimension
forall a. Integral a => a -> Dimension
mh a
h')
    safeIndex :: a -> [b] -> Maybe b
safeIndex 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 [a
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 (Dimension -> Dimension -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Dimension -> Dimension -> Ordering)
-> (Rectangle -> Dimension) -> Rectangle -> Rectangle -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Rectangle -> Dimension
rect_width)
             else [Rectangle] -> Rectangle
forall a. [a] -> a
head

setProperties :: Config -> Display -> Window -> IO ()
setProperties :: Config -> Display -> Window -> IO ()
setProperties Config
c Display
d Window
w = do
  let mkatom :: String -> IO Window
mkatom String
n = Display -> String -> Bool -> IO Window
internAtom Display
d String
n Bool
False
  Window
card <- String -> IO Window
mkatom String
"CARDINAL"
  Window
atom <- String -> IO Window
mkatom String
"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 String
"_NET_WM_WINDOW_TYPE"
  Window
dock <- String -> IO Window
mkatom String
"_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 String
"_NET_WM_DESKTOP"
    Display -> Window -> Window -> Window -> CInt -> [CLong] -> IO ()
changeProperty32 Display
d Window
w Window
desktop Window
card CInt
propModeReplace [CLong
0xffffffff]

  Window
pid  <- String -> IO Window
mkatom String
"_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' Display
d Window
w [CLong]
svs = do
  let mkatom :: String -> IO Window
mkatom String
n = Display -> String -> Bool -> IO Window
internAtom Display
d String
n Bool
False
  Window
card <- String -> IO Window
mkatom String
"CARDINAL"
  Window
pstrut <- String -> IO Window
mkatom String
"_NET_WM_STRUT_PARTIAL"
  Window
strut <- String -> IO Window
mkatom String
"_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 Int
4 [CLong]
svs)

setStruts :: Rectangle -> Config -> Display -> Window -> [Rectangle] -> IO ()
setStruts :: Rectangle -> Config -> Display -> Window -> [Rectangle] -> IO ()
setStruts Rectangle
r Config
c Display
d Window
w [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 [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 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
+ Dimension -> a
forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> Dimension
rect_height Rectangle
sr)

getStrutValues :: Rectangle -> XPosition -> Int -> [Int]
getStrutValues :: Rectangle -> XPosition -> Int -> [Int]
getStrutValues r :: Rectangle
r@(Rectangle Position
x Position
y Dimension
w Dimension
h) XPosition
p Int
rwh =
  case XPosition
p of
    OnScreen Int
_ XPosition
p'   -> Rectangle -> XPosition -> Int -> [Int]
getStrutValues Rectangle
r XPosition
p' Int
rwh
    XPosition
Top             -> [Int
0, Int
0, Int
st,  Int
0, Int
0, Int
0, Int
0, Int
0, Int
nx, Int
nw,  Int
0,  Int
0]
    TopH    Int
_       -> [Int
0, Int
0, Int
st,  Int
0, Int
0, Int
0, Int
0, Int
0, Int
nx, Int
nw,  Int
0,  Int
0]
    TopP    Int
_ Int
_     -> [Int
0, Int
0, Int
st,  Int
0, Int
0, Int
0, Int
0, Int
0, Int
nx, Int
nw,  Int
0,  Int
0]
    TopW    Align
_ Int
_     -> [Int
0, Int
0, Int
st,  Int
0, Int
0, Int
0, Int
0, Int
0, Int
nx, Int
nw,  Int
0,  Int
0]
    TopSize      {} -> [Int
0, Int
0, Int
st,  Int
0, Int
0, Int
0, Int
0, Int
0, Int
nx, Int
nw,  Int
0,  Int
0]
    XPosition
Bottom          -> [Int
0, Int
0,  Int
0, Int
sb, Int
0, Int
0, Int
0, Int
0,  Int
0,  Int
0, Int
nx, Int
nw]
    BottomH Int
_       -> [Int
0, Int
0,  Int
0, Int
sb, Int
0, Int
0, Int
0, Int
0,  Int
0,  Int
0, Int
nx, Int
nw]
    BottomP Int
_ Int
_     -> [Int
0, Int
0,  Int
0, Int
sb, Int
0, Int
0, Int
0, Int
0,  Int
0,  Int
0, Int
nx, Int
nw]
    BottomW Align
_ Int
_     -> [Int
0, Int
0,  Int
0, Int
sb, Int
0, Int
0, Int
0, Int
0,  Int
0,  Int
0, Int
nx, Int
nw]
    BottomSize   {} -> [Int
0, Int
0,  Int
0, Int
sb, Int
0, Int
0, Int
0, Int
0,  Int
0,  Int
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
+ Dimension -> Int
forall a b. (Integral a, Num b) => a -> b
fi Dimension
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
+ Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fi Dimension
w Position -> Position -> Position
forall a. Num a => a -> a -> a
- Position
1)

-- get some reaonable strut values for static placement.
getStaticStrutValues :: XPosition -> Int -> [Int]
getStaticStrutValues :: XPosition -> Int -> [Int]
getStaticStrutValues (Static Int
cx Int
cy Int
cw Int
ch) 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` Int
2) = [Int
0, Int
0, Int
st,  Int
0, Int
0, Int
0, Int
0, Int
0, Int
xs, Int
xe,  Int
0,  Int
0]
    | Bool
otherwise = [Int
0, Int
0,  Int
0, Int
sb, Int
0, Int
0, Int
0, Int
0,  Int
0,  Int
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
getStaticStrutValues XPosition
_ Int
_ = [Int
0, Int
0, Int
0, Int
0, Int
0, Int
0, Int
0, Int
0, Int
0, Int
0, Int
0, Int
0]

drawBorder :: Border -> Int -> Display -> Drawable -> GC -> Pixel
              -> Dimension -> Dimension -> IO ()
drawBorder :: Border
-> Int
-> Display
-> Window
-> GC
-> Window
-> Dimension
-> Dimension
-> IO ()
drawBorder Border
b Int
lw Display
d Window
p GC
gc Window
c Dimension
wi Dimension
ht =  case Border
b of
  Border
NoBorder -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  Border
TopB       -> Border
-> Int
-> Display
-> Window
-> GC
-> Window
-> Dimension
-> Dimension
-> IO ()
drawBorder (Int -> Border
TopBM Int
0) Int
lw Display
d Window
p GC
gc Window
c Dimension
wi Dimension
ht
  Border
BottomB    -> Border
-> Int
-> Display
-> Window
-> GC
-> Window
-> Dimension
-> Dimension
-> IO ()
drawBorder (Int -> Border
BottomBM Int
0) Int
lw Display
d Window
p GC
gc Window
c Dimension
wi Dimension
ht
  Border
FullB      -> Border
-> Int
-> Display
-> Window
-> GC
-> Window
-> Dimension
-> Dimension
-> IO ()
drawBorder (Int -> Border
FullBM Int
0) Int
lw Display
d Window
p GC
gc Window
c Dimension
wi Dimension
ht
  TopBM 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 Position
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) (Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fi Dimension
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 Int
m -> let rw :: Position
rw = Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fi Dimension
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 Position
0 Position
rw (Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fi Dimension
wi) Position
rw
  FullBM Int
m   -> let mp :: Position
mp = Int -> Position
forall a b. (Integral a, Num b) => a -> b
fi Int
m
                    pad :: Dimension
pad = Dimension
2 Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
* Position -> Dimension
forall a b. (Integral a, Num b) => a -> b
fi Position
mp Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
+  Int -> Dimension
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
-> Dimension
-> Dimension
-> IO ()
drawRectangle Display
d Window
p GC
gc Position
mp Position
mp (Dimension
wi Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
- Dimension
pad) (Dimension
ht Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
- Dimension
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 Display
d Window
w = do
    Display -> Window -> [CLong] -> IO ()
setStruts' Display
d Window
w (Int -> CLong -> [CLong]
forall a. Int -> a -> [a]
replicate Int
12 CLong
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 Rectangle
r Config
c Display
d 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 Display
d 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 Border
b Int
lw =
  case Border
b of
    Border
BottomB    -> a -> a
forall a. Num a => a -> a
negate a
boffs
    BottomBM Int
_ -> a -> a
forall a. Num a => a -> a
negate a
boffs
    Border
TopB       -> a
boffs
    TopBM Int
_    -> a
boffs
    Border
_          -> a
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
/Double
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