diff options
Diffstat (limited to '')
| -rw-r--r-- | XMonad/Layout/Mosaic.hs | 141 |
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)) + |