XMonad.Layout.Master: initial import

darcs-hash:20080404220734-462cf-19de482d505bd94a3eeefa99b95b0fb78d881b9d.gz

1 files changed, 110 insertions, 0 deletions

diff --git a/XMonad/Layout/Master.hs b/XMonad/Layout/Master.hs
new file mode 100644
index 0000000..41bcc8b
--- /dev/null
+++ b/XMonad/Layout/Master.hs
@@ -0,0 +1,110 @@
+{-# 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