XMonad/Stockholm/XUtils.hs


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47

module XMonad.Stockholm.XUtils
    ( shapeWindow
    , withGC
    , withPixmap
    , withPixmapAndGC
    ) where

import Control.Exception ( bracket )
import Foreign.C.Types ( CInt )
import Graphics.X11.Xlib
import Graphics.X11.Xlib.Extras
import Graphics.X11.Xshape


shapeWindow :: Display -> Window -> (Pixmap -> GC -> IO ()) -> IO ()
shapeWindow d w f = do
    wa <- getWindowAttributes d w

    let width = fromIntegral $ wa_width wa
        height = fromIntegral $ wa_height wa

    withPixmapAndGC d w width height 1 $ \ p g -> do

        setForeground d g 0
        fillRectangle d p g 0 0 width height

        setForeground d g 1

        f p g

        xshapeCombineMask d w shapeBounding 0 0 p shapeSet


withGC :: Display -> Drawable -> (GC -> IO ()) -> IO ()
withGC d p =
    bracket (createGC d p) (freeGC d)


withPixmap :: Display -> Drawable -> Dimension -> Dimension -> CInt -> (Pixmap -> IO ()) -> IO ()
withPixmap d p w h depth =
    bracket (createPixmap d p w h depth) (freePixmap d)


withPixmapAndGC :: Display -> Drawable -> Dimension -> Dimension -> CInt -> (Pixmap -> GC -> IO ()) -> IO ()
withPixmapAndGC d w width height depth f =
    withPixmap d w width height depth $ \ p ->
        withGC d p $ \ g -> f p g