New patches: [new layout algorithm for Mosaic. David Roundy **20070527191153] < > { addfile ./Anneal.hs hunk ./Anneal.hs 1 +module XMonadContrib.Anneal ( Rated(Rated), the_value, the_rating, anneal ) where + +data Rated a b = Rated !a !b + deriving ( Show ) +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' + +anneal :: a -> (a -> Double) -> (a -> [a]) -> Rated Double a +anneal = undefined hunk ./Mosaic.hs 2 module XMonadContrib.Mosaic ( mosaic, expandWindow, shrinkWindow, squareWindow, myclearWindow, + tallWindow, wideWindow, getName, withNamedWindow ) where -- This module defines a "mosaic" layout, which tries to give all windows hunk ./Mosaic.hs 25 -- In the key-bindings, do something like: +-- , ((controlMask .|. modMask .|. shiftMask, xK_h), withNamedWindow (sendMessage . tallWindow)) +-- , ((controlMask .|. modMask .|. shiftMask, xK_l), withNamedWindow (sendMessage . wideWindow)) -- , ((modMask .|. shiftMask, xK_h ), withNamedWindow (sendMessage . shrinkWindow)) -- , ((modMask .|. shiftMask, xK_l ), withNamedWindow (sendMessage . expandWindow)) -- , ((modMask .|. shiftMask, xK_s ), withNamedWindow (sendMessage . squareWindow)) hunk ./Mosaic.hs 30 --- , ((modMask .|. shiftMask, xK_o ), withNamedWindow (sendMessage . clearWindow)) +-- , ((modMask .|. shiftMask, xK_o ), withNamedWindow (sendMessage . myclearWindow)) + +import Control.Monad.State ( State, runState, put, get ) +import System.Random ( StdGen, Random, mkStdGen, randomR ) import Data.Ratio import Graphics.X11.Xlib hunk ./Mosaic.hs 37 -import XMonad +import XMonad hiding ( trace ) import Operations ( Resize(Shrink, Expand) ) import qualified Data.Map as M import Data.List ( sort ) hunk ./Mosaic.hs 45 import Control.Monad ( mplus ) import XMonadContrib.NamedWindows +import XMonadContrib.Anneal hunk ./Mosaic.hs 47 -import System.IO.Unsafe +import Debug.Trace data HandleWindow = ExpandWindow NamedWindow | ShrinkWindow NamedWindow | SquareWindow NamedWindow | ClearWindow NamedWindow hunk ./Mosaic.hs 51 + | TallWindow NamedWindow | WideWindow NamedWindow deriving ( Typeable, Eq ) instance Message HandleWindow hunk ./Mosaic.hs 56 -expandWindow, shrinkWindow, squareWindow, myclearWindow :: NamedWindow -> HandleWindow +expandWindow, shrinkWindow, squareWindow, myclearWindow,tallWindow, wideWindow :: NamedWindow -> HandleWindow expandWindow = ExpandWindow shrinkWindow = ShrinkWindow squareWindow = SquareWindow hunk ./Mosaic.hs 61 myclearWindow = ClearWindow +tallWindow = TallWindow +wideWindow = WideWindow hunk ./Mosaic.hs 64 -largeNumber :: Int -largeNumber = 100 +largeNumber, mediumNumber, resolutionNumber :: Int +largeNumber = 200 +mediumNumber = 10 +resolutionNumber = 100 hunk ./Mosaic.hs 69 -mosaic :: Rational -> Rational -> M.Map NamedWindow WindowRater -> M.Map NamedWindow Area -> Layout -mosaic delta tileFrac raters areas = Layout { doLayout = mosaicL tileFrac raters areas - , modifyLayout = mlayout } +defaultArea :: Double +defaultArea = 1 + +flexibility :: Double +flexibility = 0.1 + +mosaic :: Double -> Double -> M.Map NamedWindow [WindowHint] -> Layout +mosaic delta tileFrac hints = Layout { doLayout = mosaicL tileFrac hints, modifyLayout = mlayout } where mlayout x = (m1 `fmap` fromMessage x) `mplus` (m2 `fmap` fromMessage x) hunk ./Mosaic.hs 78 - 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 - m2 (ClearWindow w) = mosaic delta tileFrac (M.delete w raters) (M.delete w areas) - force_square _ (Rectangle _ _ a b) = 100*(sqr(a///b) + sqr(b///a)) - sqr a = a * a + m1 Shrink = mosaic delta (tileFrac/(1+delta)) hints + m1 Expand = mosaic delta (tileFrac*(1+delta)) hints + m2 (ExpandWindow w) = mosaic delta tileFrac (multiply_area (1+delta) w hints) + m2 (ShrinkWindow w) = mosaic delta tileFrac (multiply_area (1/(1+ delta)) w hints) + m2 (SquareWindow w) = mosaic delta tileFrac (set_aspect_ratio 1 w hints) + m2 (TallWindow w) = mosaic delta tileFrac (multiply_aspect (1/(1+delta)) w hints) + m2 (WideWindow w) = mosaic delta tileFrac (multiply_aspect (1+delta) w hints) + m2 (ClearWindow w) = mosaic delta tileFrac (M.delete w hints) hunk ./Mosaic.hs 87 -mytrace :: String -> a -> a -mytrace s a = seq foo a - where foo = unsafePerformIO $ appendFile "/tmp/xmonad.trace" (s++"\n") +multiply_area :: Double -> NamedWindow + -> M.Map NamedWindow [WindowHint] -> M.Map NamedWindow [WindowHint] +multiply_area a = alterlist f where f [] = [RelArea (defaultArea*a)] + f (RelArea a':xs) = RelArea (a'*a) : xs + f (x:xs) = x : f xs hunk ./Mosaic.hs 93 -myerror :: String -> a -myerror s = seq foo $ error s - where foo = unsafePerformIO $ appendFile "/tmp/xmonad.trace" (s++"\n") +set_aspect_ratio :: Double -> NamedWindow + -> M.Map NamedWindow [WindowHint] -> M.Map NamedWindow [WindowHint] +set_aspect_ratio r = alterlist f where f [] = [AspectRatio r] + f (FlexibleAspectRatio _:x) = AspectRatio r:x + f (AspectRatio _:x) = AspectRatio r:x + f (x:xs) = x:f xs hunk ./Mosaic.hs 100 -multiply_area :: Area -> NamedWindow -> M.Map NamedWindow Area -> M.Map NamedWindow Area -multiply_area a w = M.alter (Just . f) w where f Nothing = a - f (Just a') = a'*a +multiply_aspect :: Double -> NamedWindow + -> M.Map NamedWindow [WindowHint] -> M.Map NamedWindow [WindowHint] +multiply_aspect r = alterlist f where f [] = [FlexibleAspectRatio r] + f (AspectRatio r':x) = AspectRatio (r*r'):x + f (FlexibleAspectRatio r':x) = FlexibleAspectRatio (r*r'):x + f (x:xs) = x:f xs hunk ./Mosaic.hs 107 -add_rater :: WindowRater -> NamedWindow -> M.Map NamedWindow WindowRater -> M.Map NamedWindow 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 +findlist :: Ord k => k -> M.Map k [a] -> [a] +findlist = M.findWithDefault [] hunk ./Mosaic.hs 110 -type WindowRater = NamedWindow -> Rectangle -> Rational +alterlist :: (Ord k, Ord a) => ([a] -> [a]) -> k -> M.Map k [a] -> M.Map k [a] +alterlist f k = M.alter f' k + where f' Nothing = f' (Just []) + f' (Just xs) = case f xs of + [] -> Nothing + xs' -> Just xs' hunk ./Mosaic.hs 117 -mosaicL :: Rational -> M.Map NamedWindow WindowRater -> M.Map NamedWindow Area +mosaicL :: Double -> M.Map NamedWindow [WindowHint] -> Rectangle -> [Window] -> X [(Window, Rectangle)] hunk ./Mosaic.hs 119 -mosaicL _ _ _ _ [] = return [] -mosaicL f raters areas origRect origws +mosaicL _ _ _ [] = return [] +mosaicL f hints origRect origws = do namedws <- mapM getName origws let sortedws = reverse $ map the_value $ sort $ map (\w -> Rated (sumareas [w]) w) namedws hunk ./Mosaic.hs 123 - myv = my_mosaic origRect Vertical sortedws - myh = my_mosaic origRect Horizontal sortedws - return $ map (\(nw,r)->(unName nw,r)) $ flattenMosaic $ the_value $ if myv < myh then myv else myh - where mean_area = area origRect / fromIntegral (length origws) - - my_mosaic :: Rectangle -> CutDirection -> [NamedWindow] - -> Rated Rational (Mosaic (NamedWindow, 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') $ - take largeNumber $ init $ allsplits ws - where minL [] = myerror "minL on empty list" - minL [a] = a - minL (a:b:c) = minL (min a b:c) + myv = runCountDown largeNumber $ mosaic_splits even_split origRect Vertical sortedws + myv2 = maxL $ runCountDown largeNumber $ + sequence $ replicate mediumNumber $ + mosaic_splits one_split origRect Vertical sortedws + myh = runCountDown largeNumber $ mosaic_splits even_split origRect Horizontal sortedws + myh2 = maxL $ runCountDown largeNumber $ + sequence $ replicate mediumNumber $ + mosaic_splits one_split origRect Horizontal sortedws + return $ map (\(nw,r)->(trace ("rate1:"++ unlines [show nw, + show $ rate f meanarea (findlist nw hints) r, + show r, + show $ area r/meanarea, + show $ findlist nw hints]) $ + unName nw,crop' (findlist nw hints) r)) $ + flattenMosaic $ the_value $ + trace ("ratings: "++ show (map the_rating [myv,myh,myv2,myh2])) $ + maxL [myv,myh,myv2,myh2] + where mosaic_splits _ _ _ [] = return $ Rated 0 $ M [] + mosaic_splits _ r _ [w] = return $ Rated (rate f meanarea (findlist w hints) r) $ OM (w,r) + mosaic_splits spl r d ws = maxL `fmap` mapCD (spl r d) (init $ allsplits ws) + even_split :: Rectangle -> CutDirection -> [[NamedWindow]] + -> State CountDown (Rated Double (Mosaic (NamedWindow, Rectangle))) + even_split r d [ws] = even_split r d $ map (:[]) ws + even_split r d wss = + do let areas = map sumareas wss + let wsr_s :: [([NamedWindow], Rectangle)] + wsr_s = zip wss (partitionR d r areas) + submosaics <- mapM (\(ws',r') -> + mosaic_splits even_split r' (otherDirection d) ws') wsr_s + return $ fmap M $ catRated submosaics + one_split :: Rectangle -> CutDirection -> [[NamedWindow]] + -> State CountDown (Rated Double (Mosaic (NamedWindow, Rectangle))) + one_split r d [ws] = one_split r d $ map (:[]) ws + one_split r d wss = + do rnd <- mapM (const (fractional resolutionNumber)) [1..length wss] + let wsr_s :: [([NamedWindow], Rectangle)] + wsr_s = zip wss (partitionR d r rnd) + submosaics <- mapM (\(ws',r') -> + mosaic_splits even_split r' (otherDirection d) ws') wsr_s + return $ fmap M $ catRated submosaics hunk ./Mosaic.hs 164 - partitionR :: CutDirection -> Rectangle -> [Area] -> [Rectangle] + partitionR :: CutDirection -> Rectangle -> [Double] -> [Rectangle] partitionR _ _ [] = [] partitionR _ r [_] = [r] partitionR d r (a:ars) = r1 : partitionR d r2 ars hunk ./Mosaic.hs 170 where totarea = sum (a:ars) (r1,r2) = split d (a/totarea) r + theareas = hints2area `fmap` hints + sumareas ws = sum $ map (\w -> M.findWithDefault 1 w theareas) ws + meanarea = area origRect / fromIntegral (length origws) + +maxL :: Ord a => [a] -> a +maxL [] = error "maxL on empty list" +maxL [a] = a +maxL (a:b:c) = maxL (max a b:c) + +catRated :: Floating v => [Rated v a] -> Rated v [a] +catRated xs = Rated (product $ map the_rating xs) (map the_value xs) + +data CountDown = CD !StdGen !Int + +runCountDown :: Int -> State CountDown a -> a +runCountDown n x = fst $ runState x (CD (mkStdGen n) n) hunk ./Mosaic.hs 187 - 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 +tries_left :: State CountDown Int +tries_left = do CD _ n <- get + return (max 0 n) hunk ./Mosaic.hs 191 +mapCD :: (a -> State CountDown b) -> [a] -> State CountDown [b] +mapCD f xs = do n <- tries_left + let len = length xs + mapM (run_with_only ((n `div` len)+1) . f) $ take (n+1) xs hunk ./Mosaic.hs 196 +run_with_only :: Int -> State CountDown a -> State CountDown a +run_with_only limit j = + do CD g n <- get + let leftover = n - limit + if leftover < 0 then j + else do put $ CD g limit + x <- j + CD g' n' <- get + put $ CD g' (leftover + n') + return x hunk ./Mosaic.hs 207 -catRated :: Num v => [Rated v a] -> Rated v [a] -catRated xs = Rated (sum $ map the_rating xs) (map the_value xs) +getOne :: (Random a) => (a,a) -> State CountDown a +getOne bounds = do CD g n <- get + (x,g') <- return $ randomR bounds g + put $ CD g' n + return x + +fractional :: Int -> State CountDown Double +fractional n = ((/ fromIntegral n).fromIntegral) `fmap` getOne (1,n) hunk ./Mosaic.hs 216 -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 +data WindowHint = RelArea Double + | AspectRatio Double + | FlexibleAspectRatio Double + deriving ( Show, Read, Eq, Ord ) + +fixedAspect :: [WindowHint] -> Bool +fixedAspect [] = False +fixedAspect (AspectRatio _:_) = True +fixedAspect (_:x) = fixedAspect x + +rate :: Double -> Double -> [WindowHint] -> Rectangle -> Double +rate defaulta meanarea xs rr + | fixedAspect xs = (area (crop xs rr) / meanarea) ** weight + | otherwise = (area rr / meanarea)**(weight-flexibility) + * (area (crop (xs++[FlexibleAspectRatio defaulta]) rr) / meanarea)**flexibility + where weight = hints2area xs + +crop :: [WindowHint] -> Rectangle -> Rectangle +crop (AspectRatio f:_) = cropit f +crop (FlexibleAspectRatio f:_) = cropit f +crop (_:hs) = crop hs +crop [] = id hunk ./Mosaic.hs 239 -area :: Rectangle -> Area +crop' :: [WindowHint] -> Rectangle -> Rectangle +crop' (AspectRatio f:_) = cropit f +crop' (_:hs) = crop' hs +crop' [] = id + +cropit :: Double -> Rectangle -> Rectangle +cropit f (Rectangle a b w h) | w -/- h > f = Rectangle a b (floor $ h -* f) h + | otherwise = Rectangle a b w (floor $ w -/ f) + +hints2area :: [WindowHint] -> Double +hints2area [] = defaultArea +hints2area (RelArea r:x) = r +hints2area (_:x) = hints2area x + +area :: Rectangle -> Double area (Rectangle _ _ w h) = fromIntegral w * fromIntegral h hunk ./Mosaic.hs 256 -(///) :: (Integral a, Integral b) => a -> b -> Rational -a /// b = fromIntegral a / fromIntegral b +(-/-) :: (Integral a, Integral b) => a -> b -> Double +a -/- b = fromIntegral a / fromIntegral b + +(-/) :: (Integral a) => a -> Double -> Double +a -/ b = fromIntegral a / b hunk ./Mosaic.hs 262 +(-*) :: (Integral a) => a -> Double -> Double +a -* b = fromIntegral a * b hunk ./Mosaic.hs 265 -split :: CutDirection -> Rational -> Rectangle -> (Rectangle, Rectangle) +split :: CutDirection -> Double -> 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 hunk ./Mosaic.hs 281 data Mosaic a where M :: [Mosaic a] -> Mosaic a OM :: a -> Mosaic a + deriving ( Show ) flattenMosaic :: Mosaic a -> [a] flattenMosaic (OM a) = [a] hunk ./Mosaic.hs 290 allsplits :: [a] -> [[[a]]] allsplits [] = [[[]]] allsplits [a] = [[[a]]] -allsplits (x:xs) = (map ([x]:) splitsrest) ++ - (map (maphead (x:)) splitsrest) +allsplits (x:xs) = (map ([x]:) splitsrest) ++ (map (maphead (x:)) splitsrest) + where splitsrest = allsplits' xs + +allsplits' :: [a] -> [[[a]]] +allsplits' [] = [[[]]] +allsplits' [a] = [[[a]]] +allsplits' (x:xs) = (map (maphead (x:)) splitsrest) ++ (map ([x]:) splitsrest) where splitsrest = allsplits xs maphead :: (a->a) -> [a] -> [a] } [start switching over to a Monte Carlo algorithm for Mosaic David Roundy **20070601170505] < > { hunk ./Anneal.hs 3 module XMonadContrib.Anneal ( Rated(Rated), the_value, the_rating, anneal ) where +import System.Random ( StdGen, Random, mkStdGen, randomR ) +import Control.Monad.State ( State, runState, put, get, gets, modify ) + data Rated a b = Rated !a !b deriving ( Show ) instance Functor (Rated a) where hunk ./Anneal.hs 22 compare (Rated a _) (Rated a' _) = compare a a' anneal :: a -> (a -> Double) -> (a -> [a]) -> Rated Double a -anneal = undefined +anneal st r sel = runAnneal st r (do_anneal sel) + +do_anneal :: (a -> [a]) -> State (Anneal a) (Rated Double a) +do_anneal sel = do sequence_ $ replicate 100 da + gets best + where da = do select_metropolis sel + modify $ \s -> s { temperature = temperature s *0.99 } + +data Anneal a = A { g :: StdGen + , best :: Rated Double a + , current :: Rated Double a + , rate :: a -> Rated Double a + , temperature :: Double } + +runAnneal :: a -> (a -> Double) -> State (Anneal a) b -> b +runAnneal start r x = fst $ runState x (A { g = mkStdGen 137 + , best = Rated (r start) start + , current = Rated (r start) start + , rate = \xx -> Rated (r xx) xx + , temperature = 1.0 }) + +select_metropolis :: (a -> [a]) -> State (Anneal a) () +select_metropolis x = do c <- gets current + a <- select $ x $ the_value c + metropolis a + +metropolis :: a -> State (Anneal a) () +metropolis x = do r <- gets rate + c <- gets current + t <- gets temperature + let rx = r x + boltz = exp $ (the_rating c - the_rating rx) / t + if rx < c then do modify $ \s -> s { current = rx, best = rx } + else do p <- getOne (0,1) + if p < boltz + then modify $ \s -> s { current = rx } + else return () + +select :: [a] -> State (Anneal x) a +select [] = error "empty list in select" +select [x] = return x +select xs = do n <- getOne (0,length xs - 1) + return (xs !! n) + +getOne :: (Random a) => (a,a) -> State (Anneal x) a +getOne bounds = do s <- get + (x,g') <- return $ randomR bounds (g s) + put $ s { g = g' } + return x hunk ./Mosaic.hs 65 wideWindow = WideWindow largeNumber, mediumNumber, resolutionNumber :: Int -largeNumber = 200 +largeNumber = 50 mediumNumber = 10 resolutionNumber = 100 hunk ./Mosaic.hs 124 = do namedws <- mapM getName origws let sortedws = reverse $ map the_value $ sort $ map (\w -> Rated (sumareas [w]) w) namedws myv = runCountDown largeNumber $ mosaic_splits even_split origRect Vertical sortedws - myv2 = maxL $ runCountDown largeNumber $ - sequence $ replicate mediumNumber $ - mosaic_splits one_split origRect Vertical sortedws + myv2 = mc_mosaic sortedws Vertical + myh2 = mc_mosaic sortedws Horizontal +-- myv2 = maxL $ runCountDown largeNumber $ +-- sequence $ replicate mediumNumber $ +-- mosaic_splits one_split origRect Vertical sortedws myh = runCountDown largeNumber $ mosaic_splits even_split origRect Horizontal sortedws hunk ./Mosaic.hs 130 - myh2 = maxL $ runCountDown largeNumber $ - sequence $ replicate mediumNumber $ - mosaic_splits one_split origRect Horizontal sortedws - return $ map (\(nw,r)->(trace ("rate1:"++ unlines [show nw, - show $ rate f meanarea (findlist nw hints) r, - show r, - show $ area r/meanarea, - show $ findlist nw hints]) $ +-- myh2 = maxL $ runCountDown largeNumber $ +-- sequence $ replicate mediumNumber $ +-- mosaic_splits one_split origRect Horizontal sortedws + return $ map (\(nw,r)->(--trace ("rate1:"++ unlines [show nw, + -- show $ rate f meanarea (findlist nw hints) r, + -- show r, + -- show $ area r/meanarea, + -- show $ findlist nw hints]) $ unName nw,crop' (findlist nw hints) r)) $ hunk ./Mosaic.hs 139 - flattenMosaic $ the_value $ - trace ("ratings: "++ show (map the_rating [myv,myh,myv2,myh2])) $ - maxL [myv,myh,myv2,myh2] + flattenMosaic $ the_value $ maxL [myh2,myv2] where mosaic_splits _ _ _ [] = return $ Rated 0 $ M [] mosaic_splits _ r _ [w] = return $ Rated (rate f meanarea (findlist w hints) r) $ OM (w,r) mosaic_splits spl r d ws = maxL `fmap` mapCD (spl r d) (init $ allsplits ws) hunk ./Mosaic.hs 153 submosaics <- mapM (\(ws',r') -> mosaic_splits even_split r' (otherDirection d) ws') wsr_s return $ fmap M $ catRated submosaics + another_mosaic :: [NamedWindow] -> CutDirection + -> Rated Double (Mosaic (NamedWindow,Rectangle)) + another_mosaic ws d = rate_mosaic ratew $ + rect_mosaic origRect d $ + zipML (example_mosaic ws) (map findarea ws) + mc_mosaic :: [NamedWindow] -> CutDirection + -> Rated Double (Mosaic (NamedWindow,Rectangle)) + mc_mosaic ws d = fmap (rect_mosaic origRect d) $ + anneal (zipML (example_mosaic ws) (map findarea ws)) + (the_rating . rate_mosaic ratew . rect_mosaic origRect d ) + changeMosaic + + ratew :: (NamedWindow,Rectangle) -> Double + ratew (w,r) = rate f meanarea (findlist w hints) r + example_mosaic :: [NamedWindow] -> Mosaic NamedWindow + example_mosaic ws = M (map OM ws) + rect_mosaic :: Rectangle -> CutDirection -> Mosaic (a,Double) -> Mosaic (a,Rectangle) + rect_mosaic r _ (OM (w,_)) = OM (w,r) + rect_mosaic r d (M ws) = M $ zipWith (\w' r' -> rect_mosaic r' d' w') ws rs + where areas = map (sum . map snd . flattenMosaic) ws + rs = partitionR d r areas + d' = otherDirection d + rate_mosaic :: ((NamedWindow,Rectangle) -> Double) + -> Mosaic (NamedWindow,Rectangle) -> Rated Double (Mosaic (NamedWindow,Rectangle)) + rate_mosaic r m = catRatedM $ fmap (\x -> Rated (r x) x) m +{- one_split :: Rectangle -> CutDirection -> [[NamedWindow]] -> State CountDown (Rated Double (Mosaic (NamedWindow, Rectangle))) one_split r d [ws] = one_split r d $ map (:[]) ws hunk ./Mosaic.hs 189 submosaics <- mapM (\(ws',r') -> mosaic_splits even_split r' (otherDirection d) ws') wsr_s return $ fmap M $ catRated submosaics - +-} partitionR :: CutDirection -> Rectangle -> [Double] -> [Rectangle] partitionR _ _ [] = [] partitionR _ r [_] = [r] hunk ./Mosaic.hs 197 where totarea = sum (a:ars) (r1,r2) = split d (a/totarea) r theareas = hints2area `fmap` hints - sumareas ws = sum $ map (\w -> M.findWithDefault 1 w theareas) ws + sumareas ws = sum $ map findarea ws + findarea :: NamedWindow -> Double + findarea w = M.findWithDefault 1 w theareas meanarea = area origRect / fromIntegral (length origws) maxL :: Ord a => [a] -> a hunk ./Mosaic.hs 210 catRated :: Floating v => [Rated v a] -> Rated v [a] catRated xs = Rated (product $ map the_rating xs) (map the_value xs) +catRatedM :: Floating v => Mosaic (Rated v a) -> Rated v (Mosaic a) +catRatedM (OM (Rated v x)) = Rated v (OM x) +catRatedM (M xs) = case catRated $ map catRatedM xs of Rated v xs' -> Rated v (M xs') + data CountDown = CD !StdGen !Int runCountDown :: Int -> State CountDown a -> a hunk ./Mosaic.hs 239 put $ CD g' (leftover + n') return x -getOne :: (Random a) => (a,a) -> State CountDown a -getOne bounds = do CD g n <- get - (x,g') <- return $ randomR bounds g - put $ CD g' n - return x - -fractional :: Int -> State CountDown Double -fractional n = ((/ fromIntegral n).fromIntegral) `fmap` getOne (1,n) - data WindowHint = RelArea Double | AspectRatio Double | FlexibleAspectRatio Double hunk ./Mosaic.hs 306 OM :: a -> Mosaic a deriving ( Show ) +instance Functor Mosaic where + fmap f (OM x) = OM (f x) + fmap f (M xs) = M (map (fmap f) xs) + +zipMLwith :: (a -> b -> c) -> Mosaic a -> [b] -> Mosaic c +zipMLwith f (OM x) (y:_) = OM (f x y) +zipMLwith _ (OM _) [] = error "bad zipMLwith" +zipMLwith f (M xxs) yys = makeM $ foo xxs yys + where foo (x:xs) ys = zipMLwith f x (take (lengthM x) ys) : + foo xs (drop (lengthM x) ys) + foo [] _ = [] + +zipML :: Mosaic a -> [b] -> Mosaic (a,b) +zipML = zipMLwith (\a b -> (a,b)) + +lengthM :: Mosaic a -> Int +lengthM (OM _) = 1 +lengthM (M x) = sum $ map lengthM x + +changeMosaic :: Mosaic a -> [Mosaic a] +changeMosaic (OM a) = [] +changeMosaic (M xs) = [makeM $ reverse xs] ++ + map makeM (concatenations xs) ++ + map makeM (splits xs) -- should also change the lower level + +splits :: [Mosaic a] -> [[Mosaic a]] +splits [] = [] +splits (OM x:y) = map (OM x:) $ splits y +splits (M (x:y):z) = (x:makeM y:z) : map (makeM (x:y) :) (splits z) +splits (M []:x) = splits x + +concatenations :: [Mosaic a] -> [[Mosaic a]] +concatenations (x:y:z) = (concatenateMosaic x y:z):(map (x:) $ concatenations (y:z)) +concatenations _ = [] + +concatenateMosaic :: Mosaic a -> Mosaic a -> Mosaic a +concatenateMosaic (OM a) (OM b) = M [OM a, OM b] +concatenateMosaic (OM a) (M b) = M (OM a:b) +concatenateMosaic (M a) (OM b) = M (a++[OM b]) +concatenateMosaic (M a) (M b) = M (a++b) + +makeM :: [Mosaic a] -> Mosaic a +makeM [m] = m +makeM [] = error "makeM []" +makeM ms = M ms + flattenMosaic :: Mosaic a -> [a] flattenMosaic (OM a) = [a] flattenMosaic (M xs) = concatMap flattenMosaic xs } [cut obsolete description of mosaic. David Roundy **20070609131456] < > { hunk ./Mosaic.hs 5 tallWindow, wideWindow, getName, withNamedWindow ) 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. +-- This module defines a "mosaic" layout, which tries to give each window a +-- user-configurable relative area, while also trying to give them aspect +-- ratios configurable at run-time by the user. See comments below for the +-- key bindings. -- You can use this module with the following in your config file: } [improve changeMosaic. David Roundy **20070601175042] < > { hunk ./Mosaic.hs 322 changeMosaic :: Mosaic a -> [Mosaic a] changeMosaic (OM a) = [] -changeMosaic (M xs) = [makeM $ reverse xs] ++ - map makeM (concatenations xs) ++ - map makeM (splits xs) -- should also change the lower level +changeMosaic (M xs) = map makeM (concatenations xs) ++ + map makeM (splits xs) ++ + map M (tryAll changeMosaic xs) + +tryAll :: (a -> [a]) -> [a] -> [[a]] +tryAll _ [] = [] +tryAll f (x:xs) = map (:xs) (f x) ++ map (x:) (tryAll f xs) + +onceToEach :: (a -> a) -> [a] -> [[a]] +onceToEach _ [] = [] +onceToEach f (x:xs) = (f x : xs) : map (x:) (onceToEach f xs) splits :: [Mosaic a] -> [[Mosaic a]] splits [] = [] } [fix error in select. David Roundy **20070601183147] < > { hunk ./Anneal.hs 60 then modify $ \s -> s { current = rx } else return () -select :: [a] -> State (Anneal x) a -select [] = error "empty list in select" +select :: [a] -> State (Anneal a) a +select [] = the_value `fmap` gets best select [x] = return x select xs = do n <- getOne (0,length xs - 1) return (xs !! n) } [maximize rather than minimize the rating. David Roundy **20070601183240] < > { hunk ./Anneal.hs 1 -module XMonadContrib.Anneal ( Rated(Rated), the_value, the_rating, anneal ) where +module XMonadContrib.Anneal ( Rated(Rated), the_value, the_rating + , anneal, annealMax ) where import System.Random ( StdGen, Random, mkStdGen, randomR ) import Control.Monad.State ( State, runState, put, get, gets, modify ) hunk ./Anneal.hs 25 anneal :: a -> (a -> Double) -> (a -> [a]) -> Rated Double a anneal st r sel = runAnneal st r (do_anneal sel) +annealMax :: a -> (a -> Double) -> (a -> [a]) -> Rated Double a +annealMax st r sel = runAnneal st (negate . r) (do_anneal sel) + do_anneal :: (a -> [a]) -> State (Anneal a) (Rated Double a) do_anneal sel = do sequence_ $ replicate 100 da gets best hunk ./Mosaic.hs 156 mc_mosaic :: [NamedWindow] -> CutDirection -> Rated Double (Mosaic (NamedWindow,Rectangle)) mc_mosaic ws d = fmap (rect_mosaic origRect d) $ - anneal (zipML (example_mosaic ws) (map findarea ws)) + annealMax (zipML (example_mosaic ws) (map findarea ws)) (the_rating . rate_mosaic ratew . rect_mosaic origRect d ) changeMosaic } [update Mosaic for latest changes. David Roundy **20070610145816] < > { hunk ./Mosaic.hs 33 import Data.Ratio import Graphics.X11.Xlib import XMonad hiding ( trace ) -import Operations ( Resize(Shrink, Expand) ) +import Operations ( full, Resize(Shrink, Expand) ) import qualified Data.Map as M import Data.List ( sort ) import Data.Typeable ( Typeable ) hunk ./Mosaic.hs 71 flexibility = 0.1 mosaic :: Double -> Double -> M.Map NamedWindow [WindowHint] -> Layout -mosaic delta tileFrac hints = Layout { doLayout = mosaicL tileFrac hints, modifyLayout = mlayout } +mosaic delta tileFrac hints = full { doLayout = mosaicL tileFrac hints, modifyLayout = return . mlayout } where mlayout x = (m1 `fmap` fromMessage x) `mplus` (m2 `fmap` fromMessage x) m1 Shrink = mosaic delta (tileFrac/(1+delta)) hints m1 Expand = mosaic delta (tileFrac*(1+delta)) hints } Context: [Fix name of xmonad-clock in compilation instructions. glasser@mit.edu**20070610155204] [display names of windows on tabs. David Roundy **20070610163729] [make Decoration draw the window initially. David Roundy **20070610163651 We still don't respond to expose events. :( ] [add Decoration module to be used to easily define decorations. David Roundy **20070610153939] [add sketch of tabbed layout. David Roundy **20070610153926] [make LayoutHints work with new modifyLayout (in X). David Roundy **20070610145740] [tag visibles with Don Stewart **20070610111931] [tweak pkill Don Stewart **20070610093027] [greedydoc dave@nullcube.com**20070610091056 Add documentation on how to use GreedyView as your default workspace switcher. ] [use all 3 load values Don Stewart **20070610090959] [Modified xmonad-clock.c to display battery information from ACPI (will work only on linux though). Also restored three load averages instead of only one. buisse@cs.chalmers.se**20070610090228] [example xinitrc Don Stewart **20070610085715] [update run-xmonad.sh Don Stewart **20070610063915] [no need for ./scripts/xmonad-status.c, update run-xmonad.sh Don Stewart **20070610062806] [add DynamicLog.hs Don Stewart **20070610062757] [remove out of date ./scripts/xmonad-status.hs Don Stewart **20070610005107] [improve xmonad-status.c Don Stewart **20070609140258] [Add C script for parsing new logging encoding, and displaying workspace info Don Stewart **20070609131856] [Submap: For creating keyboard submappings Jason Creighton **20070606061941] [make LayoutHints robust with regard to future addition of Layout fields. David Roundy **20070609173725] [missing unsetenv Don Stewart **20070609090127] [add tiny clock program (C) i'm using in the status bar Don Stewart **20070609080435] [remove obsolete 'examples' dir Don Stewart **20070609061450] [latest version of xmonad-status.hs Don Stewart **20070609060913] [remove dead version Don Stewart **20070609060857] [Circle layout Peter De Wachter **20070606064153 Windows are arranged in a circle around the master window. Rather nice to use with a mouse, if you got many windows open. Screenshot: http://caladan.rave.org/circle.png ] [nicer format for dynamic workspaces Don Stewart **20070606045705] [add script which only draws current workspace, and those with clients Don Stewart **20070606044544] [In docs, change name of program from mux to xmonad-status. glasser@mit.edu**20070605140045] [Add xmonad-status.hs Don Stewart **20070605132108 An external status bar client for xmonad. See screenshots: http://www.cse.unsw.edu.au/~dons/tmp/dons-dzen-status.png http://www.cse.unsw.edu.au/~dons/tmp/xmonad-dzen-tags.png ] [gapless tiled layout obeying size hints Peter De Wachter **20070605071716] [Contrib package for 6.4 users daniel@wagner-home.com**20070604225534] [add new LayoutHints module that makes layouts respect size hints. David Roundy **20070604213716] [XMonadContrib.ReadMap: a Read instance of Map for GHC 6.4 users daniel@wagner-home.com**20070602064318] [keybindings to warp pointer to window center daniel@wagner-home.com**20070602062328] [XMonadContrib.Commands: for workspace and screen commands, leave out W/S tag glasser@mit.edu**20070601161351] [New contrib module: run internal xmonad commands via dmenu glasser@mit.edu**20070601043849] [Note that my xinerama patch is now in dzen. glasser@mit.edu**20070601041112] [Rescreen is in main xmonad now Spencer Janssen **20070528050656] [replace "name" in NamedWindow with a Show instance. David Roundy **20070526185114] [[Spiral] blend in the scale factor so it doesn't have any effect on the smallest windows joe.thornber@gmail.com**20070525032732] [[Spiral] last rect takes all available space joe.thornber@gmail.com**20070524120239] [[Spiral] Introduce a simpler Rect data type to remove a lot of the fromIntegrals joe.thornber@gmail.com**20070524100423] [[Spiral] divideRects now takes a list of directions to split in joe.thornber@gmail.com**20070524090211] [[Spiral] misc tidying joe.thornber@gmail.com**20070524085537] [[Spiral] remove old spiral code joe.thornber@gmail.com**20070524084805] [[Spiral] add fibonacci spiral joe.thornber@gmail.com**20070524084423] [Allow clients of NamedWindows to get at the name. glasser@mit.edu**20070523184251] [dzen module (with xinerama support, which requires glasser's Xinerama patch to dzen) glasser@mit.edu**20070523184315] [Extract NamedWindow support from Mosaic into its own module glasser@mit.edu**20070523155855] [remove SwapFocus (which is no longer possible) David Roundy **20070523153841 This module depended on the focus stack. ] [Fix Spiral's module name Spencer Janssen **20070522170909] [[SPIRAL] add spiral tiling layout joe.thornber@gmail.com**20070522062537] [Make RotView compile. Miikka Koskinen **20070522075338 As I'm not a Xinerama user, I'm not sure if rotView should consider only hidden workspaces or also visible but not focused workspaces. I thought hidden workspaces only would be more logical. ] [bug fix in DwmPromote. whoops. Miikka Koskinen **20070522062118] [make FindEmptyWorkspace compile Miikka Koskinen **20070521123239] [make DwmPromote compile Miikka Koskinen **20070521123140] [updated Dmenu.hs to work with zipper StackSet Jason Creighton **20070521233947] [Add GreedyView Spencer Janssen **20070521220048] [Rescreen: collects new screen information Spencer Janssen **20070521164808] [Fixes for windowset -> workspace rename Spencer Janssen **20070521042118] [TwoPane: hide windows that aren't in view Spencer Janssen **20070518224240] [make Mosaic even less picky by default. David Roundy **20070516175554] [add clear window message in Mosaic. David Roundy **20070516175518] [Comment only Spencer Janssen **20070517211003] [Add instructions for TwoPane Spencer Janssen **20070517210206] [Add TwoPane Spencer Janssen **20070517195618] [throttle the exponential expense when many windows are present. David Roundy **20070516022123] [XMonadContrib.FindEmptyWorkspace Miikka Koskinen **20070513184338 With this module you can find empty workspaces, view them and tag windows to them. ] [make DwmPromote compile Miikka Koskinen **20070513184254] [make DwmPromote compile again Miikka Koskinen **20070510154158] [make DwmPromote compile Miikka Koskinen **20070503105236] [make mosaic configure windows by name rather than by Window. David Roundy **20070512215644 Note that this is still pretty flawed. Often window names change, and the layout then stagnates a bit. Gimp, for example, opens most its windows with the same name before renaming them, so you have to hit mod-return or something to force a doLayout. Also, gimp still overrides xmonad regarding the size of its main window. :( ] [add SwapFocus. David Roundy **20070512191315] [make rotView only consider non-visible workspaces (Xinerama) Jason Creighton **20070510012059] [fix commend in RotView. David Roundy **20070505185654] [switch to Message type for layout messages Don Stewart **20070505014332] [Fix instructions in Mosaic. Chris Mears **20070503222345] [-Wall police Spencer Janssen **20070503211700] [Make RotView build, and add a brief description. Chris Mears **20070503104234] [comment: Gave URL to xinerama-enabled dmenu patch Jason Creighton **20070503053133] [add Mosaic layout. David Roundy **20070503151024] [Put dmenu in X too Spencer Janssen **20070503053727] [Add dmenu (thanks jcreigh) Spencer Janssen **20070503052225] [add RotView module. David Roundy **20070421233838] [XMonadContrib.DwmPromote: dwm-like promote Miikka Koskinen **20070501082031 I like the way dwm's equivalent to xmonad's promote works, so I implemented dwmpromote. ] [add simple date example Don Stewart **20070429064013] [more details Don Stewart **20070429061426] [add readme Don Stewart **20070429061329] [Initial import of xmonad contributions Don Stewart **20070429061150] Patch bundle hash: c668717893145463cfd30ae4609a71e2da96311c