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
|
{-# 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 XMonad
import XMonad.Layout.LayoutModifier
import Control.Arrow (second)
import Data.List (intercalate)
import Data.Default (Default(..))
-- 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
(<>) = mappend
instance Monoid DoFlip where
mempty = DoFlip id
mappend (DoFlip a) (DoFlip b) = DoFlip (a . b)
-- 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 ""
|
