Rename Zoom to Pop and move into its own Module.

Much cleaner.

3 files changed, 93 insertions, 65 deletions

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