aboutsummaryrefslogtreecommitdiff
path: root/src/Rahm/Desktop/Layout
diff options
context:
space:
mode:
Diffstat (limited to 'src/Rahm/Desktop/Layout')
-rw-r--r--src/Rahm/Desktop/Layout/ConsistentMosaic.hs69
-rw-r--r--src/Rahm/Desktop/Layout/Draw.hs2
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 "\""