From e9d45427672e4835e1d06886295d1157ff0f32b0 Mon Sep 17 00:00:00 2001 From: David Roundy Date: Thu, 3 May 2007 17:10:24 +0200 Subject: add Mosaic layout. darcs-hash:20070503151024-72aca-2f5bae5d24e35d201034593023593d595b704540.gz --- Mosaic.hs | 183 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 183 insertions(+) create mode 100644 Mosaic.hs (limited to 'Mosaic.hs') diff --git a/Mosaic.hs b/Mosaic.hs new file mode 100644 index 0000000..b08a709 --- /dev/null +++ b/Mosaic.hs @@ -0,0 +1,183 @@ +module XMonadContrib.Mosaic ( mosaic, expandWindow, shrinkWindow, squareWindow ) where + +-- This module defines a "mosaic" layout, which tries to give all windows +-- equal area, while also trying to give them a user-defined (and run-time +-- adjustable) aspect ratio. You can use mod-l and mod-h to adjust the +-- aspect ratio (which probably won't have a very interesting effect unless +-- you've got a number of windows upen. + +-- My intent is to extend this layout to optimize various constraints, such +-- as windows that should have a different aspect ratio, a fixed size, or +-- minimum dimensions in certain directions. + +-- You can use this module with the following in your config file: + +-- import XMonad.Mosaic +-- import Control.Monad.State ( gets ) +-- import qualified StackSet as W ( peek ) + +-- defaultLayouts :: [Layout LayoutMsg] +-- defaultLayouts = [ mosaic (1%4) (1%2) M.empty M.empty, full, +-- tall defaultDelta (1%2), wide defaultDelta (1%2) ] + +-- In the key-bindings, do something like: + +-- , ((modMask .|. shiftMask, xK_h ), do ws <- gets workspace +-- whenJust (W.peek ws) $ \w -> +-- layoutMsg (shrinkWindow w)) +-- , ((modMask .|. shiftMask, xK_l ), do ws <- gets workspace +-- whenJust (W.peek ws) $ \w -> +-- layoutMsg (expandWindow w)) +-- , ((modMask .|. shiftMask, xK_s ), do ws <- gets workspace +-- whenJust (W.peek ws) $ \w -> +-- layoutMsg (squareWindow w)) + +import Data.Ratio +import Graphics.X11.Xlib +import XMonad +import Operations ( ShrinkOrExpand (Shrink, Expand) ) +import qualified Data.Map as M +import Data.List ( sort ) +import Data.Dynamic ( Typeable, fromDynamic ) +import Control.Monad ( mplus ) + +import System.IO.Unsafe + +data HandleWindow = ExpandWindow Window | ShrinkWindow Window | SquareWindow Window + deriving ( Typeable, Eq ) +expandWindow, shrinkWindow, squareWindow :: Window -> HandleWindow +expandWindow = ExpandWindow +shrinkWindow = ShrinkWindow +squareWindow = SquareWindow + +mosaic :: Rational -> Rational -> M.Map Window WindowRater -> M.Map Window Area -> Layout +mosaic delta tileFrac raters areas = Layout { doLayout = mosaicL tileFrac raters areas + , modifyLayout = mlayout } + where mlayout x = (m1 `fmap` fromDynamic x) `mplus` (m2 `fmap` fromDynamic x) + m1 Shrink = mosaic delta (tileFrac/(1+delta)) raters areas + m1 Expand = mosaic delta (tileFrac*(1+delta)) raters areas + m2 (ExpandWindow w) = mosaic delta tileFrac raters + -- (add_rater (\_ (Rectangle _ _ wid h) -> delta*(1-wid///h)) w raters) + (multiply_area (1+delta) w areas) + m2 (ShrinkWindow w) = mosaic delta tileFrac raters + -- (add_rater (\_ (Rectangle _ _ wid h) -> delta*(wid///h-1)) w raters) + (multiply_area (1/(1+ delta)) w areas) + m2 (SquareWindow w) = mosaic delta tileFrac (M.insert w force_square raters) areas + force_square _ (Rectangle _ _ a b) = 100*(sqr(a///b) + sqr(b///a)) + sqr a = a * a + +mytrace :: String -> a -> a +mytrace s a = seq foo a + where foo = unsafePerformIO $ appendFile "/tmp/xmonad.trace" (s++"\n") + +myerror :: String -> a +myerror s = seq foo $ error s + where foo = unsafePerformIO $ appendFile "/tmp/xmonad.trace" (s++"\n") + +multiply_area :: Area -> Window -> M.Map Window Area -> M.Map Window Area +multiply_area a w = M.alter (Just . f) w where f Nothing = a + f (Just a') = a'*a + +add_rater :: WindowRater -> Window -> M.Map Window WindowRater -> M.Map Window WindowRater +add_rater r w = M.alter f w where f Nothing= Just r + f (Just r') = Just $ \foo bar -> r foo bar + r' foo bar + +type WindowRater = Window -> Rectangle -> Rational + +mosaicL :: Rational -> M.Map Window WindowRater -> M.Map Window Area + -> Rectangle -> [Window] -> [(Window, Rectangle)] +mosaicL _ _ _ _ [] = [] +mosaicL f raters areas origRect origws + = flattenMosaic $ the_value $ if myv < myh then myv else myh + where mean_area = area origRect / fromIntegral (length origws) + myv = my_mosaic origRect Vertical sortedws + myh = my_mosaic origRect Horizontal sortedws + sortedws = reverse $ map the_value $ sort $ map (\w -> Rated (sumareas [w]) w) origws + + my_mosaic :: Rectangle -> CutDirection -> [Window] + -> Rated Rational (Mosaic (Window, Rectangle)) + my_mosaic _ _ [] = Rated 0 $ M [] + my_mosaic r _ [w] = Rated (rating w r) $ OM (w,r) + my_mosaic r d ws = minL $ + map (fmap M . catRated . + map (\(ws',r') -> my_mosaic r' (otherDirection d) ws')) $ + map (\ws' -> zip ws' $ partitionR d r $ map sumareas ws') $ + init $ allsplits ws + where minL [] = myerror "minL on empty list" + minL [a] = a + minL (a:b:c) = minL (min a b:c) + + partitionR :: CutDirection -> Rectangle -> [Area] -> [Rectangle] + partitionR _ _ [] = [] + partitionR _ r [_] = [r] + partitionR d r (a:ars) = r1 : partitionR d r2 ars + where totarea = sum (a:ars) + (r1,r2) = split d (a/totarea) r + + rating :: WindowRater + rating w r = (M.findWithDefault default_preferences w raters) w r + default_preferences :: WindowRater + default_preferences _ r@(Rectangle _ _ w h) + | fr <- w /// h = sqr(fr/f)+sqr(f/fr)-2+ toRational (mean_area/area r) + sqr a = a * a + sumareas ws = sum $ map (\w -> M.findWithDefault 1 w areas) ws + + + +catRated :: Num v => [Rated v a] -> Rated v [a] +catRated xs = Rated (sum $ map the_rating xs) (map the_value xs) + +data Rated a b = Rated !a !b +instance Functor (Rated a) where + f `fmap` (Rated v a) = Rated v (f a) + +the_value :: Rated a b -> b +the_value (Rated _ b) = b +the_rating :: Rated a b -> a +the_rating (Rated a _) = a + +instance Eq a => Eq (Rated a b) where + (Rated a _) == (Rated a' _) = a == a' +instance Ord a => Ord (Rated a b) where + compare (Rated a _) (Rated a' _) = compare a a' + +type Area = Rational + +area :: Rectangle -> Area +area (Rectangle _ _ w h) = fromIntegral w * fromIntegral h + +(///) :: (Integral a, Integral b) => a -> b -> Rational +a /// b = fromIntegral a / fromIntegral b + + +split :: CutDirection -> Rational -> Rectangle -> (Rectangle, Rectangle) +split Vertical frac (Rectangle sx sy sw sh) = (Rectangle sx sy sw h, + Rectangle sx (sy+fromIntegral h) sw (sh-h)) + where h = floor $ fromIntegral sh * frac +split Horizontal frac (Rectangle sx sy sw sh) = (Rectangle sx sy w sh, + Rectangle (sx+fromIntegral w) sy (sw-w) sh) + where w = floor $ fromIntegral sw * frac + +data CutDirection = Vertical | Horizontal +otherDirection :: CutDirection -> CutDirection +otherDirection Vertical = Horizontal +otherDirection Horizontal = Vertical + +data Mosaic a where + M :: [Mosaic a] -> Mosaic a + OM :: a -> Mosaic a + +flattenMosaic :: Mosaic a -> [a] +flattenMosaic (OM a) = [a] +flattenMosaic (M xs) = concatMap flattenMosaic xs + +allsplits :: [a] -> [[[a]]] +allsplits [] = [[[]]] +allsplits [a] = [[[a]]] +allsplits (x:xs) = (map ([x]:) splitsrest) ++ + (map (maphead (x:)) splitsrest) + where splitsrest = allsplits xs + +maphead :: (a->a) -> [a] -> [a] +maphead f (x:xs) = f x : xs +maphead _ [] = [] -- cgit v1.2.3