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
|
{-# LANGUAGE DeriveAnyClass #-}
-- Layout modifier to flip a layout either horizontally or vertically or both.
module Rahm.Desktop.Layout.Flip
( Flip (..),
flippable,
flipVertically,
flipHorizontally,
DoFlip,
)
where
import Control.Arrow (second)
import Data.List (intercalate)
import XMonad
( Default (..),
LayoutClass (description),
Message,
Rectangle (Rectangle),
fromMessage,
)
import XMonad.Layout.LayoutModifier
( LayoutModifier (modifyDescription, pureMess, pureModifier),
ModifiedLayout (..),
)
-- A flipped layout is either flipped horizontally or vertically.
data Flip a = Flip
{ horiz :: Bool,
vert :: Bool
}
deriving (Eq, Show, Ord, Read)
-- Default instance for Flip. Both are set to false.
instance Default (Flip a) where
def = Flip False False
-- Message for altering the Flip layout modifier.
data DoFlip where
-- Contains a function to modify Flip
DoFlip :: (forall k (a :: k). Flip a -> Flip a) -> DoFlip
deriving (Message)
-- DoFlip is a monoid.
instance Semigroup DoFlip where
(DoFlip a) <> (DoFlip b) = DoFlip (a . b)
instance Monoid DoFlip where
mempty = DoFlip id
mappend = (<>)
-- Makes a layout Flippable.
flippable :: l a -> ModifiedLayout Flip l a
flippable = ModifiedLayout def
-- Message to send a flipVertically message
flipVertically :: DoFlip
flipVertically = DoFlip $ \f -> f {vert = not (vert f)}
-- Message to send a flipHorizontally message.
flipHorizontally :: DoFlip
flipHorizontally = DoFlip $ \f -> f {horiz = not (horiz f)}
instance LayoutModifier Flip a where
-- Modifies the layout. For each rectangle returned from the underlying
-- layout, flip it relative to the screen.
pureModifier flip (Rectangle sx sy sw sh) stack returned =
(map (second doFlip) returned, Nothing)
where
-- doFlip -- the composition of maybe flipping horizontally and
-- vertically.
doFlip =
(if horiz flip then flipHoriz else id)
. (if vert flip then flipVert else id)
flipVert (Rectangle x y w h) =
Rectangle ((sx + fromIntegral sw) - x - fromIntegral w + sx) y w h
flipHoriz (Rectangle x y w h) =
Rectangle x ((sy + fromIntegral sh) - y - fromIntegral h + sy) w h
-- Handle DoFlip messages.
pureMess flip (fromMessage -> Just (DoFlip f)) = Just (f flip)
pureMess _ _ = Nothing
-- Modify the description to show if the layout has been flipped.
modifyDescription flip (description -> descr) =
(++) descr $
if horiz flip || vert flip
then
intercalate
" and "
( map snd $
filter
fst
[ (horiz flip, "Horizontally"),
(vert flip, "Vertically")
]
)
++ " Flipped"
else ""
|
