clean up mosaic a bit more.

darcs-hash:20071123153617-72aca-1b2d907ca57d26706485c5ca971fda2cceb7ad95.gz

2 files changed, 79 insertions, 52 deletions

diff --git a/XMonad/Config/Droundy.hs b/XMonad/Config/Droundy.hs
index 43aad85..7aed984 100644
--- a/XMonad/Config/Droundy.hs
+++ b/XMonad/Config/Droundy.hs
@@ -27,6 +27,7 @@ import Graphics.X11.Xlib
 
 import XMonad.Layout.Tabbed
 import XMonad.Layout.Combo
+import XMonad.Layout.Mosaic
 import XMonad.Layout.Named
 import XMonad.Layout.LayoutCombinators
 import XMonad.Layout.Square
@@ -109,6 +110,16 @@ keys x = M.fromList $
     , ((modMask x .|. shiftMask, xK_r), renameWorkspace myXPConfig)
     , ((modMask x, xK_l ), layoutPrompt myXPConfig)
     , ((modMask x .|. controlMask, xK_space), sendMessage ToggleLayout)
+
+-- keybindings for Mosaic:
+    , ((controlMask .|. modMask x .|. shiftMask, xK_h), withFocused (sendMessage . tallWindow))
+    , ((controlMask .|. modMask x .|. shiftMask, xK_l), withFocused (sendMessage . wideWindow))
+    , ((modMask x .|. shiftMask, xK_h     ), withFocused (sendMessage . shrinkWindow))
+    , ((modMask x .|. shiftMask, xK_l     ), withFocused (sendMessage . expandWindow))
+    , ((modMask x .|. shiftMask, xK_s     ), withFocused (sendMessage . squareWindow))
+    , ((modMask x .|. shiftMask, xK_o     ), withFocused (sendMessage . myclearWindow))
+    , ((controlMask .|. modMask x .|. shiftMask, xK_o     ), withFocused (sendMessage . flexibleWindow))
+
     ]
  
     ++
