aboutsummaryrefslogtreecommitdiff
path: root/src/Rahm/Desktop
diff options
context:
space:
mode:
Diffstat (limited to 'src/Rahm/Desktop')
-rw-r--r--src/Rahm/Desktop/Keys.hs6
-rw-r--r--src/Rahm/Desktop/Layout/Flip.hs87
-rw-r--r--src/Rahm/Desktop/Layout/Layout.hs58
3 files changed, 93 insertions, 58 deletions
diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs
index 7ca6161..b8a4c4e 100644
--- a/src/Rahm/Desktop/Keys.hs
+++ b/src/Rahm/Desktop/Keys.hs
@@ -55,6 +55,7 @@ import Rahm.Desktop.Logger
import Rahm.Desktop.RebindKeys
import Rahm.Desktop.Swallow
import Rahm.Desktop.Layout.Pop (PopMessage(..))
+import Rahm.Desktop.Layout.Flip (flipHorizontally, flipVertically)
import Rahm.Desktop.ScreenRotate (screenRotateForward, screenRotateBackward)
type KeyMap l = XConfig l -> Map (KeyMask, KeySym) (X ())
@@ -245,10 +246,10 @@ keymap = runKeys $ do
bind xK_f $ do
justMod $
doc "Flip the current layout vertically" $
- sendMessage FlipLayout
+ sendMessage flipVertically
shiftMod $
doc "Flip the current layout horizontally" $
- sendMessage HFlipLayout
+ sendMessage flipHorizontally
bind xK_g $ do
justMod $
@@ -625,6 +626,7 @@ mouseMap = runButtons $ do
bind button13 $ do
noMod $ noWindow $ click >> CopyWindow.kill1
+
bind button14 $ do
noMod $ noWindow $ click >> sendMessage TogglePop
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
generated by cgit (git 2.34.1) at 2026-02-22 15:53:56 +0000