From cecacbf482f90d0ed56ce320fbb557b22cd3d7b0 Mon Sep 17 00:00:00 2001 From: Josh Rahm Date: Wed, 13 Apr 2022 00:22:08 -0600 Subject: 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. --- package.yaml | 1 + src/Rahm/Desktop/Keys.hs | 5 ++- src/Rahm/Desktop/Layout.hs | 17 +++---- src/Rahm/Desktop/Layout/ConsistentMosaic.hs | 69 +++++++++++++++++++++++++++++ src/Rahm/Desktop/Layout/Draw.hs | 2 +- 5 files changed, 83 insertions(+), 11 deletions(-) create mode 100644 src/Rahm/Desktop/Layout/ConsistentMosaic.hs diff --git a/package.yaml b/package.yaml index 7e7244c..f4f5603 100644 --- a/package.yaml +++ b/package.yaml @@ -40,3 +40,4 @@ dependencies: - monad-loops - data-default - linear + - bimap 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 "\"" -- cgit