Add ConsistentMosaic, a wrapper to make Mosaic more consistent.

Right now, Mosaic operate on the windows itself. But this means that
swapping windows can act very unintuitively. This wrapper changes
mosaci to work on window /positions/ rather than windows themselves,
so the window in position 1 will always be the same size, and when moved
to position 2, it will inherit that position's size.

There's still some buggy behavior, but it is in general much more
intuitive than it was before.

4 files changed, 82 insertions, 11 deletions

diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs
index 622fd3a..f7aae3c 100644
--- a/src/Rahm/Desktop/Keys.hs
+++ b/src/Rahm/Desktop/Keys.hs
@@ -60,6 +60,7 @@ import Rahm.Desktop.Layout.Pop (togglePop)
 import Rahm.Desktop.Layout.Flip (flipHorizontally, flipVertically)
 import Rahm.Desktop.Layout.Rotate (rotateLayout)
 import Rahm.Desktop.ScreenRotate (screenRotateForward, screenRotateBackward)
+import Rahm.Desktop.Layout.ConsistentMosaic
 
 type KeyMap l = XConfig l -> Map (KeyMask, KeySym) (X ())
 type ButtonsMap l = XConfig l -> Map (KeyMask, Button) (Window -> X ())
@@ -362,7 +363,7 @@ keymap = runKeys $ do
 
     shiftMod $
       doc "For mosaic layout, shrink the size-share of the current window" $
-      withFocused $ sendMessage . shrinkWindowAlt
+      sendMessage =<< shrinkPositionAlt
 
   bind xK_m $ do
     justMod $
@@ -389,7 +390,7 @@ keymap = runKeys $ do
 
     shiftMod $
       doc "For mosaic layout, increase the size-share of the current window." $
-      withFocused $ sendMessage . expandWindowAlt
+      sendMessage =<< expandPositionAlt
 
   bind xK_q $ do
     shiftMod $
diff --git a/src/Rahm/Desktop/Layout.hs b/src/Rahm/Desktop/Layout.hs
index bd875d0..d8c3442 100644
--- a/src/Rahm/Desktop/Layout.hs
+++ b/src/Rahm/Desktop/Layout.hs
@@ -33,6 +33,7 @@ import Rahm.Desktop.Layout.Flip
 import Rahm.Desktop.Layout.Rotate
 import Rahm.Desktop.Layout.Redescribe
 import Rahm.Desktop.Layout.Hole
+import Rahm.Desktop.Layout.ConsistentMosaic
 
 import qualified Data.Map as M
 import qualified XMonad.StackSet as W
@@ -50,7 +51,7 @@ mods =
 myLayoutList =
         layoutList $
           mods (reinterpretIncMaster $ spiral (6/7)) |:
-          mods (modifyMosaic (MosaicAlt M.empty :: MosaicAlt Window)) |:
+          mods (MosaicWrap $ modifyMosaic (MosaicAlt M.empty :: MosaicAlt Window)) |:
           mods (reinterpretIncMaster $ Corner (3/4) (3/100)) |:
           mods (Redescribe UsingTall (Tall 1 (3/100) (1/2))) |:
           mods (Redescribe UsingThreeCol (ThreeCol 1 (3/100) (1/2))) |:
@@ -72,17 +73,17 @@ instance DoReinterpret "ForMosaic" where
   
   -- IncMaster message
   reinterpretMessage _ (fromMessage -> Just (IncMasterN n)) = do
-    fmap (SomeMessage .
-      (if n > 0
-        then expandWindowAlt
-        else shrinkWindowAlt)) <$> getFocusedWindow
+    Just . SomeMessage <$> (
+      if n > 0
+        then expandPositionAlt
+        else shrinkPositionAlt)
   
   -- ResizeMaster message
   reinterpretMessage _ (fromMessage -> Just m) = do
-    fmap (SomeMessage .
+    Just . SomeMessage <$>
       (case m of
-        Expand -> expandWindowAlt
-        Shrink -> shrinkWindowAlt)) <$> getFocusedWindow
+        Expand -> expandPositionAlt
+        Shrink -> shrinkPositionAlt)
 
   -- Messages that don't match the above, just leave it unmodified.
   reinterpretMessage _ m = return (Just m)
