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
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
|
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Util.XUtils
-- 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
, fi
) where
import Data.Maybe
import XMonad
import XMonad.Util.Font
import XMonad.Util.Image
import Control.Monad
-- $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 p1 p2 f =
do d <- asks display
let cm = defaultColormap d (defaultScreen d)
[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 x1 x2 = round (fromIntegral x1 * f + fromIntegral x2 * (1-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 x y w h) m col o = do
d <- asks 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 em -> io $ selectInput d win em
Nothing -> io $ selectInput d win 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 w = do
d <- asks display
io $ mapWindow d w
-- | the list version
showWindows :: [Window] -> X ()
showWindows = mapM_ showWindow
-- | unmap a window
hideWindow :: Window -> X ()
hideWindow w = do
d <- asks display
io $ unmapWindow d w
-- | the list version
hideWindows :: [Window] -> X ()
hideWindows = mapM_ hideWindow
-- | destroy a window
deleteWindow :: Window -> X ()
deleteWindow w = do
d <- asks display
io $ destroyWindow d w
-- | the list version
deleteWindows :: [Window] -> X ()
deleteWindows = mapM_ 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 w wh ht bw c bc =
paintWindow' w (Rectangle 0 0 wh ht) bw c bc Nothing 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 w fs wh ht bw bc borc ffc fbc als strs = do
d <- asks display
strPositions <- forM (zip als strs) $ \(al, str) ->
stringPosition d fs (Rectangle 0 0 wh ht) al str
let ms = Just (fs,ffc,fbc, zip strs 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 w fs wh ht bw bc borc ffc fbc als strs i_als icons = do
d <- asks display
strPositions <- forM (zip als strs) $ \(al, str) ->
stringPosition d fs (Rectangle 0 0 wh ht) al str
let iconPositions = map ( \(al, icon) -> iconPosition (Rectangle 0 0 wh ht) al icon ) (zip i_als icons)
ms = Just (fs,ffc,fbc, zip strs strPositions)
is = Just (ffc, fbc, zip iconPositions icons)
paintWindow' w (Rectangle 0 0 wh ht) bw bc borc ms 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' win (Rectangle _ _ wh ht) bw color b_color strStuff iconStuff = do
d <- asks 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 $ \(s, (x, y)) ->
printStringXMF d p xmf gc fc bc x y s
-- paint icons
when (isJust iconStuff) $ do
let (fc, bc, iconAndPos) = fromJust iconStuff
forM_ iconAndPos $ \((x, y), icon) ->
drawIcon d p gc fc bc x y 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 d s rw x y w h p o = do
let visual = defaultVisualOfScreen s
attrmask = cWOverrideRedirect .|. cWBackPixel .|. cWBorderPixel
allocaSetWindowAttributes $
\attributes -> do
set_override_redirect attributes o
set_border_pixel attributes p
set_background_pixel attributes p
createWindow d rw x y w h 0 (defaultDepthOfScreen s)
inputOutput visual attrmask attributes
|
