-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Util.XUtils
-- Description :  A module for painting on the screen.
-- Copyright   :  (c) 2007 Andrea Rossato
--                    2010 Alejandro Serrano
-- License     :  BSD-style (see xmonad/LICENSE)
--
-- Maintainer  :  andrea.rossato@unibz.it
-- Stability   :  unstable
-- Portability :  unportable
--
-- A module for painting on the screen
--
-----------------------------------------------------------------------------

module XMonad.Util.XUtils
    ( -- * Usage:
      -- $usage
      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

-- $usage
-- See "XMonad.Layout.Tabbed" or "XMonad.Layout.DragPane" or
-- "XMonad.Layout.Decoration" for usage examples

-- | Compute the weighted average the colors of two given Pixel values.
averagePixels :: Pixel -> Pixel -> Double -> X Pixel
averagePixels :: Pixel -> Pixel -> Double -> X Pixel
averagePixels Pixel
p1 Pixel
p2 Double
f =
    do Display
d <- (XConf -> Display) -> X Display
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Display
display
       let cm :: Pixel
cm = Display -> ScreenNumber -> Pixel
defaultColormap Display
d (Display -> ScreenNumber
defaultScreen Display
d)
       [Color Pixel
_ Word16
r1 Word16
g1 Word16
b1 Word8
_,Color Pixel
_ Word16
r2 Word16
g2 Word16
b2 Word8
_] <- IO [Color] -> X [Color]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO [Color] -> X [Color]) -> IO [Color] -> X [Color]
forall a b. (a -> b) -> a -> b
$ Display -> Pixel -> [Color] -> IO [Color]
queryColors Display
d Pixel
cm [Pixel -> Word16 -> Word16 -> Word16 -> Word8 -> Color
Color Pixel
p1 Word16
0 Word16
0 Word16
0 Word8
0,Pixel -> Word16 -> Word16 -> Word16 -> Word8 -> Color
Color Pixel
p2 Word16
0 Word16
0 Word16
0 Word8
0]
       let mn :: a -> a -> b
mn a
x1 a
x2 = Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (a -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x1 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
f Double -> Double -> Double
forall a. Num a => a -> a -> a
+ a -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
1Double -> Double -> Double
forall a. Num a => a -> a -> a
-Double
f))
       Color Pixel
p Word16
_ Word16
_ Word16
_ Word8
_ <- IO Color -> X Color
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO Color -> X Color) -> IO Color -> X Color
forall a b. (a -> b) -> a -> b
$ Display -> Pixel -> Color -> IO Color
allocColor Display
d Pixel
cm (Pixel -> Word16 -> Word16 -> Word16 -> Word8 -> Color
Color Pixel
0 (Word16 -> Word16 -> Word16
forall b a a. (Integral b, Integral a, Integral a) => a -> a -> b
mn Word16
r1 Word16
r2) (Word16 -> Word16 -> Word16
forall b a a. (Integral b, Integral a, Integral a) => a -> a -> b
mn Word16
g1 Word16
g2) (Word16 -> Word16 -> Word16
forall b a a. (Integral b, Integral a, Integral a) => a -> a -> b
mn Word16
b1 Word16
b2) Word8
0)
       Pixel -> X Pixel
forall (m :: * -> *) a. Monad m => a -> m a
return Pixel
p

-- | Create a simple window given a rectangle. If Nothing is given
-- only the exposureMask will be set, otherwise the Just value.
-- Use 'showWindow' to map and hideWindow to unmap.
createNewWindow :: Rectangle -> Maybe EventMask -> String -> Bool -> X Window
createNewWindow :: Rectangle -> Maybe Pixel -> String -> Bool -> X Pixel
createNewWindow (Rectangle Position
x Position
y ScreenNumber
w ScreenNumber
h) Maybe Pixel
m String
col Bool
o = do
  Display
d   <- (XConf -> Display) -> X Display
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Display
display
  Pixel
rw  <- (XConf -> Pixel) -> X Pixel
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Pixel
theRoot
  Pixel
c   <- Display -> String -> X Pixel
forall (m :: * -> *).
(Functor m, MonadIO m) =>
Display -> String -> m Pixel
stringToPixel Display
d String
col
  Pixel