diff --git a/src/Rahm/Desktop/Layout/ConsistentMosaic.hs b/src/Rahm/Desktop/Layout/ConsistentMosaic.hs
new file mode 100644
index 0000000..db1ce4e
--- /dev/null
+++ b/src/Rahm/Desktop/Layout/ConsistentMosaic.hs
@@ -0,0 +1,69 @@
+
+-- This module provides a wrapper around the Mosaic layout to create a more
+-- consistent experience where instead of the windows being the ones it works
+-- on, it instead works on the window places so things like window swapping
+-- still work as expected.
+module Rahm.Desktop.Layout.ConsistentMosaic where
+
+import XMonad
+import qualified XMonad.StackSet as W
+import qualified Data.Map as Map
+import Data.Map (Map)
+import Data.Maybe (mapMaybe)
+
+import XMonad.Layout.MosaicAlt
+
+import Rahm.Desktop.Windows
+import Rahm.Desktop.Logger
+
+
+newtype MosaicWrap l a = MosaicWrap (l a) deriving (Read, Show)
+
+doAlt :: (Window -> HandleWindowAlt) -> X HandleWindowAlt
+doAlt f = do
+  (W.StackSet (W.Screen (W.Workspace _ _ mStack) _ _) _ _ _)
+    <- windowset <$> get
+
+  return $
+    case mStack of
+      Nothing -> f 0
+      Just (W.Stack _ u _) -> f (fromIntegral $ length u + 100)
+
+expandPositionAlt :: X HandleWindowAlt
+expandPositionAlt = doAlt expandWindowAlt
+
+shrinkPositionAlt :: X HandleWindowAlt
+shrinkPositionAlt = doAlt shrinkWindowAlt
+
+
+instance (LayoutClass l a, Show a, Ord a, Enum a, Num a) => LayoutClass (MosaicWrap l) a where
+  
+  runLayout (W.Workspace t (MosaicWrap l) (id -> Just s)) rect = do
+    let zs = zipStack [100..] s
+        s' = mapStack fst zs
+        m = Map.fromList (W.integrate zs)
+
+    (rects, maybeNewLayout) <- runLayout (W.Workspace t l (Just s')) rect
+    let rects' =
+          flip mapMaybe rects $ \(place, rect) ->
+            (,rect) <$> Map.lookup place m
+
+    return (rects', MosaicWrap <$> maybeNewLayout)
+
+    where
+      zipStack as (W.Stack b c d) =
+        let (cz, bz : dz) = splitAt (length c) as in
+          W.Stack (bz, b) (zip (reverse cz) c) (zip dz d)
+
+
+  runLayout (W.Workspace t (MosaicWrap l) a) rect = do
+    (rects, maybeNewLayout) <- runLayout (W.Workspace t l a) rect
+    return (rects, MosaicWrap <$> maybeNewLayout)
+    
+
+  -- By default just pass the message to the underlying layout.
+  handleMessage (MosaicWrap l) mess = do
+    maybeNewLayout <- handleMessage l mess
+    return (MosaicWrap <$> maybeNewLayout)
+
+  description _ = "ConsistentMosaic"
diff --git a/src/Rahm/Desktop/Layout/Draw.hs b/src/Rahm/Desktop/Layout/Draw.hs
index 8819e8f..aa4dba3 100644
--- a/src/Rahm/Desktop/Layout/Draw.hs
+++ b/src/Rahm/Desktop/Layout/Draw.hs
@@ -136,7 +136,7 @@ drawXpm (w, h) rects' shrinkAmt = execWriter $ do
 
     forM_ zipRects $ \(char, (color, _)) -> do
       tell $ printf "\"%c c %s\",\n" char color
-    tell "\"% c None\"a,\n"
+    tell "\"% c None\",\n"
 
     forM_ [0 .. h - 1] $ \y -> do
       tell "\""