    {-# LANGUAGE CPP             #-}
    {-# LANGUAGE LambdaCase      #-}
    {-# LANGUAGE TupleSections   #-}
    {-# LANGUAGE RecordWildCards #-}
    -----------------------------------------------------------------------------
    -- |
    -- 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
          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 ((.&.))

    -- $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.
    --
    -- This function masks out any alpha channel in the passed pixels, and the
    -- result has no alpha channel. X11 mishandles @Pixel@ values with alpha
    -- channels and throws errors while producing black pixels.
    averagePixels :: Pixel -> Pixel -> Double -> X Pixel
    averagePixels :: Atom -> Atom -> Double -> X Atom
    averagePixels Atom
    p1' Atom
    p2' Double
    f =
        do d <- (XConf -> Display) -> X Display
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks XConf -> Display
    display
           let cm = Display -> Dimension -> Atom
    defaultColormap Display
    d (Display -> Dimension
    defaultScreen Display
    d)
               mask a
    p = a
    p a -> a -> a
    forall a. Bits a => a -> a -> a
    .&. a
    0x00FFFFFF
               p1 = Atom -> Atom
    forall {a}. (Bits a, Num a) => a -> a
    mask Atom
    p1'
               p2 = Atom -> Atom
    forall {a}. (Bits a, Num a) => a -> a
    mask Atom
    p2'
           [Color _ r1 g1 b1 _,Color _ r2 g2 b2 _] <- io $ queryColors d cm [Color p1 0 0 0 0,Color p2 0 0 0 0]
           let mn a
    x1 a
    x2 = Double -> b
    forall b. Integral b => 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 p _ _ _ _ <- io $ allocColor d cm (Color 0 (mn r1 r2) (mn g1 g2) (mn b1 b2) 0)
           return 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 Atom -> String -> Bool -> X Atom
    createNewWindow (Rectangle Position
    x Position
    y Dimension
    w Dimension
    h) Maybe Atom
    m String
    col Bool
    o = do
      d   <- (XConf -> Display) -> X Display
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks XConf -> Display
    display
      rw  <- asks theRoot
      c   <- stringToPixel d col
      win <- io $ mkWindow d (defaultScreenOfDisplay d) rw x y w h c o
      case m of
        Just Atom
    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 -> Atom -> Atom -> IO ()
    selectInput Display
    d Atom
    win Atom
    em
        Maybe Atom
    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 -> Atom -> Atom -> IO ()
    selectInput Display
    d Atom
    win Atom
    exposureMask
      -- @@@ ugly hack to prevent compositing
      whenX (return $ isJust m) $ flip catchX (return ()) $ do
        wINDOW_TYPE <- getAtom "_NET_WM_WINDOW_TYPE"
        dESKTOP <- getAtom "_NET_WM_WINDOW_TYPE_DESKTOP"
        io $ changeProperty32 d win wINDOW_TYPE aTOM propModeReplace [fi dESKTOP]
      return win

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

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

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

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

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

    -- | the list version
    deleteWindows :: [Window] -> X ()
    deleteWindows :: [Atom] -> X ()
    deleteWindows = (Atom -> X ()) -> [Atom] -> X ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ Atom -> 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 :: 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 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 :: 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
        d <- (XConf -> Display) -> X Display
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks XConf -> Display
    display
        strPositions <- forM (zip als strs) $
            uncurry (stringPosition d fs (Rectangle 0 0 wh ht))
        let 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)
        paintWindow' w (Rectangle 0 0 wh ht) bw bc borc ms 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 :: 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
        d <- (XConf -> Display) -> X Display
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks XConf -> Display
    display
        strPositions <- forM (zip als strs) $ uncurry (stringPosition d fs (Rectangle 0 0 wh ht))
        let 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 -> Dimension -> Dimension -> Rectangle
    Rectangle Position
    0 Position
    0 Dimension
    wh Dimension
    ht)) [Placement]
    i_als [[[Bool]]]
    icons
            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 = (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)
        paintWindow' w (Rectangle 0 0 wh ht) bw bc borc ms is

    -- | The config for a window, as interpreted by 'showSimpleWindow'.
    --
    -- The font @winFont@ can either be specified in the TODO format or as an
    -- xft font.  For example:
    --
    -- > winFont = "xft:monospace-20"
    --
    -- or
    --
    -- > winFont = "-misc-fixed-*-*-*-*-20-*-*-*-*-*-*-*"
    data WindowConfig = WindowConfig
      { WindowConfig -> String
    winFont :: !String      -- ^ Font to use.
      , WindowConfig -> String
    winBg   :: !String      -- ^ Background color.
      , WindowConfig -> String
    winFg   :: !String      -- ^ Foreground color.
      , WindowConfig -> WindowRect
    winRect :: !WindowRect  -- ^ Position and size of the rectangle.
      }

    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
        }

    -- | What kind of window we should be.
    data WindowRect
      = CenterWindow         -- ^ Centered, big enough to fit all the text.
      | CustomRect Rectangle -- ^ Completely custom dimensions.

    -- | Create a window, then fill and show it with the given text.  If you
    -- are looking for a version of this function that also takes care of
    -- destroying the window, refer to 'withSimpleWindow'.
    showSimpleWindow :: WindowConfig -- ^ Window config.
                     -> [String]     -- ^ Lines of text to show.
                     -> X Window
    showSimpleWindow :: WindowConfig -> [String] -> X Atom
    showSimpleWindow WindowConfig{String
    WindowRect
    winFont :: WindowConfig -> String
    winBg :: WindowConfig -> String
    winFg :: WindowConfig -> String
    winRect :: WindowConfig -> WindowRect
    winFont :: String
    winBg :: String
    winFg :: String
    winRect :: WindowRect
    ..} [String]
    strs = do
      let pad :: Position
    pad = Position
    20
      font <- String -> X XMonadFont
    initXMF String
    winFont
      dpy  <- asks display
      Rectangle sx sy sw sh <- getRectangle winRect

      -- Text extents for centering all fonts
      extends <- maximum . map (uncurry (+)) <$> traverse (textExtentsXMF font) strs
      -- Height and width of entire window
      height <- pure . fi $ (1 + length strs) * fi extends
      width  <- (+ pad) . fi . maximum <$> traverse (textWidthXMF dpy font) strs

      let -- x and y coordinates that specify the upper left corner of the window
          x = Position
    sx Position -> Position -> Position
    forall a. Num a => a -> a -> a
    + (Dimension -> Position
    forall a b. (Integral a, Num b) => a -> b
    fi Dimension
    sw Position -> Position -> Position
    forall a. Num a => a -> a -> a
    - Position
    width  Position -> Position -> Position
    forall a. Num a => a -> a -> a
    + Position
    2) Position -> Position -> Position
    forall a. Integral a => a -> a -> a
    `div` Position
    2
          y = Position
    sy Position -> Position -> Position
    forall a. Num a => a -> a -> a
    + (Dimension -> Position
    forall a b. (Integral a, Num b) => a -> b
    fi Dimension
    sh Position -> Position -> Position
    forall a. Num a => a -> a -> a
    - Position
    height Position -> Position -> Position
    forall a. Num a => a -> a -> a
    + Position
    2) Position -> Position -> Position
    forall a. Integral a => a -> a -> a
    `div` Position
    2
          -- y position of first string
          yFirst = (Position
    height Position -> Position -> Position
    forall a. Num a => a -> a -> a
    + Position
    2 Position -> Position -> Position
    forall a. Num a => a -> a -> a
    * Position
    extends) Position -> Position -> Position
    forall a. Integral a => a -> a -> a
    `div` Int -> Position
    forall a b. (Integral a, Num b) => a -> b
    fi (Int
    2 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + [String] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [String]
    strs)
          -- (x starting, y starting) for all strings
          strPositions = (Position -> (Position, Position))
    -> [Position] -> [(Position, Position)]
    forall a b. (a -> b) -> [a] -> [b]
    map (Position
    pad Position -> Position -> Position
    forall a. Integral a => a -> a -> a
    `div` Position
    2, ) [Position
    yFirst, Position
    yFirst Position -> Position -> Position
    forall a. Num a => a -> a -> a
    + Position
    extends ..]

      w <- createNewWindow (Rectangle x y (fi width) (fi height)) Nothing "" True
      let ms = (XMonadFont, String, String, [(String, (Position, Position))])
    -> Maybe
         (XMonadFont, String, String, [(String, (Position, Position))])
    forall a. a -> Maybe a
    Just (XMonadFont
    font, String
    winFg, String
    winBg, [String]
    -> [(Position, Position)] -> [(String, (Position, Position))]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [String]
    strs [(Position, Position)]
    strPositions)
      showWindow w
      paintWindow' w (Rectangle 0 0 (fi width) (fi height)) 0 winBg "" ms Nothing
      releaseXMF font
      pure w
     where
      getRectangle :: WindowRect -> X Rectangle
      getRectangle :: WindowRect -> X Rectangle
    getRectangle = \case
        WindowRect
    CenterWindow -> (XState -> Rectangle) -> X Rectangle
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets ((XState -> Rectangle) -> X Rectangle)
    -> (XState -> Rectangle) -> X Rectangle
    forall a b. (a -> b) -> a -> b
    $ ScreenDetail -> Rectangle
    screenRect (ScreenDetail -> Rectangle)
    -> (XState -> ScreenDetail) -> XState -> Rectangle
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Screen String (Layout Atom) Atom ScreenId ScreenDetail
    -> ScreenDetail
    forall i l a sid sd. Screen i l a sid sd -> sd
    W.screenDetail (Screen String (Layout Atom) Atom ScreenId ScreenDetail
     -> ScreenDetail)
    -> (XState
        -> Screen String (Layout Atom) Atom ScreenId ScreenDetail)
    -> XState
    -> ScreenDetail
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StackSet String (Layout Atom) Atom ScreenId ScreenDetail
    -> Screen String (Layout Atom) Atom ScreenId ScreenDetail
    forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
    W.current (StackSet String (Layout Atom) Atom ScreenId ScreenDetail
     -> Screen String (Layout Atom) Atom ScreenId ScreenDetail)
    -> (XState
        -> StackSet String (Layout Atom) Atom ScreenId ScreenDetail)
    -> XState
    -> Screen String (Layout Atom) Atom ScreenId ScreenDetail
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . XState -> StackSet String (Layout Atom) Atom ScreenId ScreenDetail
    windowset
        CustomRect Rectangle
    r -> Rectangle -> X Rectangle
    forall a. a -> X a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Rectangle
    r

    -- | Like 'showSimpleWindow', but fully manage the window; i.e., destroy
    -- it after the given function finishes its execution.
    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
      w <- WindowConfig -> [String] -> X Atom
    showSimpleWindow WindowConfig
    wc [String]
    strs
      doStuff <* withDisplay (io . (`destroyWindow` w))

    -- 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' :: 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
      d  <- (XConf -> Display) -> X Display
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks XConf -> Display
    display
      p  <- io $ createPixmap d win wh ht (defaultDepthOfScreen $ defaultScreenOfDisplay d)
      gc <- io $ createGC d p
      -- draw
      io $ setGraphicsExposures d gc False
      [color',b_color'] <- mapM (stringToPixel d) [color,b_color]
      -- we start with the border
      io $ setForeground d gc b_color'
      io $ fillRectangle d p gc 0 0 wh ht
      -- and now again
      io $ setForeground d gc color'
      io $ fillRectangle d p gc (fi bw) (fi bw) (wh - (bw * 2)) (ht - (bw * 2))
      -- paint strings
      when (isJust strStuff) $ do
        let (xmf,fc,bc,strAndPos) = fromJust strStuff
        forM_ strAndPos $ \(String
    s, (Position
    x, Position
    y)) ->
            Display
    -> Atom
    -> XMonadFont
    -> GC
    -> String
    -> String
    -> Position
    -> Position
    -> String
    -> X ()
    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
      -- paint icons
      when (isJust iconStuff) $ do
        let (fc, bc, iconAndPos) = fromJust iconStuff
        forM_ iconAndPos $ \((Position
    x, Position
    y), [[Bool]]
    icon) ->
          Display
    -> Atom
    -> GC
    -> String
    -> String
    -> Position
    -> Position
    -> [[Bool]]
    -> X ()
    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
      -- copy the pixmap over the window
      io $ copyArea      d p win gc 0 0 wh ht 0 0
      -- free the pixmap and GC
      io $ freePixmap    d p
      io $ freeGC        d 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
    -> 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 Atom -> Atom -> Atom
    forall a. Bits a => a -> a -> a
    .|. Atom
    cWBackPixel Atom -> Atom -> Atom
    forall a. Bits a => a -> a -> a
    .|. Atom
    cWBorderPixel
      (Ptr SetWindowAttributes -> IO Atom) -> IO Atom
    forall a. (Ptr SetWindowAttributes -> IO a) -> IO a
    allocaSetWindowAttributes ((Ptr SetWindowAttributes -> IO Atom) -> IO Atom)
    -> (Ptr SetWindowAttributes -> IO Atom) -> IO Atom
    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