From 106695b521dedb23e314d94ba9a87e7c2e142a37 Mon Sep 17 00:00:00 2001 From: Josh Rahm Date: Mon, 11 Apr 2022 22:58:45 -0600 Subject: Rename Zoom to Pop and move into its own Module. Much cleaner. --- src/Rahm/Desktop/Keys.hs | 15 +++---- src/Rahm/Desktop/Layout/Layout.hs | 60 +--------------------------- src/Rahm/Desktop/Layout/Pop.hs | 83 +++++++++++++++++++++++++++++++++++++++ 3 files changed, 93 insertions(+), 65 deletions(-) create mode 100644 src/Rahm/Desktop/Layout/Pop.hs (limited to 'src') diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs index 0bebd6f..7ca6161 100644 --- a/src/Rahm/Desktop/Keys.hs +++ b/src/Rahm/Desktop/Keys.hs @@ -54,6 +54,7 @@ import Rahm.Desktop.PassMenu import Rahm.Desktop.Logger import Rahm.Desktop.RebindKeys import Rahm.Desktop.Swallow +import Rahm.Desktop.Layout.Pop (PopMessage(..)) import Rahm.Desktop.ScreenRotate (screenRotateForward, screenRotateBackward) type KeyMap l = XConfig l -> Map (KeyMask, KeySym) (X ()) @@ -311,16 +312,16 @@ keymap = runKeys $ do bind xK_j $ do justMod $ - doc "Shrink the size of the zoom region" $ - sendMessage ShrinkZoom + doc "Shrink the size of the master region" $ + sendMessage Shrink shiftMod $ doc "Go to the previous window in history." historyPrev bind xK_k $ do justMod $ - doc "Expand the size of the zoom region" $ - sendMessage ExpandZoom + doc "Expand the size of the master region" $ + sendMessage Expand shiftMod $ doc "Go to the next window in history." historyNext @@ -524,7 +525,7 @@ keymap = runKeys $ do bind xK_z $ do noMod -|- justMod $ doc "Toggle zoom on the current window." $ - sendMessage ToggleZoom + sendMessage TogglePop -- Z is reserved to create sub keybindings to do various things. -- I don't really use these at the moment. @@ -536,7 +537,7 @@ keymap = runKeys $ do -- modifier. shiftMod $ doc "Toggle zoom on the current window." $ - sendMessage ToggleZoom + sendMessage TogglePop bind xF86XK_Calculator $ do noMod $ spawnX $ terminal config ++ " -t Floating\\ Term -e /usr/bin/env python3" @@ -625,7 +626,7 @@ mouseMap = runButtons $ do noMod $ noWindow $ click >> CopyWindow.kill1 bind button14 $ do - noMod $ noWindow $ click >> sendMessage ToggleZoom + noMod $ noWindow $ click >> sendMessage TogglePop bind button15 $ do noMod $ noWindow $ spawnX "pavucontrol" diff --git a/src/Rahm/Desktop/Layout/Layout.hs b/src/Rahm/Desktop/Layout/Layout.hs index 93228e7..fd34c33 100644 --- a/src/Rahm/Desktop/Layout/Layout.hs +++ b/src/Rahm/Desktop/Layout/Layout.hs @@ -27,6 +27,7 @@ import Rahm.Desktop.Layout.CornerLayout (Corner(..)) import Rahm.Desktop.Layout.LayoutList import Rahm.Desktop.Windows import Rahm.Desktop.Layout.ReinterpretMessage +import Rahm.Desktop.Layout.Pop import qualified Data.Map as M import qualified XMonad.StackSet as W @@ -87,7 +88,7 @@ reinterpretIncMaster :: reinterpretIncMaster = ModifiedLayout ReinterpretMessage mods = - ModifiedLayout (Zoomable False 0.05 0.05) . + poppable . ModifiedLayout (Flippable False) . ModifiedLayout (HFlippable False) . ModifiedLayout (Rotateable False) @@ -137,10 +138,6 @@ instance DescriptionModifier ThreeColDescMod ThreeCol where newDescription _ (ThreeCol mast _ _) _ = "ThreeCol(" ++ show mast ++ ")" newDescription _ (ThreeColMid mast _ _) _ = "ThreeColMid(" ++ show mast ++ ")" -data ResizeZoom = ShrinkZoom | ExpandZoom deriving (Typeable) - -instance Message ResizeZoom where - newtype Flippable a = Flippable Bool -- True if flipped deriving (Show, Read) @@ -156,23 +153,10 @@ data HFlipLayout = HFlipLayout deriving (Typeable) data DoRotate = DoRotate deriving (Typeable) -data Zoomable a = Zoomable Bool Float Float -- True if zooming in on the focused window. - deriving (Show, Read) - --- Toggles if the current window should be zoomed or not. Set the boolean --- to set the zoom.mhar -data ZoomModifier = - ToggleZoom | - Zoom | - Unzoom - deriving (Typeable) - instance Message FlipLayout where instance Message HFlipLayout where -instance Message ZoomModifier where - instance Message DoRotate where instance (Eq a) => LayoutModifier Rotateable a where @@ -241,43 +225,3 @@ instance (Eq a) => LayoutModifier HFlippable a where if flipped then descr ++ " HFlipped" else descr - - -instance (Eq a) => LayoutModifier Zoomable a where - redoLayout (Zoomable doit ws hs) (Rectangle x y w h) stack returned = - if doit - then - let focused = W.focus <$> stack - (zoomed, rest) = partition ((==focused) . Just . fst) returned - in case zoomed of - [] -> return (rest, Nothing) - ((fwin, _):_) -> return ((fwin, Rectangle (x + wp) (y + hp) (w - fromIntegral (wp * 2)) (h - fromIntegral (hp * 2))) : rest, Nothing) - - else return (returned, Nothing) - where - wp = floor $ fromIntegral w * ws - hp = floor $ fromIntegral h * hs - - handleMessOrMaybeModifyIt self@(Zoomable showing sw sh) mess = - return $ - (handleResize <$> fromMessage mess) - <|> (Left . handleZoom <$> fromMessage mess) - where - handleResize r = - if showing - then Left $ Zoomable showing (guard $ sw + d) (guard $ sh + d) - else Right $ case r of - ShrinkZoom -> SomeMessage Shrink - ExpandZoom -> SomeMessage Expand - - where d = (case r of - ShrinkZoom -> -1 - ExpandZoom -> 1) * 0.02 - - handleZoom ToggleZoom = Zoomable (not showing) sw sh - handleZoom Zoom = Zoomable True sw sh - handleZoom Unzoom = Zoomable False sw sh - - guard f | f > 1 = 1 - | f < 0 = 0 - | otherwise = f diff --git a/src/Rahm/Desktop/Layout/Pop.hs b/src/Rahm/Desktop/Layout/Pop.hs new file mode 100644 index 0000000..194e645 --- /dev/null +++ b/src/Rahm/Desktop/Layout/Pop.hs @@ -0,0 +1,83 @@ +{-# LANGUAGE DeriveAnyClass #-} + +-- | The Pap layout modifier allows the user to "pop" the focused window into a +-- frame in the middle of the screen, sort of like fullscreen, but only taking +-- up a percentage of the screen rather than the whole screen so other windows +-- are still visible, alebeit typically not usable. +module Rahm.Desktop.Layout.Pop (Poppable(..), PopMessage(..), poppable) where + +import XMonad +import XMonad.Layout.LayoutModifier (LayoutModifier(..), ModifiedLayout(..)) +import Data.Default (Default(..)) +import qualified XMonad.StackSet as W + +data Poppable a = Poppable { + -- True if the current window is popped out or not. + isPopped :: Bool + + -- Fraction of the screen width around the window. + , xFrac :: Float + + -- Fraction of the screen height around the window. + , yFrac :: Float + } deriving (Show, Read, Eq, Ord) + +instance Default (Poppable a) where + def = Poppable { + isPopped = False + , xFrac = 0.05 + , yFrac = 0.05 + } + +poppable :: l a -> ModifiedLayout Poppable l a +poppable = ModifiedLayout def + +-- Message to control the state of the popped layouts modifier. +data PopMessage = TogglePop | Pop | Unpop | ResizePop Float + deriving (Typeable, Show, Eq, Ord, Message) + +instance (Eq a) => LayoutModifier Poppable a where + + -- If the current layout is not popped, then just return what the underlying + -- layout returned. + redoLayout Poppable { isPopped = False } _ _ returned = + return (returned, Nothing) + + -- Can't do anything with an empty stack. + redoLayout _ _ Nothing returned = return (returned, Nothing) + + redoLayout self (Rectangle x y w h) (Just (W.focus -> focused)) returned = + return ((focused, newRect) : remaining, Nothing) + where + remaining = filter ((/=focused) . fst) returned + wp = floor $ fromIntegral w * xFrac self + hp = floor $ fromIntegral h * yFrac self + newRect = Rectangle + (x + wp) + (y + hp) + (w - fromIntegral (wp * 2)) + (h - fromIntegral (hp * 2)) + + -- Handle the Pop messages associated with this layout. + pureMess self (fromMessage -> Just mess) = + Just $ case mess of + TogglePop -> self { isPopped = not (isPopped self) } + Pop -> self { isPopped = True } + Unpop -> self { isPopped = False } + ResizePop amt -> self { + xFrac = guard (xFrac self + amt), + yFrac = guard (yFrac self + amt) + } + where + guard = min 0.45 . max 0 + + -- Handle Shrink and Expand if it is currently in the popped state. + pureMess + self@Poppable { isPopped = True } + (fromMessage -> Just mess) = + pureMess self $ SomeMessage $ + case mess of + Shrink -> ResizePop (-0.05) + Expand -> ResizePop 0.05 + + pureMess _ _ = Nothing -- cgit