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
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
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)
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)
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
| 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
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
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