From 08eacc1d437b08863ebe521446e040bc4fa219a2 Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Fri, 23 Aug 2024 15:27:57 -0600
Subject: Add popup terminal when the "explode" happends

---
 src/Rahm/Desktop/Layout/Explode.hs | 38 ++++++++++++++++++++++++++++++--------
 1 file changed, 30 insertions(+), 8 deletions(-)

(limited to 'src/Rahm/Desktop/Layout/Explode.hs')

diff --git a/src/Rahm/Desktop/Layout/Explode.hs b/src/Rahm/Desktop/Layout/Explode.hs
index 1d25695..9e1b4d8 100644
--- a/src/Rahm/Desktop/Layout/Explode.hs
+++ b/src/Rahm/Desktop/Layout/Explode.hs
@@ -1,12 +1,14 @@
-{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveAnyClass, TypeOperators #-}
 
 module Rahm.Desktop.Layout.Explode where
 
 import Control.Arrow (Arrow (second))
-import Data.Foldable (minimumBy)
+import Data.Foldable (minimumBy, Foldable (toList))
 import Data.Ord (comparing)
 import qualified Rahm.Desktop.StackSet as W
+import qualified XMonad.StackSet as W
 import XMonad
+import Rahm.Desktop.PopupTerminal
 
 data Explodeable (l :: * -> *) (a :: *) = Explodeable
   { isExploded :: Bool,
@@ -15,19 +17,30 @@ data Explodeable (l :: * -> *) (a :: *) = Explodeable
   deriving (Show, Read, Eq, Ord)
 
 data ExplodeMessage where
-  ExplodeMessage :: (forall l a. Explodeable l a -> Explodeable l a) -> ExplodeMessage
+  ExplodeMessage :: (forall l a. Explodeable l a -> X (Explodeable l a)) -> ExplodeMessage
   deriving (Message)
 
 explodeable :: l a -> Explodeable l a
 explodeable = Explodeable False
 
+toggleExplodeM :: X () -> X () -> ExplodeMessage
+toggleExplodeM onTrue onFalse =
+  ExplodeMessage $ \(Explodeable b l) -> do
+    if b then onFalse else onTrue
+    return $ Explodeable (not b) l
+
 toggleExplode :: ExplodeMessage
-toggleExplode = ExplodeMessage $ \(Explodeable b l) -> Explodeable (not b) l
+toggleExplode = ExplodeMessage $ \(Explodeable b l) -> return $ Explodeable (not b) l
 
-instance (LayoutClass l a, Eq a) => LayoutClass (Explodeable l) a where
+instance (LayoutClass l a, a ~ Window) => LayoutClass (Explodeable l) a where
   runLayout
-    (W.Workspace t (Explodeable True l) stack)
+    (W.Workspace t (Explodeable True l) stack')
     rect@(Rectangle x y w h) = do
+      maybeWin <- getPopupTerminalWindow
+      let winRect = (,popRect) <$> maybeWin
+
+      let stack = W.filter ((/=maybeWin) . Just) =<< stack'
+
       (returned, maybeNewLayout) <- runLayout (W.Workspace t l stack) rect
 
       let (cx, cy) = (x + (fi w `div` 2), y + (fi h `div` 2))
@@ -45,8 +58,17 @@ instance (LayoutClass l a, Eq a) => LayoutClass (Explodeable l) a where
               )
               returned
 
-      return (newReturned, Explodeable True <$> maybeNewLayout)
+      return (toList winRect ++ newReturned, Explodeable True <$> maybeNewLayout)
       where
+        wp = floor $ fromIntegral w * 0.10
+        hp = floor $ fromIntegral h * 0.10
+        popRect =
+          Rectangle
+            (x + wp)
+            (y + hp)
+            (w - fromIntegral (wp * 2))
+            (h - fromIntegral (hp * 2))
+
         fi :: (Integral a, Num b) => a -> b
         fi = fromIntegral
         norm :: (Integral a, Integral b) => (a, b) -> (Float, Float)
@@ -84,7 +106,7 @@ instance (LayoutClass l a, Eq a) => LayoutClass (Explodeable l) a where
 
   -- If the message is a ExplodeMessage, handle that here.
   handleMessage p (fromMessage -> Just (ExplodeMessage f)) =
-    return $ Just $ f p
+    Just <$> f p
   -- By default just pass the message to the underlying layout.
   handleMessage (Explodeable b l) mess = do
     maybeNewLayout <- handleMessage l mess
-- 
cgit