aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--XMonad/Config/Droundy.hs20
-rw-r--r--XMonad/Layout/Mosaic.hs111
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"