{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE RecordWildCards #-}
module XMonad.Util.XUtils
(
withSimpleWindow
, showSimpleWindow
, WindowConfig(..)
, WindowRect(..)
, averagePixels
, createNewWindow
, showWindow
, showWindows
, hideWindow
, hideWindows
, deleteWindow
, deleteWindows
, paintWindow
, paintAndWrite
, paintTextAndIcons
, stringToPixel
, pixelToString
, fi
) where
import XMonad.Prelude
import XMonad
import XMonad.Util.Font
import XMonad.Util.Image
import qualified XMonad.StackSet as W
import Data.Bits ((.&.))
averagePixels :: Pixel -> Pixel -> Double -> X Pixel
averagePixels :: Atom -> Atom -> Double -> X Atom
averagePixels Atom
p1' Atom
p2' Double
f =
do Display
d <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Display
display
let cm :: Atom
cm = Display -> Dimension -> Atom
defaultColormap Display
d (Display -> Dimension
defaultScreen Display
d)
mask :: a -> a
mask a
p = a
p forall a. Bits a => a -> a -> a
.&. a
0x00FFFFFF
p1 :: Atom
p1 = forall {a}. (Bits a, Num a) => a -> a
mask Atom
p1'
p2 :: Atom
p2 = forall {a}. (Bits a, Num a) => a -> a
mask Atom
p2'
[Color Atom
_ Word16
r1 Word16
g1 Word16
b1 Word8
_,Color Atom
_ Word16
r2 Word16
g2 Word16
b2 Word8
_] <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> Atom -> [Color] -> IO [Color]
queryColors Display
d Atom
cm [Atom -> Word16 -> Word16 -> Word16 -> Word8 -> Color
Color Atom
p1 Word16
0 Word16
0 Word16
0 Word8
0,Atom -> Word16 -> Word16 -> Word16 -> Word8 -> Color
Color Atom
p2 Word16
0 Word16
0 Word16
0 Word8
0]
let mn :: a -> a -> b
mn a
x1 a
x2 = forall a b. (RealFrac a, Integral b) => a -> b
round (forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x1 forall a. Num a => a -> a -> a
* Double
f forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x2 forall a. Num a => a -> a -> a
* (Double
1forall a. Num a => a -> a -> a
-Double
f))
Color Atom
p Word16
_ Word16
_ Word16
_ Word8
_ <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> Atom -> Color -> IO Color
allocColor Display
d Atom
cm (Atom -> Word16 -> Word16 -> Word16 -> Word8 -> Color
Color Atom
0 (forall {b} {a} {a}.
(Integral b, Integral a, Integral a) =>
a -> a -> b
mn Word16
r1 Word16
r2) (forall {b} {a} {a}.
(Integral b, Integral a, Integral a) =>
a -> a -> b
mn Word16
g1 Word16
g2) (forall {b} {a} {a}.
(Integral b, Integral a, Integral a) =>
a -> a -> b
mn Word16
b1 Word16
b2) Word8
0)
forall (m :: * -> *) a. Monad m => a -> m a
return Atom
p
createNewWindow :: Rectangle -> Maybe EventMask -> String -> Bool -> X Window
createNewWindow :: Rectangle -> Maybe Atom -> String -> Bool -> X Atom
createNewWindow (Rectangle Position
x Position
y Dimension
w Dimension
h) Maybe Atom
m String
col Bool
o = do
Display
d <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Display
display
Atom
rw <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Atom
theRoot
Atom
c <- forall (m :: * -> *).
(Functor m, MonadIO m) =>
Display -> String -> m Atom
stringToPixel Display
d String
col
Atom
win <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display
-> Screen
-> Atom
-> Position
-> Position
-> Dimension
-> Dimension
-> Atom
-> Bool
-> IO Atom
mkWindow Display
d (Display -> Screen
defaultScreenOfDisplay Display
d) Atom
rw Position
x Position
y Dimension
w Dimension
h Atom
c Bool
o
case Maybe Atom
m of
Just Atom
em -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> Atom -> Atom -> IO ()
selectInput Display
d Atom
win Atom
em
Maybe Atom
Nothing -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> Atom -> Atom -> IO ()
selectInput Display
d Atom
win Atom
exposureMask
X Bool -> X () -> X ()
whenX (forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Maybe a -> Bool
isJust Maybe Atom
m) forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. X a -> X a -> X a
catchX (forall (m :: * -> *) a. Monad m => a -> m a
return ()) forall a b. (a -> b) -> a -> b
$ do
Atom
wINDOW_TYPE <- String -> X Atom
getAtom String
"_NET_WM_WINDOW_TYPE"
Atom
dESKTOP <- String -> X Atom
getAtom String
"_NET_WM_WINDOW_TYPE_DESKTOP"
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> Atom -> Atom -> Atom -> CInt -> [CLong] -> IO ()
changeProperty32 Display
d Atom
win Atom
wINDOW_TYPE Atom
aTOM CInt
propModeReplace [forall a b. (Integral a, Num b) => a -> b
fi Atom
dESKTOP]
forall (m :: * -> *) a. Monad m => a -> m a
return Atom
win
showWindow :: Window -> X ()
showWindow :: Atom -> X ()
showWindow Atom
w = do
Display
d <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Display
display
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> Atom -> IO ()
mapWindow Display
d Atom
w
showWindows :: [Window] -> X ()
showWindows :: [Atom] -> X ()
showWindows = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Atom -> X ()
showWindow
hideWindow :: Window -> X ()
hideWindow :: Atom -> X ()
hideWindow Atom
w = do
Display
d <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Display
display
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> Atom -> IO ()
unmapWindow Display
d Atom
w
hideWindows :: [Window] -> X ()
hideWindows :: [Atom] -> X ()
hideWindows = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Atom -> X ()
hideWindow
deleteWindow :: Window -> X ()
deleteWindow :: Atom -> X ()
deleteWindow Atom
w = do
Display
d <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Display
display
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> Atom -> IO ()
destroyWindow Display
d Atom
w
deleteWindows :: [Window] -> X ()
deleteWindows :: [Atom] -> X ()
deleteWindows = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Atom -> X ()
deleteWindow
paintWindow :: Window
-> Dimension
-> Dimension
-> Dimension
-> String
-> String
-> X ()
paintWindow :: Atom
-> Dimension -> Dimension -> Dimension -> String -> String -> X ()
paintWindow Atom
w Dimension
wh Dimension
ht Dimension
bw String
c String
bc =
Atom
-> Rectangle
-> Dimension
-> String
-> String
-> Maybe
(XMonadFont, String, String, [(String, (Position, Position))])
-> Maybe (String, String, [((Position, Position), [[Bool]])])
-> X ()
paintWindow' Atom
w (Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
0 Position
0 Dimension
wh Dimension
ht) Dimension
bw String
c String
bc forall a. Maybe a
Nothing forall a. Maybe a
Nothing
paintAndWrite :: Window
-> XMonadFont
-> Dimension
-> Dimension
-> Dimension
-> String
-> String
-> String
-> String
-> [Align]
-> [String]
-> X ()
paintAndWrite :: Atom
-> XMonadFont
-> Dimension
-> Dimension
-> Dimension
-> String
-> String
-> String
-> String
-> [Align]
-> [String]
-> X ()
paintAndWrite Atom
w XMonadFont
fs Dimension
wh Dimension
ht Dimension
bw String
bc String
borc String
ffc String
fbc [Align]
als [String]
strs = do
Display
d <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Display
display
[(Position, Position)]
strPositions <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (forall a b. [a] -> [b] -> [(a, b)]
zip [Align]
als [String]
strs) forall a b. (a -> b) -> a -> b
$
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (forall (m :: * -> *).
(Functor m, MonadIO m) =>
Display
-> XMonadFont
-> Rectangle
-> Align
-> String
-> m (Position, Position)
stringPosition Display
d XMonadFont
fs (Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
0 Position
0 Dimension
wh Dimension
ht))
let ms :: Maybe
(XMonadFont, String, String, [(String, (Position, Position))])
ms = forall a. a -> Maybe a
Just (XMonadFont
fs,String
ffc,String
fbc, forall a b. [a] -> [b] -> [(a, b)]
zip [String]
strs [(Position, Position)]
strPositions)
Atom
-> Rectangle
-> Dimension
-> String
-> String
-> Maybe
(XMonadFont, String, String, [(String, (Position, Position))])
-> Maybe (String, String, [((Position, Position), [[Bool]])])
-> X ()
paintWindow' Atom
w (Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
0 Position
0 Dimension
wh Dimension
ht) Dimension
bw String
bc String
borc Maybe
(XMonadFont, String, String, [(String, (Position, Position))])
ms forall a. Maybe a
Nothing
paintTextAndIcons :: Window
-> XMonadFont
-> Dimension
-> Dimension
-> Dimension
-> String
-> String
-> String
-> String
-> [Align]
-> [String]
-> [Placement]
-> [[[Bool]]]
-> X ()
paintTextAndIcons :: Atom
-> XMonadFont
-> Dimension
-> Dimension
-> Dimension
-> String
-> String
-> String
-> String
-> [Align]
-> [String]
-> [Placement]
-> [[[Bool]]]
-> X ()
paintTextAndIcons Atom
w XMonadFont
fs Dimension
wh Dimension
ht Dimension
bw String
bc String
borc String
ffc String
fbc [Align]
als [String]
strs [Placement]
i_als [[[Bool]]]
icons = do
Display
d <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Display
display
[(Position, Position)]
strPositions <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (forall a b. [a] -> [b] -> [(a, b)]
zip [Align]
als [String]
strs) forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (forall (m :: * -> *).
(Functor m, MonadIO m) =>
Display
-> XMonadFont
-> Rectangle
-> Align
-> String
-> m (Position, Position)
stringPosition Display
d XMonadFont
fs (Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
0 Position
0 Dimension
wh Dimension
ht))
let iconPositions :: [(Position, Position)]
iconPositions = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Rectangle -> Placement -> [[Bool]] -> (Position, Position)
iconPosition (Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
0 Position
0 Dimension
wh Dimension
ht)) [Placement]
i_als [[[Bool]]]
icons
ms :: Maybe
(XMonadFont, String, String, [(String, (Position, Position))])
ms = forall a. a -> Maybe a
Just (XMonadFont
fs,String
ffc,String
fbc, forall a b. [a] -> [b] -> [(a, b)]
zip [String]
strs [(Position, Position)]
strPositions)
is :: Maybe (String, String, [((Position, Position), [[Bool]])])
is = forall a. a -> Maybe a
Just (String
ffc, String
fbc, forall a b. [a] -> [b] -> [(a, b)]
zip [(Position, Position)]
iconPositions [[[Bool]]]
icons)
Atom
-> Rectangle
-> Dimension
-> String
-> String
-> Maybe
(XMonadFont, String, String, [(String, (Position, Position))])
-> Maybe (String, String, [((Position, Position), [[Bool]])])
-> X ()
paintWindow' Atom
w (Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
0 Position
0 Dimension
wh Dimension
ht) Dimension
bw String
bc String
borc Maybe
(XMonadFont, String, String, [(String, (Position, Position))])
ms Maybe (String, String, [((Position, Position), [[Bool]])])
is
data WindowConfig = WindowConfig
{ WindowConfig -> String
winFont :: !String
, WindowConfig -> String
winBg :: !String
, WindowConfig -> String
winFg :: !String
, WindowConfig -> WindowRect
winRect :: !WindowRect
}
instance Default WindowConfig where
def :: WindowConfig
def = WindowConfig
{
#ifdef XFT
winFont :: String
winFont = String
"xft:monospace-20"
#else
winFont = "-misc-fixed-*-*-*-*-20-*-*-*-*-*-*-*"
#endif
, winBg :: String
winBg = String
"black"
, winFg :: String
winFg = String
"white"
, winRect :: WindowRect
winRect = WindowRect
CenterWindow
}
data WindowRect
= CenterWindow
| CustomRect Rectangle
showSimpleWindow :: WindowConfig
-> [String]
-> X Window
showSimpleWindow :: WindowConfig -> [String] -> X Atom
showSimpleWindow WindowConfig{String
WindowRect
winRect :: WindowRect
winFg :: String
winBg :: String
winFont :: String
winRect :: WindowConfig -> WindowRect
winFg :: WindowConfig -> String
winBg :: WindowConfig -> String
winFont :: WindowConfig -> String
..} [String]
strs = do
let pad :: Position
pad = Position
20
XMonadFont
font <- String -> X XMonadFont
initXMF String
winFont
Display
dpy <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Display
display
Rectangle Position
sx Position
sy Dimension
sw Dimension
sh <- WindowRect -> X Rectangle
getRectangle WindowRect
winRect
Position
extends <- forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Num a => a -> a -> a
(+)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (m :: * -> *).
MonadIO m =>
XMonadFont -> String -> m (Position, Position)
textExtentsXMF XMonadFont
font) [String]
strs
Position
height <- forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fi forall a b. (a -> b) -> a -> b
$ (Int
1 forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
strs) forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fi Position
extends
Position
width <- (forall a. Num a => a -> a -> a
+ Position
pad) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fi forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (m :: * -> *).
MonadIO m =>
Display -> XMonadFont -> String -> m Int
textWidthXMF Display
dpy XMonadFont
font) [String]
strs
let
x :: Position
x = Position
sx forall a. Num a => a -> a -> a
+ (forall a b. (Integral a, Num b) => a -> b
fi Dimension
sw forall a. Num a => a -> a -> a
- Position
width forall a. Num a => a -> a -> a
+ Position
2) forall a. Integral a => a -> a -> a
`div` Position
2
y :: Position
y = Position
sy forall a. Num a => a -> a -> a
+ (forall a b. (Integral a, Num b) => a -> b
fi Dimension
sh forall a. Num a => a -> a -> a
- Position
height forall a. Num a => a -> a -> a
+ Position
2) forall a. Integral a => a -> a -> a
`div` Position
2
yFirst :: Position
yFirst = (Position
height forall a. Num a => a -> a -> a
+ Position
2 forall a. Num a => a -> a -> a
* Position
extends) forall a. Integral a => a -> a -> a
`div` forall a b. (Integral a, Num b) => a -> b
fi (Int
2 forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
strs)
strPositions :: [(Position, Position)]
strPositions = forall a b. (a -> b) -> [a] -> [b]
map (Position
pad forall a. Integral a => a -> a -> a
`div` Position
2, ) [Position
yFirst, Position
yFirst forall a. Num a => a -> a -> a
+ Position
extends ..]
Atom
w <- Rectangle -> Maybe Atom -> String -> Bool -> X Atom
createNewWindow (Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
x Position
y (forall a b. (Integral a, Num b) => a -> b
fi Position
width) (forall a b. (Integral a, Num b) => a -> b
fi Position
height)) forall a. Maybe a
Nothing String
"" Bool
True
let ms :: Maybe
(XMonadFont, String, String, [(String, (Position, Position))])
ms = forall a. a -> Maybe a
Just (XMonadFont
font, String
winFg, String
winBg, forall a b. [a] -> [b] -> [(a, b)]
zip [String]
strs [(Position, Position)]
strPositions)
Atom -> X ()
showWindow Atom
w
Atom
-> Rectangle
-> Dimension
-> String
-> String
-> Maybe
(XMonadFont, String, String, [(String, (Position, Position))])
-> Maybe (String, String, [((Position, Position), [[Bool]])])
-> X ()
paintWindow' Atom
w (Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
0 Position
0 (forall a b. (Integral a, Num b) => a -> b
fi Position
width) (forall a b. (Integral a, Num b) => a -> b
fi Position
height)) Dimension
0 String
winBg String
"" Maybe
(XMonadFont, String, String, [(String, (Position, Position))])
ms forall a. Maybe a
Nothing
XMonadFont -> X ()
releaseXMF XMonadFont
font
forall (f :: * -> *) a. Applicative f => a -> f a
pure Atom
w
where
getRectangle :: WindowRect -> X Rectangle
getRectangle :: WindowRect -> X Rectangle
getRectangle = \case
WindowRect
CenterWindow -> forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a b. (a -> b) -> a -> b
$ ScreenDetail -> Rectangle
screenRect forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. Screen i l a sid sd -> sd
W.screenDetail forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset
CustomRect Rectangle
r -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Rectangle
r
withSimpleWindow :: WindowConfig -> [String] -> X a -> X a
withSimpleWindow :: forall a. WindowConfig -> [String] -> X a -> X a
withSimpleWindow WindowConfig
wc [String]
strs X a
doStuff = do
Atom
w <- WindowConfig -> [String] -> X Atom
showSimpleWindow WindowConfig
wc [String]
strs
X a
doStuff forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall a. (Display -> X a) -> X a
withDisplay (forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Display -> Atom -> IO ()
`destroyWindow` Atom
w))
paintWindow' :: Window -> Rectangle -> Dimension -> String -> String
-> Maybe (XMonadFont,String,String,[(String, (Position, Position))])
-> Maybe (String, String, [((Position, Position), [[Bool]])]) -> X ()
paintWindow' :: Atom
-> Rectangle
-> Dimension
-> String
-> String
-> Maybe
(XMonadFont, String, String, [(String, (Position, Position))])
-> Maybe (String, String, [((Position, Position), [[Bool]])])
-> X ()
paintWindow' Atom
win (Rectangle Position
_ Position
_ Dimension
wh Dimension
ht) Dimension
bw String
color String
b_color Maybe
(XMonadFont, String, String, [(String, (Position, Position))])
strStuff Maybe (String, String, [((Position, Position), [[Bool]])])
iconStuff = do
Display
d <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Display
display
Atom
p <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> Atom -> Dimension -> Dimension -> CInt -> IO Atom
createPixmap Display
d Atom
win Dimension
wh Dimension
ht (Screen -> CInt
defaultDepthOfScreen forall a b. (a -> b) -> a -> b
$ Display -> Screen
defaultScreenOfDisplay Display
d)
GC
gc <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> Atom -> IO GC
createGC Display
d Atom
p
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> GC -> Bool -> IO ()
setGraphicsExposures Display
d GC
gc Bool
False
[Atom
color',Atom
b_color'] <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
(Functor m, MonadIO m) =>
Display -> String -> m Atom
stringToPixel Display
d) [String
color,String
b_color]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> GC -> Atom -> IO ()
setForeground Display
d GC
gc Atom
b_color'
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display
-> Atom
-> GC
-> Position
-> Position
-> Dimension
-> Dimension
-> IO ()
fillRectangle Display
d Atom
p GC
gc Position
0 Position
0 Dimension
wh Dimension
ht
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> GC -> Atom -> IO ()
setForeground Display
d GC
gc Atom
color'
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display
-> Atom
-> GC
-> Position
-> Position
-> Dimension
-> Dimension
-> IO ()
fillRectangle Display
d Atom
p GC
gc (forall a b. (Integral a, Num b) => a -> b
fi Dimension
bw) (forall a b. (Integral a, Num b) => a -> b
fi Dimension
bw) (Dimension
wh forall a. Num a => a -> a -> a
- (Dimension
bw forall a. Num a => a -> a -> a
* Dimension
2)) (Dimension
ht forall a. Num a => a -> a -> a
- (Dimension
bw forall a. Num a => a -> a -> a
* Dimension
2))
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isJust Maybe
(XMonadFont, String, String, [(String, (Position, Position))])
strStuff) forall a b. (a -> b) -> a -> b
$ do
let (XMonadFont
xmf,String
fc,String
bc,[(String, (Position, Position))]
strAndPos) = forall a. HasCallStack => Maybe a -> a
fromJust Maybe
(XMonadFont, String, String, [(String, (Position, Position))])
strStuff
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(String, (Position, Position))]
strAndPos forall a b. (a -> b) -> a -> b
$ \(String
s, (Position
x, Position
y)) ->
forall (m :: * -> *).
(Functor m, MonadIO m) =>
Display
-> Atom
-> XMonadFont
-> GC
-> String
-> String
-> Position
-> Position
-> String
-> m ()
printStringXMF Display
d Atom
p XMonadFont
xmf GC
gc String
fc String
bc Position
x Position
y String
s
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isJust Maybe (String, String, [((Position, Position), [[Bool]])])
iconStuff) forall a b. (a -> b) -> a -> b
$ do
let (String
fc, String
bc, [((Position, Position), [[Bool]])]
iconAndPos) = forall a. HasCallStack => Maybe a -> a
fromJust Maybe (String, String, [((Position, Position), [[Bool]])])
iconStuff
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [((Position, Position), [[Bool]])]
iconAndPos forall a b. (a -> b) -> a -> b
$ \((Position
x, Position
y), [[Bool]]
icon) ->
forall (m :: * -> *).
(Functor m, MonadIO m) =>
Display
-> Atom
-> GC
-> String
-> String
-> Position
-> Position
-> [[Bool]]
-> m ()
drawIcon Display
d Atom
p GC
gc String
fc String
bc Position
x Position
y [[Bool]]
icon
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display
-> Atom
-> Atom
-> GC
-> Position
-> Position
-> Dimension
-> Dimension
-> Position
-> Position
-> IO ()
copyArea Display
d Atom
p Atom
win GC
gc Position
0 Position
0 Dimension
wh Dimension
ht Position
0 Position
0
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> Atom -> IO ()
freePixmap Display
d Atom
p
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> GC -> IO ()
freeGC Display
d GC
gc
mkWindow :: Display -> Screen -> Window -> Position
-> Position -> Dimension -> Dimension -> Pixel -> Bool -> IO Window
mkWindow :: Display
-> Screen
-> Atom
-> Position
-> Position
-> Dimension
-> Dimension
-> Atom
-> Bool
-> IO Atom
mkWindow Display
d Screen
s Atom
rw Position
x Position
y Dimension
w Dimension
h Atom
p Bool
o = do
let visual :: Visual
visual = Screen -> Visual
defaultVisualOfScreen Screen
s
attrmask :: Atom
attrmask = Atom
cWOverrideRedirect forall a. Bits a => a -> a -> a
.|. Atom
cWBackPixel forall a. Bits a => a -> a -> a
.|. Atom
cWBorderPixel
forall a. (Ptr SetWindowAttributes -> IO a) -> IO a
allocaSetWindowAttributes forall a b. (a -> b) -> a -> b
$
\Ptr SetWindowAttributes
attributes -> do
Ptr SetWindowAttributes -> Bool -> IO ()
set_override_redirect Ptr SetWindowAttributes
attributes Bool
o
Ptr SetWindowAttributes -> Atom -> IO ()
set_border_pixel Ptr SetWindowAttributes
attributes Atom
p
Ptr SetWindowAttributes -> Atom -> IO ()
set_background_pixel Ptr SetWindowAttributes
attributes Atom
p
Display
-> Atom
-> Position
-> Position
-> Dimension
-> Dimension
-> CInt
-> CInt
-> CInt
-> Visual
-> Atom
-> Ptr SetWindowAttributes
-> IO Atom
createWindow Display
d Atom
rw Position
x Position
y Dimension
w Dimension
h CInt
0 (Screen -> CInt
defaultDepthOfScreen Screen
s)
CInt
inputOutput Visual
visual Atom
attrmask Ptr SetWindowAttributes
attributes