blob: 8a8583a33ac6d67d496a5b4e01cfc87e0599bfaa (
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
|
{-# 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 XMonad
import XMonad.Layout.LayoutModifier
import Data.Default (Default(..))
import Control.Arrow (second)
-- 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
|
