{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
module XMonad.Layout.Dwindle (
Dwindle(..)
, Direction2D(..)
, Chirality(..)
) where
import XMonad.Prelude ( unfoldr )
import XMonad
import XMonad.StackSet ( integrate, Stack )
import XMonad.Util.Types ( Direction2D(..) )
data Dwindle a = Dwindle !Direction2D !Chirality !Rational !Rational
| Spiral !Direction2D !Chirality !Rational !Rational
| Squeeze !Direction2D !Rational !Rational
deriving (ReadPrec [Dwindle a]
ReadPrec (Dwindle a)
ReadS [Dwindle a]
forall a. ReadPrec [Dwindle a]
forall a. ReadPrec (Dwindle a)
forall a. Int -> ReadS (Dwindle a)
forall a. ReadS [Dwindle a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Dwindle a]
$creadListPrec :: forall a. ReadPrec [Dwindle a]
readPrec :: ReadPrec (Dwindle a)
$creadPrec :: forall a. ReadPrec (Dwindle a)
readList :: ReadS [Dwindle a]
$creadList :: forall a. ReadS [Dwindle a]
readsPrec :: Int -> ReadS (Dwindle a)
$creadsPrec :: forall a. Int -> ReadS (Dwindle a)
Read, Int -> Dwindle a -> ShowS
forall a. Int -> Dwindle a -> ShowS
forall a. [Dwindle a] -> ShowS
forall a. Dwindle a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Dwindle a] -> ShowS
$cshowList :: forall a. [Dwindle a] -> ShowS
show :: Dwindle a -> String
$cshow :: forall a. Dwindle a -> String
showsPrec :: Int -> Dwindle a -> ShowS
$cshowsPrec :: forall a. Int -> Dwindle a -> ShowS
Show)
data Chirality = CW | CCW
deriving (ReadPrec [Chirality]
ReadPrec Chirality
Int -> ReadS Chirality
ReadS [Chirality]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Chirality]
$creadListPrec :: ReadPrec [Chirality]
readPrec :: ReadPrec Chirality
$creadPrec :: ReadPrec Chirality
readList :: ReadS [Chirality]
$creadList :: ReadS [Chirality]
readsPrec :: Int -> ReadS Chirality
$creadsPrec :: Int -> ReadS Chirality
Read, Int -> Chirality -> ShowS
[Chirality] -> ShowS
Chirality -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Chirality] -> ShowS
$cshowList :: [Chirality] -> ShowS
show :: Chirality -> String
$cshow :: Chirality -> String
showsPrec :: Int -> Chirality -> ShowS
$cshowsPrec :: Int -> Chirality -> ShowS
Show)
instance LayoutClass Dwindle a where
pureLayout :: Dwindle a -> Rectangle -> Stack a -> [(a, Rectangle)]
pureLayout (Dwindle Direction2D
dir Chirality
rot Rational
ratio Rational
_) = forall a.
AxesGenerator
-> Direction2D
-> Chirality
-> Rational
-> Rectangle
-> Stack a
-> [(a, Rectangle)]
dwindle AxesGenerator
alternate Direction2D
dir Chirality
rot Rational
ratio
pureLayout (Spiral Direction2D
dir Chirality
rot Rational
ratio Rational
_) = forall a.
AxesGenerator
-> Direction2D
-> Chirality
-> Rational
-> Rectangle
-> Stack a
-> [(a, Rectangle)]
dwindle AxesGenerator
rotate Direction2D
dir Chirality
rot Rational
ratio
pureLayout (Squeeze Direction2D
dir Rational
ratio Rational
_) = forall a.
Direction2D -> Rational -> Rectangle -> Stack a -> [(a, Rectangle)]
squeeze Direction2D
dir Rational
ratio
pureMessage :: Dwindle a -> SomeMessage -> Maybe (Dwindle a)
pureMessage (Dwindle Direction2D
dir Chirality
rot Rational
ratio Rational
delta) =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Rational
ratio' -> forall a.
Direction2D -> Chirality -> Rational -> Rational -> Dwindle a
Dwindle Direction2D
dir Chirality
rot Rational
ratio' Rational
delta) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Rational -> SomeMessage -> Maybe Rational
changeRatio Rational
ratio Rational
delta
pureMessage (Spiral Direction2D
dir Chirality
rot Rational
ratio Rational
delta) =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Rational
ratio' -> forall a.
Direction2D -> Chirality -> Rational -> Rational -> Dwindle a
Spiral Direction2D
dir Chirality
rot Rational
ratio' Rational
delta) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Rational -> SomeMessage -> Maybe Rational
changeRatio Rational
ratio Rational
delta
pureMessage (Squeeze Direction2D
dir Rational
ratio Rational
delta) =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Rational
ratio' -> forall a. Direction2D -> Rational -> Rational -> Dwindle a
Squeeze Direction2D
dir Rational
ratio' Rational
delta) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Rational -> SomeMessage -> Maybe Rational
changeRatio Rational
ratio Rational
delta
changeRatio :: Rational -> Rational -> SomeMessage -> Maybe Rational
changeRatio :: Rational -> Rational -> SomeMessage -> Maybe Rational
changeRatio Rational
ratio Rational
delta = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Resize -> Rational
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Message m => SomeMessage -> Maybe m
fromMessage
where f :: Resize -> Rational
f Resize
Expand = Rational
ratio forall a. Num a => a -> a -> a
* Rational
delta
f Resize
Shrink = Rational
ratio forall a. Fractional a => a -> a -> a
/ Rational
delta
dwindle :: AxesGenerator -> Direction2D -> Chirality -> Rational -> Rectangle -> Stack a ->
[(a, Rectangle)]
dwindle :: forall a.
AxesGenerator
-> Direction2D
-> Chirality
-> Rational
-> Rectangle
-> Stack a
-> [(a, Rectangle)]
dwindle AxesGenerator
trans Direction2D
dir Chirality
rot Rational
ratio Rectangle
rect Stack a
st = forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr forall {a}.
([a], Rectangle, (Int, Int), Chirality)
-> Maybe ((a, Rectangle), ([a], Rectangle, (Int, Int), Chirality))
genRects (forall a. Stack a -> [a]
integrate Stack a
st, Rectangle
rect, Direction2D -> (Int, Int)
dirAxes Direction2D
dir, Chirality
rot)
where genRects :: ([a], Rectangle, (Int, Int), Chirality)
-> Maybe ((a, Rectangle), ([a], Rectangle, (Int, Int), Chirality))
genRects ([], Rectangle
_, (Int, Int)
_, Chirality
_ ) = forall a. Maybe a
Nothing
genRects ([a
w], Rectangle
r, (Int, Int)
a, Chirality
rt) = forall a. a -> Maybe a
Just ((a
w, Rectangle
r), ([], Rectangle
r, (Int, Int)
a, Chirality
rt))
genRects (a
w:[a]
ws, Rectangle
r, (Int, Int)
a, Chirality
rt) = forall a. a -> Maybe a
Just ((a
w, Rectangle
r'), ([a]
ws, Rectangle
r'', (Int, Int)
a', Chirality
rt'))
where (Rectangle
r', Rectangle
r'') = Rectangle -> Rational -> (Int, Int) -> (Rectangle, Rectangle)
splitRect Rectangle
r Rational
ratio (Int, Int)
a
((Int, Int)
a', Chirality
rt') = AxesGenerator
trans (Int, Int)
a Chirality
rt
squeeze :: Direction2D -> Rational -> Rectangle -> Stack a -> [(a, Rectangle)]
squeeze :: forall a.
Direction2D -> Rational -> Rectangle -> Stack a -> [(a, Rectangle)]
squeeze Direction2D
dir Rational
ratio Rectangle
rect Stack a
st = forall a b. [a] -> [b] -> [(a, b)]
zip [a]
wins [Rectangle]
rects
where wins :: [a]
wins = forall a. Stack a -> [a]
integrate Stack a
st
nwins :: Int
nwins = forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
wins
sizes :: [Rational]
sizes = forall a. Int -> [a] -> [a]
take Int
nwins forall a b. (a -> b) -> a -> b
$ forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr (\Rational
r -> forall a. a -> Maybe a
Just (Rational
r forall a. Num a => a -> a -> a
* Rational
ratio, Rational
r forall a. Num a => a -> a -> a
* Rational
ratio)) Rational
1
totals' :: [Rational]
totals' = Rational
0 forall a. a -> [a] -> [a]
: forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a. Num a => a -> a -> a
(+) [Rational]
sizes [Rational]
totals'
totals :: [Rational]
totals = forall a. Int -> [a] -> [a]
drop Int
1 [Rational]
totals'
splits :: [(Rational, Rational)]
splits = forall a b. [a] -> [b] -> [(a, b)]
zip (forall a. Int -> [a] -> [a]
drop Int
1 [Rational]
sizes) [Rational]
totals
ratios :: [Rational]
ratios = forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Fractional a => a -> a -> a
(/)) [(Rational, Rational)]
splits
rects :: [Rectangle]
rects = Rectangle -> [Rational] -> [Rectangle]
genRects Rectangle
rect [Rational]
ratios
genRects :: Rectangle -> [Rational] -> [Rectangle]
genRects Rectangle
r [] = [Rectangle
r]
genRects Rectangle
r (Rational
x:[Rational]
xs) = Rectangle
r' forall a. a -> [a] -> [a]
: Rectangle -> [Rational] -> [Rectangle]
genRects Rectangle
r'' [Rational]
xs
where (Rectangle
r', Rectangle
r'') = Rectangle -> Rational -> (Int, Int) -> (Rectangle, Rectangle)
splitRect Rectangle
r Rational
x (Direction2D -> (Int, Int)
dirAxes Direction2D
dir)
splitRect :: Rectangle -> Rational -> Axes -> (Rectangle, Rectangle)
splitRect :: Rectangle -> Rational -> (Int, Int) -> (Rectangle, Rectangle)
splitRect (Rectangle Position
x Position
y Dimension
w Dimension
h) Rational
ratio (Int
ax, Int
ay) = (Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
x' Position
y' Dimension
w' Dimension
h', Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
x'' Position
y'' Dimension
w'' Dimension
h'')
where portion :: Rational
portion = Rational
ratio forall a. Fractional a => a -> a -> a
/ (Rational
ratio forall a. Num a => a -> a -> a
+ Rational
1)
w1 :: Int
w1 = (forall a b. (RealFrac a, Integral b) => a -> b
round forall a b. (a -> b) -> a -> b
$ forall b a. (Num b, Integral a) => a -> b
fi Dimension
w forall a. Num a => a -> a -> a
* Rational
portion) :: Int
w2 :: Int
w2 = forall b a. (Num b, Integral a) => a -> b
fi Dimension
w forall a. Num a => a -> a -> a
- Int
w1
h1 :: Int
h1 = (forall a b. (RealFrac a, Integral b) => a -> b
round forall a b. (a -> b) -> a -> b
$ forall b a. (Num b, Integral a) => a -> b
fi Dimension
h forall a. Num a => a -> a -> a
* Rational
portion) :: Int
h2 :: Int
h2 = forall b a. (Num b, Integral a) => a -> b
fi Dimension
h forall a. Num a => a -> a -> a
- Int
h1
x' :: Position
x' = Position
x forall a. Num a => a -> a -> a
+ forall b a. (Num b, Integral a) => a -> b
fi (forall a. Num a => a -> a
negate Int
ax forall a. Num a => a -> a -> a
* (Int
1 forall a. Num a => a -> a -> a
- Int
ax) forall a. Num a => a -> a -> a
* Int
w2 forall a. Integral a => a -> a -> a
`div` Int
2)
y' :: Position
y' = Position
y forall a. Num a => a -> a -> a
+ forall b a. (Num b, Integral a) => a -> b
fi (forall a. Num a => a -> a
negate Int
ay forall a. Num a => a -> a -> a
* (Int
1 forall a. Num a => a -> a -> a
- Int
ay) forall a. Num a => a -> a -> a
* Int
h2 forall a. Integral a => a -> a -> a
`div` Int
2)
w' :: Dimension
w' = forall b a. (Num b, Integral a) => a -> b
fi forall a b. (a -> b) -> a -> b
$ Int
w1 forall a. Num a => a -> a -> a
+ (Int
1 forall a. Num a => a -> a -> a
- forall a. Num a => a -> a
abs Int
ax) forall a. Num a => a -> a -> a
* Int
w2
h' :: Dimension
h' = forall b a. (Num b, Integral a) => a -> b
fi forall a b. (a -> b) -> a -> b
$ Int
h1 forall a. Num a => a -> a -> a
+ (Int
1 forall a. Num a => a -> a -> a
- forall a. Num a => a -> a
abs Int
ay) forall a. Num a => a -> a -> a
* Int
h2
x'' :: Position
x'' = Position
x forall a. Num a => a -> a -> a
+ forall b a. (Num b, Integral a) => a -> b
fi (Int
ax forall a. Num a => a -> a -> a
* (Int
1 forall a. Num a => a -> a -> a
+ Int
ax) forall a. Num a => a -> a -> a
* Int
w1 forall a. Integral a => a -> a -> a
`div` Int
2)
y'' :: Position
y'' = Position
y forall a. Num a => a -> a -> a
+ forall b a. (Num b, Integral a) => a -> b
fi (Int
ay forall a. Num a => a -> a -> a
* (Int
1 forall a. Num a => a -> a -> a
+ Int
ay) forall a. Num a => a -> a -> a
* Int
h1 forall a. Integral a => a -> a -> a
`div` Int
2)
w'' :: Dimension
w'' = forall b a. (Num b, Integral a) => a -> b
fi forall a b. (a -> b) -> a -> b
$ Int
w2 forall a. Num a => a -> a -> a
+ (Int
1 forall a. Num a => a -> a -> a
- forall a. Num a => a -> a
abs Int
ax) forall a. Num a => a -> a -> a
* Int
w1
h'' :: Dimension
h'' = forall b a. (Num b, Integral a) => a -> b
fi forall a b. (a -> b) -> a -> b
$ Int
h2 forall a. Num a => a -> a -> a
+ (Int
1 forall a. Num a => a -> a -> a
- forall a. Num a => a -> a
abs Int
ay) forall a. Num a => a -> a -> a
* Int
h1
fi :: (Num b, Integral a) => a -> b
fi :: forall b a. (Num b, Integral a) => a -> b
fi = forall a b. (Integral a, Num b) => a -> b
fromIntegral
type Axes = (Int, Int)
type AxesGenerator = Axes -> Chirality -> (Axes, Chirality)
dirAxes :: Direction2D -> Axes
dirAxes :: Direction2D -> (Int, Int)
dirAxes Direction2D
L = (-Int
1, Int
0)
dirAxes Direction2D
R = ( Int
1, Int
0)
dirAxes Direction2D
U = ( Int
0, -Int
1)
dirAxes Direction2D
D = ( Int
0, Int
1)
alternate :: AxesGenerator
alternate :: AxesGenerator
alternate = (Chirality -> Chirality) -> AxesGenerator
chDir Chirality -> Chirality
alt
rotate :: AxesGenerator
rotate :: AxesGenerator
rotate = (Chirality -> Chirality) -> AxesGenerator
chDir forall a. a -> a
id
chDir :: (Chirality -> Chirality) -> AxesGenerator
chDir :: (Chirality -> Chirality) -> AxesGenerator
chDir Chirality -> Chirality
f (Int
x, Int
y) Chirality
r = (Chirality -> (Int, Int)
a' Chirality
r, Chirality
r')
where a' :: Chirality -> (Int, Int)
a' Chirality
CW = (-Int
y, Int
x)
a' Chirality
CCW = ( Int
y, -Int
x)
r' :: Chirality
r' = Chirality -> Chirality
f Chirality
r
alt :: Chirality -> Chirality
alt :: Chirality -> Chirality
alt Chirality
CW = Chirality
CCW
alt Chirality
CCW = Chirality
CW