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.

2 files changed, 70 insertions, 1 deletions

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 "\""