{-# 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 following 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)
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

-- | 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 = 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

-- | 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 = 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

-- | 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 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

-- | 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 = 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

-- | 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
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)

-- | 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 = 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

-- | 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
xforall 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 = 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)