blob: e6f9a64340c8a755d69e58b57cc75b26e452f1ba (
plain) (
blame)
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
|
{-# LANGUAGE DeriveAnyClass #-}
-- Layout modifier which optionally rotates the underlying layout. This actually
-- uses the mirrorRect, so it's not strictly rotating, but when combined with
-- flipping it works.
module Rahm.Desktop.Layout.Rotate
( rotateable,
rotateLayout,
Rotate,
)
where
import Control.Arrow (second)
import Data.Default (Default (..))
import XMonad
import XMonad.Layout.LayoutModifier
-- Just a wrapper over a Bool.
newtype Rotate a = Rotate Bool
deriving (Read, Show, Eq, Ord)
-- Returns a layout that can be rotated.
rotateable :: l a -> ModifiedLayout Rotate l a
rotateable = ModifiedLayout def
-- Message to rotate the layout.
rotateLayout :: RotateMessage
rotateLayout = RotateMessage $ \(Rotate n) -> Rotate (not n)
-- Default instance just defaults to false..
instance Default (Rotate a) where
def = Rotate False
-- Rotate message is a wrapper over a function to modify a Rotate instance.
data RotateMessage where
RotateMessage :: (forall k (a :: k). Rotate a -> Rotate a) -> RotateMessage
deriving (Message)
instance (Eq a) => LayoutModifier Rotate a where
pureModifier (Rotate rotate) (Rectangle x' y' sw sh) _ returned =
if rotate
then (map (second (unzero . scaleRect . mirrorRect . zero)) returned, Nothing)
else (returned, Nothing)
where
zero (Rectangle x y w h) = Rectangle (x - x') (y - y') w h
unzero (Rectangle x y w h) = Rectangle (x + x') (y + y') w h
scaleRect (Rectangle x y w h) =
Rectangle
(x * fi sw `div` fi sh)
(y * fi sh `div` fi sw)
(w * sw `div` sh)
(h * sh `div` sw)
fi = fromIntegral
pureMess r (fromMessage -> Just (RotateMessage f)) = Just (f r)
pureMess _ _ = Nothing
modifyDescription (Rotate rot) underlying =
let descr = description underlying
in if rot
then descr ++ " Rotated"
else descr
|