win <- IO Pixel -> X Pixel
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO Pixel -> X Pixel) -> IO Pixel -> X Pixel
forall a b. (a -> b) -> a -> b
$ Display
-> Screen
-> Pixel
-> Position
-> Position
-> ScreenNumber
-> ScreenNumber
-> Pixel
-> Bool
-> IO Pixel
mkWindow Display
d (Display -> Screen
defaultScreenOfDisplay Display
d) Pixel
rw Position
x Position
y ScreenNumber
w ScreenNumber
h Pixel
c Bool
o
  case Maybe Pixel
m of
    Just Pixel
em -> IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ Display -> Pixel -> Pixel -> IO ()
selectInput Display
d Pixel
win Pixel
em
    Maybe Pixel
Nothing -> IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ Display -> Pixel -> Pixel -> IO ()
selectInput Display
d Pixel
win Pixel
exposureMask
  -- @@@ ugly hack to prevent compositing
  X Bool -> X () -> X ()
whenX (Bool -> X Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> X Bool) -> Bool -> X Bool
forall a b. (a -> b) -> a -> b
$ Maybe Pixel -> Bool
forall a. Maybe a -> Bool
isJust Maybe Pixel
m) (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$ (X () -> X () -> X ()) -> X () -> X () -> X ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip X () -> X () -> X ()
forall a. X a -> X a -> X a
catchX (() -> X ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$ do
    Pixel
wINDOW_TYPE <- String -> X Pixel
getAtom String
"_NET_WM_WINDOW_TYPE"
    Pixel
dESKTOP <- String -> X Pixel
getAtom String
"_NET_WM_WINDOW_TYPE_DESKTOP"
    IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ Display -> Pixel -> Pixel -> Pixel -> CInt -> [CLong] -> IO ()
changeProperty32 Display
d Pixel
win Pixel
wINDOW_TYPE Pixel
aTOM CInt
propModeReplace [Pixel -> CLong
forall a b. (Integral a, Num b) => a -> b
fi Pixel
dESKTOP]
  Pixel -> X Pixel
forall (m :: * -> *) a. Monad m => a -> m a
return Pixel
win

-- | Map a window
showWindow :: Window -> X ()
showWindow :: Pixel -> X ()
showWindow Pixel
w = do
  Display
d <- (XConf -> Display) -> X Display
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Display
display
  IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ Display -> Pixel -> IO ()
mapWindow Display
d Pixel
w

-- | the list version
showWindows :: [Window] -> X ()
showWindows :: [Pixel] -> X ()
showWindows = (Pixel -> X ()) -> [Pixel] -> X ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Pixel -> X ()
showWindow

-- | unmap a window
hideWindow :: Window -> X ()
hideWindow :: Pixel -> X ()
hideWindow Pixel
w = do
  Display
d <- (XConf -> Display) -> X Display
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Display
display
  IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ Display -> Pixel -> IO ()
unmapWindow Display
d Pixel
w

-- | the list version
hideWindows :: [Window] -> X ()
hideWindows :: [Pixel] -> X ()
hideWindows = (Pixel -> X ()) -> [Pixel] -> X ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Pixel -> X ()
hideWindow

-- | destroy a window
deleteWindow :: Window -> X ()
deleteWindow :: Pixel -> X ()
deleteWindow Pixel
w = do
  Display
d <- (XConf -> Display) -> X Display
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Display
display
  IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ Display -> Pixel -> IO ()
destroyWindow Display
d Pixel
w

-- | the list version
deleteWindows :: [Window] -> X ()
deleteWindows :: [Pixel] -> X ()
deleteWindows = (Pixel -> X ()) -> [Pixel] -> X ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Pixel -> X ()
deleteWindow

-- | Fill a window with a rectangle and a border
paintWindow :: Window     -- ^ The window where to draw
            -> Dimension  -- ^ Window width
            -> Dimension  -- ^ Window height
            -> Dimension  -- ^ Border width
            -> String     -- ^ Window background color
            -> String     -- ^ Border color
            -> X ()
paintWindow :: Pixel
-> ScreenNumber
-> ScreenNumber
-> ScreenNumber
-> String
-> String
-> X ()
paintWindow Pixel
w ScreenNumber
wh ScreenNumber
ht ScreenNumber
bw String
c String
bc =
    Pixel
-> Rectangle
-> ScreenNumber
-> String
-> String
-> Maybe
     (XMonadFont, String, String, [(String, (Position, Position))])
-> Maybe (String, String, [((Position, Position), [[Bool]])])
-> X ()
paintWindow' Pixel
w (Position -> Position -> ScreenNumber -> ScreenNumber -> Rectangle
Rectangle Position
0 Position
0 ScreenNumber
wh ScreenNumber
ht) ScreenNumber
bw String
c String
bc Maybe
  (XMonadFont, String, String, [(String, (Position, Position))])
forall a. Maybe a
Nothing Maybe (String, String, [((Position, Position), [[Bool]])])
forall a. Maybe a
Nothing

-- | Fill a window with a rectangle and a border, and write
-- | a number of strings to given positions
paintAndWrite :: Window     -- ^ The window where to draw
              -> XMonadFont -- ^ XMonad Font for drawing
              -> Dimension  -- ^ Window width
              -> Dimension  -- ^ Window height
              -> Dimension  -- ^ Border width
              -> String     -- ^ Window background color
              -> String     -- ^ Border color
              -> String     -- ^ String color
              -> String     -- ^ String background color
              -> [Align]    -- ^ String 'Align'ments
              -> [String]   -- ^ Strings to be printed
              -> X ()
paintAndWrite :: Pixel
-> XMonadFont
-> ScreenNumber
-> ScreenNumber
-> ScreenNumber
-> String
-> String
-> String
-> String
-> [Align]
-> [String]
-> X ()
paintAndWrite Pixel
w XMonadFont
fs ScreenNumber
wh ScreenNumber
ht ScreenNumber
bw String
bc String
borc String
ffc String
fbc [Align]
als [String]
strs = do
    Display
d <- (XConf -> Display) -> X Display
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Display
display
    [(Position, Position)]
strPositions <- [(Align, String)]
-> ((Align, String) -> X (Position, Position))
-> X [(Position, Position)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM ([Align] -> [String] -> [(Align, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Align]
als [String]
strs) (((Align, String) -> X (Position, Position))
 -> X [(Position, Position)])
-> ((Align, String) -> X (Position, Position))
-> X [(Position, Position)]
forall a b. (a -> b) -> a -> b
$
        (Align -> String -> X (Position, Position))
-> (Align, String) -> X (Position, Position)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Display
-> XMonadFont
-> Rectangle
-> Align
-> String
-> X (Position, Position)
forall (m :: * -> *).
(Functor m, MonadIO m) =>
Display
-> XMonadFont
-> Rectangle
-> Align
-> String
-> m (Position, Position)
stringPosition Display
d XMonadFont
fs (Position -> Position -> ScreenNumber -> ScreenNumber -> Rectangle
Rectangle Position
0 Position
0 ScreenNumber
wh ScreenNumber
ht))
    let ms :: Maybe
  (XMonadFont, String, String, [(String, (Position, Position))])
ms = (XMonadFont, String, String, [(String, (Position, Position))])
-> Maybe
     (XMonadFont, String, String, [(String, (Position, Position))])
forall a. a -> Maybe a
Just (XMonadFont
fs,String
ffc,String
fbc, [String]
-> [(Position, Position)] -> [(String, (Position, Position))]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
strs [(Position, Position)]
strPositions)
    Pixel
-> Rectangle
-> ScreenNumber
-> String
-> String
-> Maybe
     (XMonadFont, String, String, [(String, (Position, Position))])
-> Maybe (String, String, [((Position, Position), [[Bool]])])
-> X ()
paintWindow' Pixel
w (Position -> Position -> ScreenNumber -> ScreenNumber -> Rectangle
Rectangle Position
0 Position
0 ScreenNumber
wh ScreenNumber
ht) ScreenNumber
bw String
bc String
borc Maybe
  (XMonadFont, String, String, [(String, (Position, Position))])
ms Maybe (String, String, [((Position, Position), [[Bool]])])
forall a. Maybe a
Nothing

-- | Fill a window with a rectangle and a border, and write
-- | a number of strings and a number of icons to given positions
paintTextAndIcons :: Window      -- ^ The window where to draw
                  -> XMonadFont  -- ^ XMonad Font for drawing
                  -> Dimension   -- ^ Window width
                  -> Dimension   -- ^ Window height
                  -> Dimension   -- ^ Border width
                  -> String      -- ^ Window background color
                  -> String      -- ^ Border color
                  -> String      -- ^ String color
                  -> String      -- ^ String background color
                  -> [Align]     -- ^ String 'Align'ments
                  -> [String]    -- ^ Strings to be printed
                  -> [Placement] -- ^ Icon 'Placements'
                  -> [[[Bool]]]  -- ^ Icons to be printed
                  -> X ()
paintTextAndIcons :: Pixel
-> XMonadFont
-> ScreenNumber
-> ScreenNumber
-> ScreenNumber
-> String
-> String
-> String
-> String
-> [Align]
-> [String]
-> [Placement]
-> [[[Bool]]]
-> X ()
paintTextAndIcons Pixel
w XMonadFont
fs ScreenNumber
wh ScreenNumber
ht ScreenNumber
bw String
bc String
borc String
ffc String
fbc [Align]
als [String]
strs [Placement]
i_als [[[Bool]]]
icons = do
    Display
d <- (XConf -> Display) -> X Display
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Display
display
    [(Position, Position)]
strPositions <- [(Align, String)]
-> ((Align, String) -> X (Position, Position))
-> X [(Position, Position)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM ([Align] -> [String] -> [(Align, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Align]
als [String]
strs) (((Align, String) -> X (Position, Position))
 -> X [(Position, Position)])
-> ((Align, String) -> X (Position, Position))
-> X [(Position, Position)]
forall a b. (a -> b) -> a -> b
$ (Align -> String -> X (Position, Position))
-> (Align, String) -> X (Position, Position)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Display
-> XMonadFont
-> Rectangle
-> Align
-> String
-> X (Position, Position)
forall (m :: * -> *).
(Functor m, MonadIO m) =>
Display
-> XMonadFont
-> Rectangle
-> Align
-> String
-> m (Position, Position)
stringPosition Display
d XMonadFont
fs (Position -> Position -> ScreenNumber -> ScreenNumber -> Rectangle
Rectangle Position
0 Position
0 ScreenNumber
wh ScreenNumber
ht))
    let iconPositions :: [(Position, Position)]
iconPositions = (Placement -> [[Bool]] -> (Position, Position))
-> [Placement] -> [[[Bool]]] -> [(Position, Position)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Rectangle -> Placement -> [[Bool]] -> (Position, Position)
iconPosition (Position -> Position -> ScreenNumber -> ScreenNumber -> Rectangle
Rectangle Position
0 Position
0 ScreenNumber
wh ScreenNumber
ht)) [Placement]
i_als [[[Bool]]]
icons
        ms :: Maybe
  (XMonadFont, String, String, [(String, (Position, Position))])
ms = (XMonadFont, String, String, [(String, (Position, Position))])
-> Maybe
     (XMonadFont, String, String, [(String, (Position, Position))])
forall a. a -> Maybe a
Just (XMonadFont
fs,String
ffc,String
fbc, [String]
-> [(Position, Position)] -> [(String, (Position, Position))]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
strs [(Position, Position)]
strPositions)
        is :: Maybe (String, String, [((Position, Position), [[Bool]])])
is = (String, String, [((Position, Position), [[Bool]])])
-> Maybe (String, String, [((Position, Position), [[Bool]])])
forall a. a -> Maybe a
Just (String
ffc, String
fbc, [(Position, Position)]
-> [[[Bool]]] -> [((Position, Position), [[Bool]])]
forall a b. [a] -> [b] -> [(a, b)]
zip [(Position, Position)]
iconPositions [[[Bool]]]
icons)
    Pixel
-> Rectangle
-> ScreenNumber
-> String
-> String
-> Maybe
     (XMonadFont, String, String, [(String, (Position, Position))])
-> Maybe (String, String, [((Position, Position), [[Bool]])])
-> X ()
paintWindow' Pixel
w (Position -> Position -> ScreenNumber -> ScreenNumber -> Rectangle
Rectangle Position
0 Position
0 ScreenNumber
wh ScreenNumber
ht) ScreenNumber
bw String
bc String
borc Maybe
  (XMonadFont, String, String, [(String, (Position, Position))])
ms Maybe (String, String, [((Position, Position), [[Bool]])])
is

-- This stuff is not exported

-- | Paints a titlebar with some strings and icons
-- drawn inside it.
-- Not exported.
paintWindow' :: Window -> Rectangle -> Dimension -> String -> String
                -> Maybe (XMonadFont,String,String,[(String, (Position, Position))])
                -> Maybe (String, String, [((Position, Position), [[Bool]])]) -> X ()
paintWindow' :: Pixel
-> Rectangle
-> ScreenNumber
-> String
-> String
-> Maybe
     (XMonadFont, String, String, [(String, (Position, Position))])
-> Maybe (String, String, [((Position, Position), [[Bool]])])
-> X ()
paintWindow' Pixel
win (Rectangle Position
_ Position
_ ScreenNumber
wh ScreenNumber
ht) ScreenNumber
bw String
color String
b_color Maybe
  (XMonadFont, String, String, [(String, (Position, Position))])
strStuff Maybe (String, String, [((Position, Position), [[Bool]])])
iconStuff = do
  Display
d  <- (XConf -> Display) -> X Display
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Display
display
  Pixel
p  <- IO Pixel -> X Pixel
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO Pixel -> X Pixel) -> IO Pixel -> X Pixel
forall a b. (a -> b) -> a -> b
$ Display
-> Pixel -> ScreenNumber -> ScreenNumber -> CInt -> IO Pixel
createPixmap Display
d Pixel
win ScreenNumber
wh ScreenNumber
ht (Screen -> CInt
defaultDepthOfScreen (Screen -> CInt) -> Screen -> CInt
forall a b. (a -> b) -> a -> b
$ Display -> Screen
defaultScreenOfDisplay Display
d)
  GC
gc <- IO GC -> X GC
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO GC -> X GC) -> IO GC -> X GC
forall a b. (a -> b) -> a -> b
$ Display -> Pixel -> IO GC
createGC Display
d Pixel
p
  -- draw
  IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ Display -> GC -> Bool -> IO ()
setGraphicsExposures Display
d GC
gc Bool
False
  [Pixel
color',Pixel
b_color'] <- (String -> X Pixel) -> [String] -> X [Pixel]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Display -> String -> X Pixel
forall (m :: * -> *).
(Functor m, MonadIO m) =>
Display -> String -> m Pixel
stringToPixel Display
d) [String
color,String
b_color]
  -- we start with the border
  IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ Display -> GC -> Pixel -> IO ()
setForeground Display
d GC
gc Pixel
b_color'
  IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ Display
-> Pixel
-> GC
-> Position
-> Position
-> ScreenNumber
-> ScreenNumber
-> IO ()
fillRectangle Display
d Pixel
p GC
gc Position
0 Position
0 ScreenNumber
wh ScreenNumber
ht
  -- and now again
  IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ Display -> GC -> Pixel -> IO ()
setForeground Display
d GC
gc Pixel
color'
  IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ Display
-> Pixel
-> GC
-> Position
-> Position
-> ScreenNumber
-> ScreenNumber
-> IO ()
fillRectangle Display
d Pixel
p GC
gc (ScreenNumber -> Position
forall a b. (Integral a, Num b) => a -> b
fi ScreenNumber
bw) (ScreenNumber -> Position
forall a b. (Integral a, Num b) => a -> b
fi ScreenNumber
bw) (ScreenNumber
wh ScreenNumber -> ScreenNumber -> ScreenNumber
forall a. Num a => a -> a -> a
- (ScreenNumber
bw ScreenNumber -> ScreenNumber -> ScreenNumber
forall a. Num a => a -> a -> a
* ScreenNumber
2)) (ScreenNumber
ht ScreenNumber -> ScreenNumber -> ScreenNumber
forall a. Num a => a -> a -> a
- (ScreenNumber
bw ScreenNumber -> ScreenNumber -> ScreenNumber
forall a. Num a => a -> a -> a
* ScreenNumber
2))
  -- paint strings
  Bool -> X () -> X ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe
  (XMonadFont, String, String, [(String, (Position, Position))])
-> Bool
forall a. Maybe a -> Bool
isJust Maybe
  (XMonadFont, String, String, [(String, (Position, Position))])
strStuff) (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$ do
    let (XMonadFont
xmf,String
fc,String
bc,[(String, (Position, Position))]
strAndPos) = Maybe
  (XMonadFont, String, String, [(String, (Position, Position))])
-> (XMonadFont, String, String, [(String, (Position, Position))])
forall a. HasCallStack => Maybe a -> a
fromJust Maybe
  (XMonadFont, String, String, [(String, (Position, Position))])
strStuff
    [(String, (Position, Position))]
-> ((String, (Position, Position)) -> X ()) -> X ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(String, (Position, Position))]
strAndPos (((String, (Position, Position)) -> X ()) -> X ())
-> ((String, (Position, Position)) -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \(String
s, (Position
x, Position
y)) ->
        Display
-> Pixel
-> XMonadFont
-> GC
-> String
-> String
-> Position
-> Position
-> String
-> X ()
forall (m :: * -> *).
(Functor m, MonadIO m) =>
Display
-> Pixel
-> XMonadFont
-> GC
-> String
-> String
-> Position
-> Position
-> String
-> m ()
printStringXMF Display
d Pixel
p XMonadFont
xmf GC
gc String
fc String
bc Position
x Position
y String
s
  -- paint icons
  Bool -> X () -> X ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe (String, String, [((Position, Position), [[Bool]])]) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (String, String, [((Position, Position), [[Bool]])])
iconStuff) (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$ do
    let (String
fc, String
bc, [((Position, Position), [[Bool]])]
iconAndPos) = Maybe (String, String, [((Position, Position), [[Bool]])])
-> (String, String, [((Position, Position), [[Bool]])])
forall a. HasCallStack => Maybe a -> a
fromJust Maybe (String, String, [((Position, Position), [[Bool]])])
iconStuff
    [((Position, Position), [[Bool]])]
-> (((Position, Position), [[Bool]]) -> X ()) -> X ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [((Position, Position), [[Bool]])]
iconAndPos ((((Position, Position), [[Bool]]) -> X ()) -> X ())
-> (((Position, Position), [[Bool]]) -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \((Position
x, Position
y), [[Bool]]
icon) ->
      Display
-> Pixel
-> GC
-> String
-> String
-> Position
-> Position
-> [[Bool]]
-> X ()
forall (m :: * -> *).
(Functor m, MonadIO m) =>
Display
-> Pixel
-> GC
-> String
-> String
-> Position
-> Position
-> [[Bool]]
-> m ()
drawIcon Display
d Pixel
p GC
gc String
fc String
bc Position
x Position
y [[Bool]]
icon
  -- copy the pixmap over the window
  IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ Display
-> Pixel
-> Pixel
-> GC
-> Position
-> Position
-> ScreenNumber
-> ScreenNumber
-> Position
-> Position
-> IO ()
copyArea      Display
d Pixel
p Pixel
win GC
gc Position
0 Position
0 ScreenNumber
wh ScreenNumber
ht Position
0 Position
0
  -- free the pixmap and GC
  IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ Display -> Pixel -> IO ()
freePixmap    Display
d Pixel
p
  IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ Display -> GC -> IO ()
freeGC        Display
d GC
gc

-- | Creates a window with the possibility of setting some attributes.
-- Not exported.
mkWindow :: Display -> Screen -> Window -> Position
         -> Position -> Dimension -> Dimension -> Pixel -> Bool -> IO Window
mkWindow :: Display
-> Screen
-> Pixel
-> Position
-> Position
-> ScreenNumber
-> ScreenNumber
-> Pixel
-> Bool
-> IO Pixel
mkWindow Display
d Screen
s Pixel
rw Position
x Position
y ScreenNumber
w ScreenNumber
h Pixel
p Bool
o = do
  let visual :: Visual
visual = Screen -> Visual
defaultVisualOfScreen Screen
s
      attrmask :: Pixel
attrmask = Pixel
cWOverrideRedirect Pixel -> Pixel -> Pixel
forall a. Bits a => a -> a -> a
.|. Pixel
cWBackPixel Pixel -> Pixel -> Pixel
forall a. Bits a => a -> a -> a
.|. Pixel
cWBorderPixel
  (Ptr SetWindowAttributes -> IO Pixel) -> IO Pixel
forall a. (Ptr SetWindowAttributes -> IO a) -> IO a
allocaSetWindowAttributes ((Ptr SetWindowAttributes -> IO Pixel) -> IO Pixel)
-> (Ptr SetWindowAttributes -> IO Pixel) -> IO Pixel
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 -> Pixel -> IO ()
set_border_pixel      Ptr SetWindowAttributes
attributes Pixel
p
           Ptr SetWindowAttributes -> Pixel -> IO ()
set_background_pixel  Ptr SetWindowAttributes
attributes Pixel
p
           Display
-> Pixel
-> Position
-> Position
-> ScreenNumber
-> ScreenNumber
-> CInt
-> CInt
-> CInt
-> Visual
-> Pixel
-> Ptr SetWindowAttributes
-> IO Pixel
createWindow Display
d Pixel
rw Position
x Position
y ScreenNumber
w ScreenNumber
h CInt
0 (Screen -> CInt
defaultDepthOfScreen Screen
s)
                        CInt
inputOutput Visual
visual Pixel
attrmask Ptr SetWindowAttributes
attributes