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 +++++++++++++++++++++++++++++++++++++++++ 1 file changed, 87 insertions(+) create mode 100644 src/Rahm/Desktop/Layout/Flip.hs (limited to 'src/Rahm/Desktop/Layout/Flip.hs') 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 "" -- cgit