{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, FlexibleContexts #-}
module XMonad.Layout.AutoMaster (
autoMaster, AutoMaster
) where
import XMonad
import XMonad.Layout.LayoutModifier
import XMonad.Prelude
import qualified XMonad.StackSet as W
import Control.Arrow (first)
data AutoMaster a = AutoMaster Int Float Float
deriving (ReadPrec [AutoMaster a]
ReadPrec (AutoMaster a)
ReadS [AutoMaster a]
forall a. ReadPrec [AutoMaster a]
forall a. ReadPrec (AutoMaster a)
forall a. Int -> ReadS (AutoMaster a)
forall a. ReadS [AutoMaster a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AutoMaster a]
$creadListPrec :: forall a. ReadPrec [AutoMaster a]
readPrec :: ReadPrec (AutoMaster a)
$creadPrec :: forall a. ReadPrec (AutoMaster a)
readList :: ReadS [AutoMaster a]
$creadList :: forall a. ReadS [AutoMaster a]
readsPrec :: Int -> ReadS (AutoMaster a)
$creadsPrec :: forall a. Int -> ReadS (AutoMaster a)
Read,Int -> AutoMaster a -> ShowS
forall a. Int -> AutoMaster a -> ShowS
forall a. [AutoMaster a] -> ShowS
forall a. AutoMaster a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AutoMaster a] -> ShowS
$cshowList :: forall a. [AutoMaster a] -> ShowS
show :: AutoMaster a -> String
$cshow :: forall a. AutoMaster a -> String
showsPrec :: Int -> AutoMaster a -> ShowS
$cshowsPrec :: forall a. Int -> AutoMaster a -> ShowS
Show)
instance (Eq w) => LayoutModifier AutoMaster w where
modifyLayout :: forall (l :: * -> *).
LayoutClass l w =>
AutoMaster w
-> Workspace String (l w) w
-> Rectangle
-> X ([(w, Rectangle)], Maybe (l w))
modifyLayout (AutoMaster Int
k Float
bias Float
_) = forall w (l :: * -> *).
(Eq w, LayoutClass l w) =>
Int
-> Float
-> Workspace String (l w) w
-> Rectangle
-> X ([(w, Rectangle)], Maybe (l w))
autoLayout Int
k Float
bias
pureMess :: AutoMaster w -> SomeMessage -> Maybe (AutoMaster w)
pureMess = forall a. AutoMaster a -> SomeMessage -> Maybe (AutoMaster a)
autoMess
autoMess :: AutoMaster a -> SomeMessage -> Maybe (AutoMaster a)
autoMess :: forall a. AutoMaster a -> SomeMessage -> Maybe (AutoMaster a)
autoMess (AutoMaster Int
k Float
bias Float
delta) SomeMessage
m = forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {a}. Resize -> AutoMaster a
resize (forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m),
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {a}. IncMasterN -> AutoMaster a
incmastern (forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m)]
where incmastern :: IncMasterN -> AutoMaster a
incmastern (IncMasterN Int
d) = forall a. Int -> Float -> Float -> AutoMaster a
AutoMaster (forall a. Ord a => a -> a -> a
max Int
1 (Int
kforall a. Num a => a -> a -> a
+Int
d)) Float
bias Float
delta
resize :: Resize -> AutoMaster a
resize Resize
Expand = forall a. Int -> Float -> Float -> AutoMaster a
AutoMaster Int
k (forall a. Ord a => a -> a -> a
min Float
0.4 forall a b. (a -> b) -> a -> b
$ Float
biasforall a. Num a => a -> a -> a
+Float
delta) Float
delta
resize Resize
Shrink = forall a. Int -> Float -> Float -> AutoMaster a
AutoMaster Int
k (forall a. Ord a => a -> a -> a
max (-Float
0.4) forall a b. (a -> b) -> a -> b
$ Float
biasforall a. Num a => a -> a -> a
-Float
delta) Float
delta
autoLayout :: (Eq w, LayoutClass l w) =>
Int ->
Float ->
W.Workspace WorkspaceId (l w) w
-> Rectangle
-> X ([(w, Rectangle)], Maybe (l w))
autoLayout :: forall w (l :: * -> *).
(Eq w, LayoutClass l w) =>
Int
-> Float
-> Workspace String (l w) w
-> Rectangle
-> X ([(w, Rectangle)], Maybe (l w))
autoLayout Int
k Float
bias Workspace String (l w) w
wksp Rectangle
rect = do
let stack :: Maybe (Stack w)
stack = forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack Workspace String (l w) w
wksp
let ws :: [w]
ws = forall a. Maybe (Stack a) -> [a]
W.integrate' Maybe (Stack w)
stack
let n :: Int
n = forall (t :: * -> *) a. Foldable t => t a -> Int
length [w]
ws
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [w]
ws then
forall (layout :: * -> *) a.
LayoutClass layout a =>
Workspace String (layout a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
runLayout Workspace String (l w) w
wksp Rectangle
rect
else
if Int
nforall a. Ord a => a -> a -> Bool
<=Int
k then
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Rectangle -> [a] -> [(a, Rectangle)]
divideRow Rectangle
rect [w]
ws,forall a. Maybe a
Nothing)
else do
let master :: [w]
master = forall a. Int -> [a] -> [a]
take Int
k [w]
ws
let filtStack :: Maybe (Stack w)
filtStack = Maybe (Stack w)
stack forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (a -> Bool) -> Stack a -> Maybe (Stack a)
W.filter (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [w]
master)
([(w, Rectangle)], Maybe (l w))
wrs <- forall (layout :: * -> *) a.
LayoutClass layout a =>
Workspace String (layout a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
runLayout (Workspace String (l w) w
wksp {stack :: Maybe (Stack w)
W.stack = Maybe (Stack w)
filtStack}) (Rectangle -> Int -> Float -> Rectangle
slaveRect Rectangle
rect Int
n Float
bias)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (forall a. Rectangle -> [a] -> [(a, Rectangle)]
divideRow (Rectangle -> Int -> Float -> Rectangle
masterRect Rectangle
rect Int
n Float
bias) [w]
master forall a. [a] -> [a] -> [a]
++)
([(w, Rectangle)], Maybe (l w))
wrs
masterHeight :: Int -> Float -> Float
masterHeight :: Int -> Float -> Float
masterHeight Int
n Float
bias = Int -> Float
calcHeight Int
n forall a. Num a => a -> a -> a
+ Float
bias
where calcHeight :: Int -> Float
calcHeight :: Int -> Float
calcHeight Int
1 = Float
1.0
calcHeight Int
m = if Int
mforall a. Ord a => a -> a -> Bool
<Int
9 then (Float
43forall a. Fractional a => a -> a -> a
/Float
45) forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
mforall a. Num a => a -> a -> a
*(Float
7forall a. Fractional a => a -> a -> a
/Float
90) else Float
1forall a. Fractional a => a -> a -> a
/Float
3
masterRect :: Rectangle -> Int -> Float -> Rectangle
masterRect :: Rectangle -> Int -> Float -> Rectangle
masterRect (Rectangle Position
sx Position
sy Dimension
sw Dimension
sh) Int
n Float
bias = Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
sx Position
sy Dimension
sw Dimension
h
where h :: Dimension
h = forall a b. (RealFrac a, Integral b) => a -> b
round forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
shforall a. Num a => a -> a -> a
*Int -> Float -> Float
masterHeight Int
n Float
bias
slaveRect :: Rectangle -> Int -> Float -> Rectangle
slaveRect :: Rectangle -> Int -> Float -> Rectangle
slaveRect (Rectangle Position
sx Position
sy Dimension
sw Dimension
sh) Int
n Float
bias = Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
sx (Position
syforall a. Num a => a -> a -> a
+Position
mh) Dimension
sw Dimension
h
where mh :: Position
mh = forall a b. (RealFrac a, Integral b) => a -> b
round forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
shforall a. Num a => a -> a -> a
*Int -> Float -> Float
masterHeight Int
n Float
bias
h :: Dimension
h = forall a b. (RealFrac a, Integral b) => a -> b
round forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
shforall a. Num a => a -> a -> a
*(Float
1forall a. Num a => a -> a -> a
-Int -> Float -> Float
masterHeight Int
n Float
bias)
divideRow :: Rectangle -> [a] -> [(a, Rectangle)]
divideRow :: forall a. Rectangle -> [a] -> [(a, Rectangle)]
divideRow (Rectangle Position
x Position
y Dimension
w Dimension
h) [a]
ws = forall a b. [a] -> [b] -> [(a, b)]
zip [a]
ws [Rectangle]
rects
where n :: Int
n = forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
ws
oneW :: Int
oneW = forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
w forall a. Integral a => a -> a -> a
`div` Int
n
oneRect :: Rectangle
oneRect = Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
x Position
y (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
oneW) Dimension
h
rects :: [Rectangle]
rects = forall a. Int -> [a] -> [a]
take Int
n forall a b. (a -> b) -> a -> b
$ forall a. (a -> a) -> a -> [a]
iterate (Position -> Rectangle -> Rectangle
shiftR (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
oneW)) Rectangle
oneRect
shiftR :: Position -> Rectangle -> Rectangle
shiftR :: Position -> Rectangle -> Rectangle
shiftR Position
s (Rectangle Position
x Position
y Dimension
w Dimension
h) = Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle (Position
xforall a. Num a => a -> a -> a
+Position
s) Position
y Dimension
w Dimension
h
autoMaster :: LayoutClass l a =>
Int ->
Float ->
l a ->
ModifiedLayout AutoMaster l a
autoMaster :: forall (l :: * -> *) a.
LayoutClass l a =>
Int -> Float -> l a -> ModifiedLayout AutoMaster l a
autoMaster Int
nmaster Float
delta = forall (m :: * -> *) (l :: * -> *) a.
m a -> l a -> ModifiedLayout m l a
ModifiedLayout (forall a. Int -> Float -> Float -> AutoMaster a
AutoMaster Int
nmaster Float
0 Float
delta)