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
|
{-# LANGUAGE DeriveAnyClass #-}
-- | The Pap layout modifier allows the user to "pop" the focused window into a
-- frame in the middle of the screen, sort of like fullscreen, but only taking
-- up a percentage of the screen rather than the whole screen so other windows
-- are still visible, alebeit typically not usable.
module Rahm.Desktop.Layout.Pop
( Poppable (..),
PopMessage (..),
poppable,
resizePop,
togglePop,
setPop,
)
where
import qualified Rahm.Desktop.StackSet as W
( Stack (focus),
Workspace (Workspace),
)
import XMonad
( LayoutClass (handleMessage, runLayout),
Message,
Rectangle (Rectangle),
Resize (Expand, Shrink),
SomeMessage (SomeMessage),
fromMessage,
)
data Poppable (l :: * -> *) (a :: *) = Poppable
{ -- True if the current window is popped out or not.
isPopped :: Bool,
-- Fraction of the screen width around the window.
xFrac :: Float,
-- Fraction of the screen height around the window.
yFrac :: Float,
wrap :: l a
}
deriving (Show, Read, Eq, Ord)
data PopMessage where
PopMessage :: (forall l a. Poppable l a -> Poppable l a) -> PopMessage
deriving (Message)
resizePop :: Float -> PopMessage
resizePop f = PopMessage $ \(Poppable b x y l) ->
Poppable b (g $ x + f) (g $ y + f) l
where
g = max 0 . min 0.45
setPop :: (Bool -> Bool) -> PopMessage
setPop f = PopMessage $ \(Poppable b x y l) -> Poppable (f b) x y l
togglePop :: PopMessage
togglePop = setPop not
poppable :: l a -> Poppable l a
poppable = Poppable False 0.05 0.05
instance (LayoutClass l a, Eq a) => LayoutClass (Poppable l) a where
-- If the current layout is not popped, then just return what the underlying
-- layout returned.
runLayout
( W.Workspace
t
(Poppable True xs ys l)
a@(Just (W.focus -> focused))
)
rect@(Rectangle x y w h) = do
(returned, maybeNewLayout) <- runLayout (W.Workspace t l a) rect
return
( (focused, newRect) : filter ((/= focused) . fst) returned,
Poppable True xs ys <$> maybeNewLayout
)
where
wp = floor $ fromIntegral w * xs
hp = floor $ fromIntegral h * ys
newRect =
Rectangle
(x + wp)
(y + hp)
(w - fromIntegral (wp * 2))
(h - fromIntegral (hp * 2))
-- If the pop is not active, just delegate to the underlying layout.
runLayout (W.Workspace t (Poppable b x y l) a) rect = do
(rects, maybeNewLayout) <- runLayout (W.Workspace t l a) rect
return (rects, Poppable b x y <$> maybeNewLayout)
-- If the message is a PopMessage, handle that here.
handleMessage p (fromMessage -> Just (PopMessage f)) =
return $ Just $ f p
-- Intercept Shrink/Expand message if the pop is active, and resize the
-- pop size.
handleMessage p (fromMessage -> Just mess) | isPopped p =
case mess of
Shrink -> handleMessage p (SomeMessage $ resizePop 0.025)
Expand -> handleMessage p (SomeMessage $ resizePop (-0.025))
-- By default just pass the message to the underlying layout.
handleMessage (Poppable b x y l) mess = do
maybeNewLayout <- handleMessage l mess
return (Poppable b x y <$> maybeNewLayout)
|
