diff options
Diffstat (limited to 'src/Rahm/Desktop/Layout')
| -rw-r--r-- | src/Rahm/Desktop/Layout/ConsistentMosaic.hs | 69 | ||||
| -rw-r--r-- | src/Rahm/Desktop/Layout/Draw.hs | 2 |
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 "\"" |