{-# LANGUAGE MultiParamTypeClasses, TypeSynonymInstances, FlexibleContexts #-}
{-# LANGUAGE PatternGuards #-}
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Layout.Master
-- Copyright : (c) Lukas Mai
-- License : BSD-style (see LICENSE)
--
-- Maintainer : <l.mai@web.de>
-- Stability : unstable
-- Portability : unportable
--
-- A layout that adds a distinguished master window to a base layout.
-----------------------------------------------------------------------------
module XMonad.Layout.Master (
-- * Usage
-- $usage
mastered,
Master
) where
import XMonad
import XMonad.StackSet
import Data.List
import Data.Ord
-- $usage
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Layout.Master
--
-- and add something like
--
-- > mastered (1/100) (1/2) $ Grid
--
-- to your layouts. This will use the left half of your screen for a master
-- window and let Grid manage the right half.
--
-- For more detailed instructions on editing the layoutHook see
-- "XMonad.Doc.Extending#Editing_the_layout_hook".
--
-- Like 'XMonad.Layout.Tall', 'Master' supports the 'XMonad.Layout.Shrink' and
-- 'XMonad.Layout.Expand' messages.
mastered :: (LayoutClass l a)
=> Rational -- ^ @delta@, the ratio of the screen to resize by
-> Rational -- ^ @frac@, what portion of the screen to reserve for the master window
-> l a -- ^ the layout to use for the remaining windows
-> Master l a
mastered d f b = Master d f' b
where
f' = min 1 . max 0 $ f
data Master l a =
Master{
delta :: Rational,
frac :: Rational,
base :: l a
} deriving (Show, Read, Eq, Ord)
extractMaster :: Stack a -> (a, Maybe (Stack a))
extractMaster (Stack x ls rs) = case reverse ls of
[] -> (x, differentiate rs)
(m : ls') -> (m, Just $ Stack x (reverse ls') rs)
area :: Rectangle -> Dimension
area r = rect_width r * rect_height r
chop :: D -> Rectangle -> Rectangle
chop (w, h) (Rectangle rx ry rw rh) =
let
r' = maximumBy (comparing area)
[ Rectangle rx (ry + fromIntegral h) rw (rh - h)
, Rectangle (rx + fromIntegral w) ry (rw - w) rh]
in
r'{ rect_width = max 0 $ rect_width r', rect_height = max 0 $ rect_height r' }
instance (LayoutClass l Window) => LayoutClass (Master l) Window where
description m = "Master " ++ description (base m)
handleMessage m msg
| Just Shrink <- fromMessage msg =
return . Just $ m{ frac = max 0 $ frac m - delta m }
| Just Expand <- fromMessage msg =
return . Just $ m{ frac = min 1 $ frac m + delta m }
| otherwise =
fmap (fmap (\x -> m{ base = x })) $ handleMessage (base m) msg
runLayout ws rect = do
(f, ws', rect') <- case fmap extractMaster $ stack ws of
Nothing ->
return (id, ws, rect)
Just (x, Nothing) -> do
f <- mkAdjust x
let
(w', h') = f (rect_width rect, rect_height rect)
xr = rect{ rect_width = w', rect_height = h' }
return (((x, xr) :), ws{ stack = Nothing }, Rectangle (rect_x xr + fromIntegral w') (rect_y xr) 0 0)
Just (x, Just st) -> do
f <- mkAdjust x
let
d@(w', h') = f (scale $ rect_width rect, rect_height rect)
xr = rect{ rect_width = w', rect_height = h' }
return (((x, xr) :), ws{ stack = Just st }, chop d rect)
(y, l) <- runLayout ws'{ layout = base m } rect'
return (f y, fmap (\x -> m{ base = x }) l)
where
m = layout ws
scale = round . (* frac m) . fromIntegral
