{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, FlexibleContexts #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Layout.AutoMaster
-- Description :  Change size of the stack area depending on the number of its windows.
-- Copyright   :  (c) 2009 Ilya Portnov
-- License     :  BSD3-style (see LICENSE)
--
-- Maintainer  :  Ilya Portnov <portnov84@rambler.ru>
-- Stability   :  unstable
-- Portability :  unportable
--
-- Provides layout modifier AutoMaster. It separates screen in two parts -
-- master and slave. Size of slave area automatically changes depending on
-- number of slave windows.
--
-----------------------------------------------------------------------------

module XMonad.Layout.AutoMaster (
                             -- * Usage
                             -- $usage
                             autoMaster, AutoMaster
                            ) where
import XMonad
import XMonad.Layout.LayoutModifier
import XMonad.Prelude
import qualified XMonad.StackSet as W

import Control.Arrow (first)


-- $usage
-- This module defines layout modifier named autoMaster. It separates
-- screen in two parts - master and slave. Master windows are arranged
-- in one row, in slave area underlying layout is run. Size of slave area
-- automatically increases when number of slave windows is increasing.
--
-- You can use this module by adding folowing in your @xmonad.hs@:
--
-- > import XMonad.Layout.AutoMaster
--
-- Then add layouts to your layoutHook:
--
-- > myLayoutHook = autoMaster 1 (1/100) Grid ||| ...
--
-- In this example, master area by default contains 1 window (you can
-- change this number in runtime with usual IncMasterN message), changing
-- slave area size with 1/100 on each Shrink/Expand message.

-- | Data type for layout modifier
data AutoMaster a = AutoMaster Int Float Float
    deriving (ReadPrec [AutoMaster a]
ReadPrec (AutoMaster a)
Int -> ReadS (AutoMaster a)
ReadS [AutoMaster a]
(Int -> ReadS (AutoMaster a))
-> ReadS [AutoMaster a]
-> ReadPrec (AutoMaster a)
-> ReadPrec [AutoMaster a]
-> Read (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
[AutoMaster a] -> ShowS
AutoMaster a -> String
(Int -> AutoMaster a -> ShowS)
-> (AutoMaster a -> String)
-> ([AutoMaster a] -> ShowS)
-> Show (AutoMaster a)
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
_) = Int
-> Float
-> Workspace String (l w) w
-> Rectangle
-> X ([(w, Rectangle)], Maybe (l w))
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 = AutoMaster w -> SomeMessage -> Maybe (AutoMaster w)
forall a. AutoMaster a -> SomeMessage -> Maybe (AutoMaster a)
autoMess

-- | Handle Shrink/Expand and IncMasterN messages
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 = [Maybe (AutoMaster a)] -> Maybe (AutoMaster a)
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [(Resize -> AutoMaster a) -> Maybe Resize -> Maybe (AutoMaster a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Resize -> AutoMaster a
forall {a}. Resize -> AutoMaster a
resize (SomeMessage -> Maybe Resize
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m),
                                             (IncMasterN -> AutoMaster a)
-> Maybe IncMasterN -> Maybe (AutoMaster a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IncMasterN -> AutoMaster a
forall {a}. IncMasterN -> AutoMaster a
incmastern (SomeMessage -> Maybe IncMasterN
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m)]
    where incmastern :: IncMasterN -> AutoMaster a
incmastern (IncMasterN Int
d) = Int -> Float -> Float -> AutoMaster a
forall a. Int -> Float -> Float -> AutoMaster a
AutoMaster (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
d)) Float
bias Float
delta
          resize :: Resize -> AutoMaster a
resize Resize
Expand = Int -> Float -> Float -> AutoMaster a
forall a. Int -> Float -> Float -> AutoMaster a
AutoMaster Int
k (Float -> Float -> Float
forall a. Ord a => a -> a -> a
min Float
0.4  (Float -> Float) -> Float -> Float
forall a b. (a -> b) -> a -> b
$ Float
biasFloat -> Float -> Float
forall a. Num a => a -> a -> a
+Float
delta) Float
delta
          resize Resize
Shrink = Int -> Float -> Float -> AutoMaster a
forall a. Int -> Float -> Float -> AutoMaster a
AutoMaster Int
k (Float -> Float -> Float
forall a. Ord a => a -> a -> a
max (-Float
0.4)  (Float -> Float) -> Float -> Float
forall a b. (a -> b) -> a -> b
$ Float
biasFloat -> Float -> Float
forall a. Num a => a -> a -> a
-Float
delta) Float
delta

-- | Main layout function
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 = Workspace String (l w) w -> Maybe (Stack w)
forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack Workspace String (l w) w
wksp
    let ws :: [w]
ws = Maybe (Stack w) -> [w]
forall a. Maybe (Stack a) -> [a]
W.integrate' Maybe (Stack w)
stack
    let n :: Int
n = [w] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [w]
ws
    if [w] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [w]
ws then
        Workspace String (l w) w
-> Rectangle -> X ([(w, Rectangle)], Maybe (l w))
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
nInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<=Int
k then
              ([(w, Rectangle)], Maybe (l w))
-> X ([(w, Rectangle)], Maybe (l w))
forall (m :: * -> *) a. Monad m => a -> m a
return (Rectangle -> [w] -> [(w, Rectangle)]
forall a. Rectangle -> [a] -> [(a, Rectangle)]
divideRow Rectangle
rect [w]
ws,Maybe (l w)
forall a. Maybe a
Nothing)
              else do
              let master :: [w]
master = Int -> [w] -> [w]
forall a. Int -> [a] -> [a]
take Int
k [w]
ws
              let filtStack :: Maybe (Stack w)
filtStack = Maybe (Stack w)
stack Maybe (Stack w) -> (Stack w -> Maybe (Stack w)) -> Maybe (Stack w)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (w -> Bool) -> Stack w -> Maybe (Stack w)
forall a. (a -> Bool) -> Stack a -> Maybe (Stack a)
W.filter (w -> [w] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [w]
master)
              ([(w, Rectangle)], Maybe (l w))
wrs <- Workspace String (l w) w
-> Rectangle -> X ([(w, Rectangle)], Maybe (l w))
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)
              ([(w, Rectangle)], Maybe (l w))
-> X ([(w, Rectangle)], Maybe (l w))
forall (m :: * -> *) a. Monad m => a -> m a
return (([(w, Rectangle)], Maybe (l w))
 -> X ([(w, Rectangle)], Maybe (l w)))
-> ([(w, Rectangle)], Maybe (l w))
-> X ([(w, Rectangle)], Maybe (l w))
forall a b. (a -> b) -> a -> b
$ ([(w, Rectangle)] -> [(w, Rectangle)])
-> ([(w, Rectangle)], Maybe (l w))
-> ([(w, Rectangle)], Maybe (l w))
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (Rectangle -> [w] -> [(w, Rectangle)]
forall a. Rectangle -> [a] -> [(a, Rectangle)]
divideRow (Rectangle -> Int -> Float -> Rectangle
masterRect Rectangle
rect Int
n Float
bias) [w]
master [(w, Rectangle)] -> [(w, Rectangle)] -> [(w, Rectangle)]
forall a. [a] -> [a] -> [a]
++)
                             ([(w, Rectangle)], Maybe (l w))
wrs

-- | Calculates height of master area, depending on number of windows.
masterHeight :: Int -> Float -> Float
masterHeight :: Int -> Float -> Float
masterHeight Int
n Float
bias = Int -> Float
calcHeight Int
n Float -> Float -> Float
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
mInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
9 then (Float
43Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/Float
45) Float -> Float -> Float
forall a. Num a => a -> a -> a
- Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
mFloat -> Float -> Float
forall a. Num a => a -> a -> a
*(Float
7Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/Float
90) else Float
1Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/Float
3

-- | Rectangle for master area
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 = Float -> Dimension
forall a b. (RealFrac a, Integral b) => a -> b
round (Float -> Dimension) -> Float -> Dimension
forall a b. (a -> b) -> a -> b
$ Dimension -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
shFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Int -> Float -> Float
masterHeight Int
n Float
bias

-- | Rectangle for slave area
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
syPosition -> Position -> Position
forall a. Num a => a -> a -> a
+Position
mh) Dimension
sw Dimension
h
    where mh :: Position
mh = Float -> Position
forall a b. (RealFrac a, Integral b) => a -> b
round (Float -> Position) -> Float -> Position
forall a b. (a -> b) -> a -> b
$ Dimension -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
shFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Int -> Float -> Float
masterHeight Int
n Float
bias
          h :: Dimension
h  = Float -> Dimension
forall a b. (RealFrac a, Integral b) => a -> b
round (Float -> Dimension) -> Float -> Dimension
forall a b. (a -> b) -> a -> b
$ Dimension -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
shFloat -> Float -> Float
forall a. Num a => a -> a -> a
*(Float
1Float -> Float -> Float
forall a. Num a => a -> a -> a
-Int -> Float -> Float
masterHeight Int
n Float
bias)

-- | Divide rectangle between windows
divideRow :: Rectangle -> [a] -> [(a, Rectangle)]
divideRow :: forall a. Rectangle -> [a] -> [(a, Rectangle)]
divideRow (Rectangle Position
x Position
y Dimension
w Dimension
h) [a]
ws = [a] -> [Rectangle] -> [(a, Rectangle)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
ws [Rectangle]
rects
    where n :: Int
n = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
ws
          oneW :: Int
oneW = Dimension -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
w Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
n
          oneRect :: Rectangle
oneRect = Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
x Position
y (Int -> Dimension
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
oneW) Dimension
h
          rects :: [Rectangle]
rects = Int -> [Rectangle] -> [Rectangle]
forall a. Int -> [a] -> [a]
take Int
n ([Rectangle] -> [Rectangle]) -> [Rectangle] -> [Rectangle]
forall a b. (a -> b) -> a -> b
$ (Rectangle -> Rectangle) -> Rectangle -> [Rectangle]
forall a. (a -> a) -> a -> [a]
iterate (Position -> Rectangle -> Rectangle
shiftR (Int -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
oneW)) Rectangle
oneRect

-- | Shift rectangle right
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
xPosition -> Position -> Position
forall a. Num a => a -> a -> a
+Position
s) Position
y Dimension
w Dimension
h

-- | User interface function
autoMaster :: LayoutClass l a =>
              Int ->      -- Number of master windows
              Float ->    -- Step for which to increment/decrement master area size with Shrink/Expand
              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 = AutoMaster a -> l a -> ModifiedLayout AutoMaster l a
forall (m :: * -> *) (l :: * -> *) a.
m a -> l a -> ModifiedLayout m l a
ModifiedLayout (Int -> Float -> Float -> AutoMaster a
forall a. Int -> Float -> Float -> AutoMaster a
AutoMaster Int
nmaster Float
0 Float
delta)