1 files changed, 141 insertions, 0 deletions
diff --git a/XMonad/Layout/Mosaic.hs b/XMonad/Layout/Mosaic.hs
new file mode 100644
index 0000000..46b8fed
--- /dev/null
+++ b/XMonad/Layout/Mosaic.hs
@@ -0,0 +1,141 @@
+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, DeriveDataTypeable #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Layout.Mosaic
+-- Copyright   :  (c) 2009 Adam Vogt, 2007 James Webb
+-- License     :  BSD-style (see xmonad/LICENSE)
+--
+-- Maintainer  :  vogt.adam<at>gmail.com
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- Based on MosaicAlt, but aspect ratio messages allways change the aspect
+-- ratios, and rearranging the window stack changes the window sizes.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Layout.Mosaic (
+    Mosaic(..)
+    ,Aspect(..)
+    )
+    where
+
+import Prelude hiding (sum)
+
+import XMonad(Typeable,
+              LayoutClass(pureLayout, pureMessage, description), Message,
+              fromMessage, splitHorizontallyBy, splitVerticallyBy, Rectangle)
+import XMonad.StackSet(integrate)
+import Data.Foldable(Foldable(foldMap), sum)
+import Data.Monoid(Monoid(mappend, mempty))
+
+-- $usage
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Layout.Mosaic
+--
+-- Then edit your @layoutHook@ by adding the Mosaic layout:
+--
+-- > myLayouts = Mosaic 0 [1..10] ||| Full ||| etc..
+-- > main = xmonad defaultConfig { layoutHook = myLayouts }
+--
+-- The numbers are directly proportional to the area given, with the
+-- master window getting the most if you have an ascending list.
+--
+-- Unfortunately, infinite lists break serialization, so
+-- don't use them
+--
+-- The position of a window in the stack determines its size.
+--
+-- To change the choice in aspect ratio, add to your keybindings:
+--
+--  , ((modMask, xK_a), sendMessage Taller)
+--  , ((modMask, xK_z), sendMessage Wider)
+--  , ((modMask, xK_s), sendMessage (SlopeMod (zipWith (*) [1..])))
+--  , ((modMask, xK_d), sendMessage (SlopeMod (zipWith (flip (/)) [1..])))
+--
+-- For more detailed instructions on editing the layoutHook see:
+--
+-- "XMonad.Doc.Extending#Editing_the_layout_hook"
+
+data Aspect
+    = Taller
+    | Wider
+    | Reset
+    | SlopeMod ([Rational] -> [Rational])
+    deriving (Typeable)
+
+instance Message Aspect
+
+data Mosaic a
+    = Mosaic Int [Rational]
+    deriving (Read, Show)
+
+instance LayoutClass Mosaic a where
+    description = const "Mosaic"
+
+    pureMessage (Mosaic i ss) msg = ixMod $ fromMessage msg
+        where ixMod (Just Wider) = Just $ Mosaic (succ i) ss
+              ixMod (Just Taller)  = if i <= 1 then Nothing else Just $ Mosaic (pred i) ss
+              ixMod (Just Reset) = Just $ Mosaic 0 ss
+              ixMod (Just (SlopeMod f)) = Just $ Mosaic i (f ss)
+              ixMod _ = Nothing
+
+    pureLayout (Mosaic i ss) r st = zip (integrate st) (rect i)
+        where rects = splits (length $ integrate st) r ss
+              rect 0 = rects !! (length rects `div` 2)
+              rect n = if length rects < n then last rects else rects !! pred n
+
+splits :: Int -> Rectangle -> [Rational] -> [[Rectangle]]
+splits num rect sz = splitsL rect $ makeTree $ normalize $ take num sz
+--    where --fas = normalize $ map (fromIntegral (sum fas')/) $ map fromIntegral fas'
+
+normalize :: Fractional a => [a] -> [a]
+normalize x = let s = sum x
+    in map (/s) x
+
+-- recursively enumerate splits
+splitsL :: Rectangle -> Tree Rational -> [[Rectangle]]
+splitsL _rect Empty = []
+splitsL rect (Leaf _) = [[rect]]
+splitsL rect (Branch l r) = do
+    let mkSplit f = f (sum l / (sum l + sum r)) rect
+    (rl,rr) <- map mkSplit [splitHorizontallyBy,splitVerticallyBy]
+    splitsL rl l `interleave` splitsL rr r
+
+interleave :: [[a]] -> [[a]] -> [[a]]
+interleave xs ys | lx > ly = zc xs (extend lx ys)
+                 | otherwise = zc (extend ly xs) ys
+    where lx = length xs
+          ly = length ys
+          zc = zipWith (++)
+
+extend :: Int -> [a] -> [a]
+extend n pat = do
+    (p,e') <- zip pat $ take m (repeat True) ++ repeat False
+    let e = if e' then [p] else []
+    (e++) $ take d $ repeat p
+    where (d,m) = n `divMod` length pat
+
+data Tree a = Branch (Tree a) (Tree a) | Leaf a | Empty
+    deriving (Show)
+
+instance Foldable Tree where
+   foldMap _f Empty = mempty
+   foldMap f (Leaf x) = f x
+   foldMap f (Branch l r) = foldMap f l `mappend` foldMap f r
+
+instance Monoid (Tree a) where
+    mempty = Empty
+    mappend Empty x = x
+    mappend x Empty = x
+    mappend x y = Branch x y
+
+makeTree :: [Rational] -> Tree Rational
+makeTree [] = Empty
+makeTree [x] = Leaf x
+makeTree xs = Branch (makeTree a) (makeTree b)
+    where ((a,b),_) = foldr w (([],[]),(0,0)) xs
+          w n ((ls,rs),(l,r)) = if l > r then ((ls,n:rs),(l,n+r))
+                                        else ((n:ls,rs),(n+l,r))
+