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
104
105
106
107
108
109
110
111
112
113
|
{-# LANGUAGE DeriveAnyClass, TypeOperators #-}
module Rahm.Desktop.Layout.Explode where
import Control.Arrow (Arrow (second))
import Data.Foldable (minimumBy, Foldable (toList))
import Data.Ord (comparing)
import qualified Rahm.Desktop.StackSet as W
import qualified XMonad.StackSet as W
import XMonad
import Rahm.Desktop.PopupTerminal
data Explodeable (l :: * -> *) (a :: *) = Explodeable
{ isExploded :: Bool,
wrap :: l a
}
deriving (Show, Read, Eq, Ord)
data ExplodeMessage where
ExplodeMessage :: (forall l a. Explodeable l a -> X (Explodeable l a)) -> ExplodeMessage
deriving (Message)
explodeable :: l a -> Explodeable l a
explodeable = Explodeable False
toggleExplodeM :: X () -> X () -> ExplodeMessage
toggleExplodeM onTrue onFalse =
ExplodeMessage $ \(Explodeable b l) -> do
if b then onFalse else onTrue
return $ Explodeable (not b) l
toggleExplode :: ExplodeMessage
toggleExplode = ExplodeMessage $ \(Explodeable b l) -> return $ Explodeable (not b) l
instance (LayoutClass l a, a ~ Window) => LayoutClass (Explodeable l) a where
runLayout
(W.Workspace t (Explodeable True l) stack')
rect@(Rectangle x y w h) = do
maybeWin <- getPopupTerminalWindow
let winRect = (,popRect) <$> maybeWin
let stack = W.filter ((/=maybeWin) . Just) =<< stack'
(returned, maybeNewLayout) <- runLayout (W.Workspace t l stack) rect
let (cx, cy) = (x + (fi w `div` 2), y + (fi h `div` 2))
newReturned =
map
( second $ \(Rectangle rx ry rw rh) ->
let (rcx, rcy) = (rx + (fi rw `div` 2), ry + (fi rh `div` 2))
(dx, dy) = norm (rcx - cx, rcy - cy)
(x', y') = calcNewPoint (fi rcx, fi rcy) (fi cx, fi cy) rect
in Rectangle
(round (x' - (fi rcx - fi rx) + (fi w * dx) / 10))
(round (y' - (fi rcy - fi ry) + (fi h * dy) / 10))
rw
rh
)
returned
return (toList winRect ++ newReturned, Explodeable True <$> maybeNewLayout)
where
wp = floor $ fromIntegral w * 0.10
hp = floor $ fromIntegral h * 0.10
popRect =
Rectangle
(x + wp)
(y + hp)
(w - fromIntegral (wp * 2))
(h - fromIntegral (hp * 2))
fi :: (Integral a, Num b) => a -> b
fi = fromIntegral
norm :: (Integral a, Integral b) => (a, b) -> (Float, Float)
norm (fromIntegral -> x, fromIntegral -> y) = let d = sqrt (x ** 2 + y ** 2) in (x / d, y / d)
calcNewPoint (rcx, rcy) (cx, cy) (Rectangle x y w h) =
let (dx, dy) = (rcx - cx, rcy - cy)
s = dy / dx
x1, y1, x2, y2, x3, y3, x4, y4 :: Float
x1 = fi x
y1 = s * x1 + rcy - s * rcx + fi y
x2 = fi (x + fi w)
y2 = s * x2 + rcy - s * rcx + fi y
y3 = fi y
x3 = (y3 + s * rcx - rcy) / s
y4 = fi (y + fi h)
x4 = (y4 + s * rcx - rcy) / s
points = [(x1, y1), (x2, y2), (x3, y3), (x4, y4)]
in minimumBy
( comparing
( \(x1, y1) ->
(x1 - rcx) ** 2 + (y1 - rcy) ** 2
)
)
points
runLayout (W.Workspace t (Explodeable b l) a) rect = do
(rects, maybeNewLayout) <- runLayout (W.Workspace t l a) rect
return (rects, Explodeable b <$> maybeNewLayout)
-- If the message is a ExplodeMessage, handle that here.
handleMessage p (fromMessage -> Just (ExplodeMessage f)) =
Just <$> f p
-- By default just pass the message to the underlying layout.
handleMessage (Explodeable b l) mess = do
maybeNewLayout <- handleMessage l mess
return (Explodeable b <$> maybeNewLayout)
|
