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
|
module Rahm.Desktop.Dzen.WorkspaceSelect where
import Control.Arrow (Arrow (first, second))
import Control.Concurrent (threadDelay)
import Control.Monad.Trans.Maybe (MaybeT (runMaybeT))
import Data.Function (fix)
import Data.List (find, sortBy)
import Data.Ord (comparing)
import Data.Word
import qualified Graphics.X11 as X
import Rahm.Desktop.Common (gotoWorkspace)
import Rahm.Desktop.StackSet as W
import Rahm.Desktop.Submap (ButtonOrKeyEvent (ButtonPress), nextButton, nextButtonOrKeyEvent)
import System.IO
import Text.Printf (printf)
import XMonad
import XMonad.Util.Run (spawnPipe)
dzenSize :: (Integral a) => a
dzenSize = 100
data ScreenType = Current | Visible | Hidden
displayDzenSelection :: X ()
displayDzenSelection = do
(W.StackSet cur vis other _floating) <- gets windowset
let allWorkspaces :: [(W.Workspace WorkspaceId (Layout Window) Window, ScreenType)]
allWorkspaces =
sortBy (comparing (W.tag . fst)) $
filter (not . null . W.integrate' . W.stack . fst) $
((W.workspace cur, Current) : map ((,Visible) . W.workspace) vis) ++ map (,Hidden) other
(SD rect) = W.screenDetail cur
dzenRects = calculatePositions rect allWorkspaces
rectsToWorkspaces = map (second (first W.tag)) dzenRects
dzenPipes <- mapM (uncurry launchDzen) rectsToWorkspaces
fix $ \retry -> do
evt <- runMaybeT nextButtonOrKeyEvent
case evt of
Nothing -> return () -- timeout
Just (ButtonPress _ b) | b == button1 -> do
withDisplay $ \d -> do
(_, _, _, fi -> cx, fi -> cy, _, _, _) <-
io $ X.queryPointer d =<< rootWindow d 0
case find (\(r, _) -> pointWithin cx cy r) rectsToWorkspaces of
Just (_, (ws, _)) -> gotoWorkspace ws
Nothing -> return ()
_ -> retry
io $ do
mapM_ hClose dzenPipes
return ()
where
fi :: (Integral a, Integral b) => a -> b
fi = fromIntegral
toInt :: (Integral a) => a -> Int
toInt = fromIntegral
-- Returns, starting x, dzen width
calculatePositions :: Rectangle -> [a] -> [(Rectangle, a)]
calculatePositions (Rectangle (toInt -> x) (toInt -> y) (toInt -> w) (toInt -> h)) as =
let nas = length as
cellSize = (w `div` nas)
y' = fi $ (h `div` 2) - (toInt cellSize `div` 2)
sz = min 200 (cellSize * 9 `div` 10)
in zipWith
(\x' a -> (embedRectangle (Rectangle (fi x') (fi y') (fi cellSize) (fi cellSize)) sz sz, a))
[x, x + cellSize ..]
as
embedRectangle :: Rectangle -> Int -> Int -> Rectangle
embedRectangle r@(Rectangle x y w h) w' h' | w' > fi w || h' > fi h = r
embedRectangle (Rectangle x y w h) w' h' =
Rectangle
(x + fi (w `div` 2) - fi (w' `div` 2))
(y + fi (h `div` 2) - fi (h' `div` 2))
(fi w')
(fi h')
launchDzen :: Rectangle -> (String, ScreenType) -> X Handle
launchDzen (Rectangle x y w h) (wsTag, screenType) = do
pipe <-
spawnPipe
( printf
"dzen2 -fn \"Monofur Nerd Font:size=15:style=bold\" -x %d -y %d -w %d -h %d -bg '%s' -fg '#000000'"
x
y
w
h
( case screenType of
Current -> "#ff8888"
Visible -> "#8888ff"
Hidden -> "#888888"
)
)
io $ do
hPutStrLn pipe wsTag
hFlush pipe
return pipe
|