@@ -119,10 +130,13 @@ keys x = M.fromList $
 config = defaultConfig
          { borderWidth = 1 -- Width of the window border in pixels.
          , XMonad.workspaces = ["1:mutt","2:iceweasel"]
-         , layoutHook = workspaceDir "~" $ windowNavigation $ toggleLayouts (noBorders Full) $
+         , layoutHook = workspaceDir "~" $ windowNavigation $
+                        toggleLayouts (noBorders Full) $ -- avoidStruts $
                         Named "tabbed" (noBorders mytab) |||
-                        Named "xclock" (mytab <-/> combineTwo Square mytab mytab) |||
-                        mytab <//> mytab
+                        Named "xclock" (mytab <-//> combineTwo Square mytab mytab) |||
+                        Named "widescreen" ((mytab <||> mytab)
+                                                <-//> combineTwo Square mytab mytab) |||
+                        mosaic 0.25 0.5
          , terminal = "xterm" -- The preferred terminal program.
          , normalBorderColor = "#dddddd" -- Border color for unfocused windows.
          , focusedBorderColor = "#00ff00" -- Border color for focused windows.
diff --git a/XMonad/Layout/Mosaic.hs b/XMonad/Layout/Mosaic.hs
index eaf81ab..dbd6eff 100644
--- a/XMonad/Layout/Mosaic.hs
+++ b/XMonad/Layout/Mosaic.hs
@@ -20,12 +20,13 @@ module XMonad.Layout.Mosaic (
                              -- $usage
                              mosaic, expandWindow, shrinkWindow, squareWindow, myclearWindow,
                              tallWindow, wideWindow, flexibleWindow,
-                             getName, withNamedWindow ) where
+                             getName ) where
 
 import Control.Monad.State ( State, put, get, runState )
 import System.Random ( StdGen, mkStdGen )
 
 import Graphics.X11.Xlib
+import Graphics.X11.Xlib.Extras ( getWMNormalHints, sh_aspect )
 import XMonad hiding ( trace )
 import XMonad.Layouts ( Resize(Shrink, Expand) )
 import qualified XMonad.StackSet as W
@@ -54,27 +55,27 @@ import XMonad.Util.Anneal
 --
 -- In the key-bindings, do something like:
 --
--- >   , ((controlMask .|. modMask x .|. shiftMask, xK_h), withNamedWindow (sendMessage . tallWindow))
--- >   , ((controlMask .|. modMask x .|. shiftMask, xK_l), withNamedWindow (sendMessage . wideWindow))
--- >   , ((modMask x .|. shiftMask, xK_h     ), withNamedWindow (sendMessage . shrinkWindow))
--- >   , ((modMask x .|. shiftMask, xK_l     ), withNamedWindow (sendMessage . expandWindow))
--- >   , ((modMask x .|. shiftMask, xK_s     ), withNamedWindow (sendMessage . squareWindow))
--- >   , ((modMask x .|. shiftMask, xK_o     ), withNamedWindow (sendMessage . myclearWindow))
--- >   , ((controlMask .|. modMask x .|. shiftMask, xK_o     ), withNamedWindow (sendMessage . flexibleWindow))
+-- >   , ((controlMask .|. modMask x .|. shiftMask, xK_h), withFocused (sendMessage . tallWindow))
+-- >   , ((controlMask .|. modMask x .|. shiftMask, xK_l), withFocused (sendMessage . wideWindow))
+-- >   , ((modMask x .|. shiftMask, xK_h     ), withFocused (sendMessage . shrinkWindow))
+-- >   , ((modMask x .|. shiftMask, xK_l     ), withFocused (sendMessage . expandWindow))
+-- >   , ((modMask x .|. shiftMask, xK_s     ), withFocused (sendMessage . squareWindow))
+-- >   , ((modMask x .|. shiftMask, xK_o     ), withFocused (sendMessage . myclearWindow))
+-- >   , ((controlMask .|. modMask x .|. shiftMask, xK_o     ), withFocused (sendMessage . flexibleWindow))
 --
 -- For detailed instruction on editing the key binding see:
 --
 -- "XMonad.Doc.Extending#Editing_key_bindings".
 
-data HandleWindow = ExpandWindow NamedWindow | ShrinkWindow NamedWindow
-                  | SquareWindow NamedWindow | ClearWindow NamedWindow
-                  | TallWindow NamedWindow | WideWindow NamedWindow
-                  | FlexibleWindow NamedWindow
+data HandleWindow = ExpandWindow Window | ShrinkWindow Window
+                  | SquareWindow Window | ClearWindow Window
+                  | TallWindow Window | WideWindow Window
+                  | FlexibleWindow Window
                     deriving ( Typeable, Eq )
 
 instance Message HandleWindow
 
-expandWindow, shrinkWindow, squareWindow, flexibleWindow, myclearWindow,tallWindow, wideWindow :: NamedWindow -> HandleWindow
+expandWindow, shrinkWindow, squareWindow, flexibleWindow, myclearWindow,tallWindow, wideWindow :: Window -> HandleWindow
 expandWindow   = ExpandWindow
 shrinkWindow   = ShrinkWindow
 squareWindow   = SquareWindow
@@ -95,7 +96,7 @@ flexibility = 0.1
 mosaic :: Double -> Double -> MosaicLayout Window
 mosaic d t = Mosaic d t M.empty
 
-data MosaicLayout a = Mosaic Double Double (M.Map String [WindowHint])
+data MosaicLayout a = Mosaic Double Double (M.Map Window [WindowHint])
               deriving ( Show, Read )
 
 instance LayoutClass MosaicLayout Window where
@@ -111,52 +112,51 @@ instance LayoutClass MosaicLayout Window where
           m2 (FlexibleWindow w) = Mosaic d t (make_flexible w h)
           m2 (TallWindow w)     = Mosaic d t (multiply_aspect (1/(1+d)) w h)
           m2 (WideWindow w)     = Mosaic d t (multiply_aspect (1+d) w h)
-          m2 (ClearWindow w)    = Mosaic d t (M.delete (show w) h)
+          m2 (ClearWindow w)    = Mosaic d t (M.delete w h)
 
-    description _ = "The Original Mosaic"
+    description _ = "mosaic"
 
-multiply_area :: Double -> NamedWindow
-              -> M.Map String [WindowHint] -> M.Map String [WindowHint]
+multiply_area :: Double -> Window
+              -> M.Map Window [WindowHint] -> M.Map Window [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
 
-set_aspect_ratio :: Double -> NamedWindow
-                 -> M.Map String [WindowHint] -> M.Map String [WindowHint]
+set_aspect_ratio :: Double -> Window
+                 -> M.Map Window [WindowHint] -> M.Map Window [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
 
-make_flexible :: NamedWindow
-              -> M.Map String [WindowHint] -> M.Map String [WindowHint]
+make_flexible :: Window
+              -> M.Map Window [WindowHint] -> M.Map Window [WindowHint]
 make_flexible = alterlist (map f) where f (AspectRatio r) = FlexibleAspectRatio r
                                         f (FlexibleAspectRatio r) = AspectRatio r
                                         f x = x
 
-multiply_aspect :: Double -> NamedWindow
-                -> M.Map String [WindowHint] -> M.Map String [WindowHint]
+multiply_aspect :: Double -> Window
+                -> M.Map Window [WindowHint] -> M.Map Window [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
 
-findlist :: NamedWindow -> M.Map String [a] -> [a]
-findlist = M.findWithDefault [] . show
+findlist :: Window -> M.Map Window [a] -> [a]
+findlist = M.findWithDefault []
 
-alterlist :: (Ord a) => ([a] -> [a]) -> NamedWindow -> M.Map String [a] -> M.Map String [a]
-alterlist f k = M.alter f' $ show k
+alterlist :: (Ord a) => ([a] -> [a]) -> Window -> M.Map Window [a] -> M.Map Window [a]
+alterlist f k = M.alter f' k
     where f' Nothing = f' (Just [])
           f' (Just xs) = case f xs of
                            [] -> Nothing
                            xs' -> Just xs'
 
-mosaicL :: Double -> M.Map String [WindowHint]
+mosaicL :: Double -> M.Map Window [WindowHint]
         -> Rectangle -> [Window] -> X ([(Window, Rectangle)],Maybe (MosaicLayout Window))
 mosaicL _ _ _ [] = return ([], Nothing)
 mosaicL f hints origRect origws
-    = do namedws <- mapM getName origws
-         let sortedws = reverse $ map the_value $ sort $ map (\w -> Rated (sumareas [w]) w) namedws
+    = do let sortedws = reverse $ map the_value $ sort $ map (\w -> Rated (sumareas [w]) w) origws
              -- TODO: remove all this dead code
              myv = runCountDown largeNumber $ mosaic_splits even_split origRect Vertical sortedws
              myv2 = mc_mosaic sortedws Vertical
@@ -168,43 +168,44 @@ mosaicL f hints origRect origws
 --             myh2 = maxL $ runCountDown largeNumber $
 --                    sequence $ replicate mediumNumber $
 --                    mosaic_splits one_split origRect Horizontal sortedws
-         return (map (\(nw,r)->(--trace ("rate1:"++ unlines [show nw,
+         all_hints <- add_hints origws hints
+         return (map (\(w,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)) $
+                                 w,crop' (findlist w all_hints) r)) $
                 flattenMosaic $ the_value $ maxL [myh,myv,myh2,myv2], Nothing)
     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 :: Rectangle -> CutDirection -> [[Window]]
+                     -> State CountDown (Rated Double (Mosaic (Window, 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)]
+                 let wsr_s :: [([Window], 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
           {-
-          another_mosaic :: [NamedWindow] -> CutDirection
-                         -> Rated Double (Mosaic (NamedWindow,Rectangle))
+          another_mosaic :: [Window] -> CutDirection
+                         -> Rated Double (Mosaic (Window,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 :: [Window] -> CutDirection
+                         -> Rated Double (Mosaic (Window,Rectangle))
           mc_mosaic ws d = fmap (rect_mosaic origRect d) $
                            annealMax (zipML (example_mosaic ws) (map findarea ws))
                            (the_rating . rate_mosaic ratew . rect_mosaic origRect d )
                            changeMosaic
 
-          ratew :: (NamedWindow,Rectangle) -> Double
+          ratew :: (Window,Rectangle) -> Double
           ratew (w,r) = rate f meanarea (findlist w hints) r
-          example_mosaic :: [NamedWindow] -> Mosaic NamedWindow
+          example_mosaic :: [Window] -> Mosaic Window
           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)
@@ -212,16 +213,16 @@ mosaicL f hints origRect origws
               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 :: ((Window,Rectangle) -> Double)
+                      -> Mosaic (Window,Rectangle) -> Rated Double (Mosaic (Window,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 :: Rectangle -> CutDirection -> [[Window]]
+                    -> State CountDown (Rated Double (Mosaic (Window, 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)]
+                 let wsr_s :: [([Window], Rectangle)]
                      wsr_s = zip wss (partitionR d r rnd)
                  submosaics <- mapM (\(ws',r') ->
                                      mosaic_splits even_split r' (otherDirection d) ws') wsr_s
@@ -235,9 +236,21 @@ mosaicL f hints origRect origws
                     (r1,r2) = split d (a/totarea) r
           theareas = hints2area `fmap` hints
           sumareas ws = sum $ map findarea ws
-          findarea :: NamedWindow -> Double
-          findarea w = M.findWithDefault 1 (show w) theareas
+          findarea :: Window -> Double
+          findarea w = M.findWithDefault 1 w theareas
           meanarea =  area origRect / fromIntegral (length origws)
+          add_hints [] x = return x
+          add_hints (w:ws) x =
+              do h <- withDisplay $ \d -> io $ getWMNormalHints d w
+                 case map4 `fmap` sh_aspect h of
+                   Just ((minx,miny),(maxx,maxy))
+                       | or [minx < 1, miny < 1, maxx < 1, maxy < 1] -> add_hints ws x
+                       | minx/miny == maxx/maxy -> add_hints ws $ set_aspect_ratio (minx/miny) w x
+                       | otherwise -> add_hints ws $ make_flexible w $
+                                      set_aspect_ratio (sqrt $ minx*maxx/miny/maxy) w x
+                   Nothing -> add_hints ws x
+          map4 :: Integral a => ((a,a),(a,a)) -> ((Double,Double),(Double,Double))
+          map4 ((a,b),(c,d)) = ((fromIntegral a,fromIntegral b),(fromIntegral c,fromIntegral d))
 
 maxL :: Ord a => [a] -> a
 maxL [] = error "maxL on empty list"