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
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
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)
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)
getStaticStrutValues :: XPosition -> Int -> [Int]
getStaticStrutValues :: XPosition -> Int -> [Int]
getStaticStrutValues (Static Int
cx Int
cy Int
cw Int
ch) Int
rwh
| 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
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
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