Add ability to flip the layout with mod-f.

2 files changed, 58 insertions, 28 deletions

diff --git a/src/Internal/Keys.hs b/src/Internal/Keys.hs
index 0b7b1c3..ab6eab6 100644
--- a/src/Internal/Keys.hs
+++ b/src/Internal/Keys.hs
@@ -73,29 +73,30 @@ newKeys :: MarkContext -> IO (KeyMap l)
 newKeys markContext =
     return $ \config@(XConfig {modMask = modm}) ->
       Map.fromList
-        [ ((modm,               xK_F12), (void $ spawn "spotify-control next"))
-        , ((modm,               xK_F11), (void $ spawn "spotify-control prev"))
-        , ((modm,               xK_semicolon), scratchpadSpawnActionTerminal "scratchpad")
-        , ((modm,               xK_F10), (void $ spawn "spotify-control play"))
-        , ((modm,               xK_r),   runDMenu)
-        , ((modm,               xK_c),   runPassMenu)
-        , ((modm,               xK_h),   windows W.focusDown)
-        , ((modm,               xK_l),   windows W.focusUp)
-        , ((modm .|. shiftMask, xK_h),   windows W.swapUp)
-        , ((modm .|. shiftMask, xK_l),   windows W.swapDown)
-        , ((modm              , xK_Return),   windows W.swapMaster)
-        , ((modm,               xK_j),   sendMessage Shrink)
-        , ((modm,               xK_k),   sendMessage Expand)
-        , ((modm .|. shiftMask, xK_r),   (void $ spawn "gmrun"))
-        , ((modm .|. mod1Mask,  xK_l), (void $ spawn "xsecurelock"))
-        , ((modm .|. mod1Mask,  xK_s), (void $ spawn "sudo systemctl suspend && xsecurelock"))
-        , ((modm .|. shiftMask, xK_c), kill)
-        , ((modm .|. shiftMask, xK_t), withFocused $ windows . W.sink)
+        [ ((modm,               xK_F12),        (void $ spawn "spotify-control next"))
+        , ((modm,               xK_F11),        (void $ spawn "spotify-control prev"))
+        , ((modm,               xK_semicolon),  scratchpadSpawnActionTerminal "scratchpad")
+        , ((modm,               xK_F10),        (void $ spawn "spotify-control play"))
+        , ((modm,               xK_r),          runDMenu)
+        , ((modm,               xK_c),          runPassMenu)
+        , ((modm,               xK_h),          windows W.focusDown)
+        , ((modm,               xK_l),          windows W.focusUp)
+        , ((modm .|. shiftMask, xK_h),          windows W.swapUp)
+        , ((modm .|. shiftMask, xK_l),          windows W.swapDown)
+        , ((modm              , xK_f),          sendMessage FlipLayout)
+        , ((modm              , xK_Return),     windows W.swapMaster)
+        , ((modm,               xK_j),          sendMessage Shrink)
+        , ((modm,               xK_k),          sendMessage Expand)
+        , ((modm .|. shiftMask, xK_r),          (void $ spawn "gmrun"))
+        , ((modm .|. mod1Mask,  xK_l),          (void $ spawn "xsecurelock"))
+        , ((modm .|. mod1Mask,  xK_s),          (void $ spawn "sudo systemctl suspend && xsecurelock"))
+        , ((modm .|. shiftMask, xK_c),          kill)
+        , ((modm .|. shiftMask, xK_t),          withFocused $ windows . W.sink)
         , ((mod4Mask,           xK_BackSpace),  (void $ spawn "xterm"))
         , ((modm,               xK_BackSpace),  (void $ spawn "pkill -SIGUSR1 xmobar"))
-        , ((modm,               xK_t),  (void $ spawn (terminal config)))
-        , ((modm,               xK_m), (submap $ mapAlpha modm (markCurrentWindow markContext)))
-        , ((modm,               xK_w), runXPlus markContext config windowJump)
+        , ((modm,               xK_t),          (void $ spawn (terminal config)))
+        , ((modm,               xK_m),          (submap $ mapAlpha modm (markCurrentWindow markContext)))
+        , ((modm,               xK_w),          runXPlus markContext config windowJump)
         , ((modm,               xK_apostrophe), (submap $
               Map.insert
                 (modm, xK_apostrophe)
diff --git a/src/Internal/Layout.hs b/src/Internal/Layout.hs
index 2339cca..aa3df1a 100644
--- a/src/Internal/Layout.hs
+++ b/src/Internal/Layout.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
 module Internal.Layout where 
 
+import Control.Arrow (second)
 import XMonad.Hooks.ManageDocks
 import XMonad.Layout.Circle
 import XMonad.Layout.Accordion
@@ -20,26 +21,54 @@ import qualified XMonad.StackSet as W
 
 myLayout =
   ModifiedLayout (Zoomable False 0.05 0.05) $
-    spacingRaw True (Border 5 5 5 5) True (Border 5 5 5 5) True $ avoidStruts $
-      spiral (6/7) |||
-      Tall 1 (3/100) (1/2) |||
-      ThreeCol 1 (3/100) (1/2) |||
-      Full |||
-      Grid |||
-      Dishes 2 (1/6)
+    ModifiedLayout (Flippable False) $
+      spacingRaw True (Border 5 5 5 5) True (Border 5 5 5 5) True $ avoidStruts $
+        spiral (6/7) |||
+        Tall 1 (3/100) (1/2) |||
+        ThreeCol 1 (3/100) (1/2) |||
+        Full |||
+        Grid |||
+        Dishes 2 (1/6)
 
 data ResizeZoom = ShrinkZoom | ExpandZoom deriving (Typeable)
 
 instance Message ResizeZoom where
 
+data Flippable a = Flippable Bool -- True if flipped
+  deriving (Show, Read)
+
+data FlipLayout = FlipLayout deriving (Typeable)
+
 data Zoomable a = Zoomable Bool Float Float -- True if zooming in on the focused window.
   deriving (Show, Read)
 
 data ToggleZoom = ToggleZoom
   deriving (Typeable)
 
+instance Message FlipLayout where
+
 instance Message ToggleZoom where
 
+instance (Eq a) => LayoutModifier Flippable a where
+  pureModifier (Flippable flip) (Rectangle _ _ sw _) stack returned =
+    if flip 
+      then (map (second doFlip) returned, Nothing)
+      else (returned, Nothing)
+    where
+      doFlip (Rectangle x y w h) = Rectangle (fromIntegral sw - x - fromIntegral w) 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 Zoomable a where
   redoLayout (Zoomable doit ws hs) (Rectangle x y w h) stack returned =
     if doit