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
|
-- |
-- Module : XMonad.Actions.FloatSnapSpaced
-- Copyright : (c) 2009 Anders Engstrom <ankaan@gmail.com>
-- License : BSD3-style (see LICENSE)
-- Maintainer : Azat Bahawi <azahi@teknik.io>
-- Stability : unstable
-- Portability : unportable
--
module XMonad.Actions.FloatSnapSpaced
( snapSpacedMagicMove
) where
import Data.List
import Data.Maybe
import Data.Set ( fromList )
import XMonad
import XMonad.Hooks.ManageDocks
import qualified XMonad.StackSet as S
snapSpacedMagicMove :: Int -> Maybe Int -> Maybe Int -> Window -> X ()
snapSpacedMagicMove spacing collidedist snapdist w =
whenX (isClient w) $ withDisplay $ \d -> do
io $ raiseWindow d w
wa <- io $ getWindowAttributes d w
nx <- handleAxis True d wa
ny <- handleAxis False d wa
io $ moveWindow d w (fromIntegral nx) (fromIntegral ny)
float w
where
handleAxis horiz d wa = do
((mbl, mbr, bs), (mfl, mfr, fs)) <- getSnap horiz collidedist d w
return $ if bs || fs
then wpos wa
else
let
b = case (mbl, mbr) of
(Just bl, Just br) ->
if wpos wa - bl < br - wpos wa then bl + spacing else br + spacing
(Just bl, Nothing) -> bl + spacing
(Nothing, Just br) -> br + spacing
(Nothing, Nothing) -> wpos wa + spacing
f = case (mfl, mfr) of
(Just fl, Just fr) ->
if wpos wa + wdim wa - fl < fr - wpos wa - wdim wa
then fl - spacing
else fr - spacing
(Just fl, Nothing) -> fl - spacing
(Nothing, Just fr) -> fr - spacing
(Nothing, Nothing) -> wpos wa - spacing
newpos = if abs (b - wpos wa) <= abs (f - wpos wa - wdim wa)
then b
else f - wdim wa
in
if isNothing snapdist || abs (newpos - wpos wa) <= fromJust snapdist
then newpos
else wpos wa
where (wpos, wdim, _, _) = constructors horiz
getSnap
:: Bool
-> Maybe Int
-> Display
-> Window
-> X ((Maybe Int, Maybe Int, Bool), (Maybe Int, Maybe Int, Bool))
getSnap horiz collidedist d w = do
wa <- io $ getWindowAttributes d w
screen <- S.current <$> gets windowset
let sr = screenRect $ S.screenDetail screen
wl = S.integrate' . S.stack $ S.workspace screen
gr <- fmap ($ sr) $ calcGap $ fromList [minBound .. maxBound]
wla <- filter (collides wa)
<$> io (mapM (getWindowAttributes d) $ filter (/= w) wl)
return
( neighbours (back wa sr gr wla) (wpos wa)
, neighbours (front wa sr gr wla) (wpos wa + wdim wa)
)
where
wborder = fromIntegral . wa_border_width
(wpos , wdim , rpos, rdim) = constructors horiz
(refwpos, refwdim, _ , _ ) = constructors $ not horiz
back wa sr gr wla =
dropWhile (< rpos sr)
$ takeWhile (< rpos sr + rdim sr)
$ sort
$ rpos sr
: rpos gr
: (rpos gr + rdim gr)
: foldr
(\a as -> wpos a : (wpos a + wdim a + wborder a + wborder wa) : as)
[]
wla
front wa sr gr wla =
dropWhile (<= rpos sr)
$ takeWhile (<= rpos sr + rdim sr)
$ sort
$ (rpos gr - 2 * wborder wa)
: (rpos gr + rdim gr - 2 * wborder wa)
: (rpos sr + rdim sr - 2 * wborder wa)
: foldr
(\a as -> (wpos a - wborder a - wborder wa) : (wpos a + wdim a) : as)
[]
wla
neighbours l v =
( listToMaybe $ reverse $ takeWhile (< v) l
, listToMaybe $ dropWhile (<= v) l
, v `elem` l
)
collides wa oa = case collidedist of
Nothing -> True
Just dist ->
refwpos oa
- wborder oa
< refwpos wa
+ refwdim wa
+ wborder wa
+ dist
&& refwpos wa
- wborder wa
- dist
< refwpos oa
+ refwdim oa
+ wborder oa
constructors
:: Bool
-> ( WindowAttributes -> Int
, WindowAttributes -> Int
, Rectangle -> Int
, Rectangle -> Int
)
constructors True =
( fromIntegral . wa_x
, fromIntegral . wa_width
, fromIntegral . rect_x
, fromIntegral . rect_width
)
constructors False =
( fromIntegral . wa_y
, fromIntegral . wa_height
, fromIntegral . rect_y
, fromIntegral . rect_height
)
|
