From 9d4e7ae016180769eb050f4c2729475236f4ad34 Mon Sep 17 00:00:00 2001 From: Josh Rahm Date: Tue, 12 Apr 2022 00:23:26 -0600 Subject: Break the Flippable modifiers into their own file. This also combines the two into a single type. --- src/Rahm/Desktop/Layout/Flip.hs | 87 +++++++++++++++++++++++++++++++++++++++ src/Rahm/Desktop/Layout/Layout.hs | 58 +------------------------- 2 files changed, 89 insertions(+), 56 deletions(-) create mode 100644 src/Rahm/Desktop/Layout/Flip.hs (limited to 'src/Rahm/Desktop/Layout') diff --git a/src/Rahm/Desktop/Layout/Flip.hs b/src/Rahm/Desktop/Layout/Flip.hs new file mode 100644 index 0000000..e0d3abc --- /dev/null +++ b/src/Rahm/Desktop/Layout/Flip.hs @@ -0,0 +1,87 @@ +{-# LANGUAGE DeriveAnyClass #-} + +-- Layout modifier to flip a layout either horizontally or vertically or both. +module Rahm.Desktop.Layout.Flip ( + Flip(..), + flippable, + flipVertically, + flipHorizontally, + DoFlip + ) where + +import XMonad +import XMonad.Layout.LayoutModifier + +import Control.Arrow (second) +import Data.List (intercalate) +import Data.Default (Default(..)) + +-- A flipped layout is either flipped horizontally or vertically. +data Flip a = + Flip { + horiz :: Bool + , vert :: Bool + } deriving (Eq, Show, Ord, Read) + +-- Default instance for Flip. Both are set to false. +instance Default (Flip a) where + def = Flip False False + +-- Message for altering the Flip layout modifier. +data DoFlip where + -- Contains a function to modify Flip + DoFlip :: (forall k (a :: k). Flip a -> Flip a) -> DoFlip + deriving Message + +-- DoFlip is a monoid. +instance Semigroup DoFlip where + (<>) = mappend +instance Monoid DoFlip where + mempty = DoFlip id + mappend (DoFlip a) (DoFlip b) = DoFlip (a . b) + +-- Makes a layout Flippable. +flippable :: l a -> ModifiedLayout Flip l a +flippable = ModifiedLayout def + +-- Message to send a flipVertically message +flipVertically :: DoFlip +flipVertically = DoFlip $ \f -> f { vert = not (vert f) } + +-- Message to send a flipHorizontally message. +flipHorizontally :: DoFlip +flipHorizontally = DoFlip $ \f -> f { horiz = not (horiz f) } + +instance LayoutModifier Flip a where + + -- Modifies the layout. For each rectangle returned from the underlying + -- layout, flip it relative to the screen. + pureModifier flip (Rectangle sx sy sw sh) stack returned = + (map (second doFlip) returned, Nothing) + where + -- doFlip -- the composition of maybe flipping horizontally and + -- vertically. + doFlip = + (if horiz flip then flipHoriz else id) . + (if vert flip then flipVert else id) + + flipVert (Rectangle x y w h) = + Rectangle ((sx + fromIntegral sw) - x - fromIntegral w + sx) y w h + flipHoriz (Rectangle x y w h) = + Rectangle x ((sy + fromIntegral sh) - y - fromIntegral h + sy) w h + + -- Handle DoFlip messages. + pureMess flip (fromMessage -> Just (DoFlip f)) = Just (f flip) + pureMess _ _ = Nothing + + -- Modify the description to show if the layout has been flipped. + modifyDescription flip (description -> descr) = + (++) descr $ + if horiz flip || vert flip + then intercalate " and " ( + map snd $ + filter fst [ + (horiz flip, "Horizontally"), + (vert flip, "Vertically")]) + ++ " Flipped" + else "" diff --git a/src/Rahm/Desktop/Layout/Layout.hs b/src/Rahm/Desktop/Layout/Layout.hs index 135b9a0..a871aa6 100644 --- a/src/Rahm/Desktop/Layout/Layout.hs +++ b/src/Rahm/Desktop/Layout/Layout.hs @@ -28,6 +28,7 @@ import Rahm.Desktop.Layout.LayoutList import Rahm.Desktop.Windows import Rahm.Desktop.Layout.ReinterpretMessage import Rahm.Desktop.Layout.Pop +import Rahm.Desktop.Layout.Flip import qualified Data.Map as M import qualified XMonad.StackSet as W @@ -90,8 +91,7 @@ reinterpretIncMaster = ModifiedLayout ReinterpretMessage mods = reinterpretResize . poppable . - ModifiedLayout (Flippable False) . - ModifiedLayout (HFlippable False) . + flippable . ModifiedLayout (Rotateable False) @@ -139,25 +139,11 @@ instance DescriptionModifier ThreeColDescMod ThreeCol where newDescription _ (ThreeCol mast _ _) _ = "ThreeCol(" ++ show mast ++ ")" newDescription _ (ThreeColMid mast _ _) _ = "ThreeColMid(" ++ show mast ++ ")" -newtype Flippable a = Flippable Bool -- True if flipped - deriving (Show, Read) - -newtype HFlippable a = HFlippable Bool -- True if flipped - deriving (Show, Read) - newtype Rotateable a = Rotateable Bool -- True if rotated deriving (Show, Read) -data FlipLayout = FlipLayout deriving (Typeable) - -data HFlipLayout = HFlipLayout deriving (Typeable) - data DoRotate = DoRotate deriving (Typeable) -instance Message FlipLayout where - -instance Message HFlipLayout where - instance Message DoRotate where instance (Eq a) => LayoutModifier Rotateable a where @@ -186,43 +172,3 @@ instance (Eq a) => LayoutModifier Rotateable a where if rot then descr ++ " Rotated" else descr - -instance (Eq a) => LayoutModifier Flippable a where - pureModifier (Flippable flip) (Rectangle sx _ sw _) stack returned = - if flip - then (map (second doFlip) returned, Nothing) - else (returned, Nothing) - where - doFlip (Rectangle x y w h) = - Rectangle ((sx + fromIntegral sw) - x - fromIntegral w + sx) y w h - - pureMess (Flippable flip) message = - case fromMessage message of - Just FlipLayout -> Just (Flippable (not flip)) - Nothing -> Nothing - - modifyDescription (Flippable flipped) underlying = - let descr = description underlying in - if flipped - then descr ++ " Flipped" - else descr - -instance (Eq a) => LayoutModifier HFlippable a where - pureModifier (HFlippable flip) (Rectangle _ sy _ sh) stack returned = - if flip - then (map (second doFlip) returned, Nothing) - else (returned, Nothing) - where - doFlip (Rectangle x y w h) = - Rectangle x ((sy + fromIntegral sh) - y - fromIntegral h + sy) w h - - pureMess (HFlippable flip) message = - case fromMessage message of - Just HFlipLayout -> Just (HFlippable (not flip)) - Nothing -> Nothing - - modifyDescription (HFlippable flipped) underlying = - let descr = description underlying in - if flipped - then descr ++ " HFlipped" - else descr -- cgit