Keep track of the current desired frame bounds in the frame state

This saved a few round-trips to the X server and is preparation for the
window confinement feature.

4 files changed, 21 insertions, 24 deletions

diff --git a/MetaTile/Core.hs b/MetaTile/Core.hs
index 3d84ea3..5fa62e6 100644
--- a/MetaTile/Core.hs
+++ b/MetaTile/Core.hs
@@ -75,6 +75,7 @@ data WindowState = WindowState
 
 data FrameState = FrameState
     { fsWindow       :: !Window
+    , fsBounds       :: !Rectangle
     , fsBorderWidth  :: !BorderWidth
     } deriving Show
 
@@ -83,7 +84,7 @@ data FrameState = FrameState
 data XState = XState
     { windowset        :: !WindowSet                     -- ^ workspace list
     , windowState      :: !(M.Map Window WindowState)    -- ^ the extended window state
-    , frameState       :: !(M.Map Window FrameState)    -- ^ the extended frame state
+    , frameState       :: !(M.Map Window FrameState)     -- ^ the extended frame state
     , dragging         :: !(Maybe (Position -> Position -> X (), X ()))
     , numberlockMask   :: !KeyMask                       -- ^ The numlock modifier
     , extensibleState  :: !(M.Map String (Either String StateExtension))
diff --git a/MetaTile/Layout/Floating.hs b/MetaTile/Layout/Floating.hs
index ac306d3..d317063 100644
--- a/MetaTile/Layout/Floating.hs
+++ b/MetaTile/Layout/Floating.hs
@@ -88,18 +88,18 @@ mouseMoveWindow :: Window -> X ()
 mouseMoveWindow w = whenX (isClient w) $ withDisplay $ \d -> do
     frame <- getsWindowState wsFrame w
     io $ raiseWindow d frame
-    wa <- io $ getWindowAttributes d frame
+    Just (Rectangle x y width height) <- getsFrameState fsBounds frame
     (_, _, _, ox', oy', _, _, _) <- io $ queryPointer d frame
     let ox = fromIntegral ox'
         oy = fromIntegral oy'
-    mouseDrag (\ex ey -> (io $ moveWindow d frame (fromIntegral (fromIntegral (wa_x wa) + (ex - ox))) (fromIntegral (fromIntegral (wa_y wa) + (ey - oy)))) >> reveal w) (float w)
+    mouseDrag (\ex ey -> tileWindow w (Rectangle (fromIntegral (fromIntegral x + (ex - ox))) (fromIntegral (fromIntegral y + (ey - oy))) width height) >> configure w) (float w)
 
 -- | XXX comment me
 mouseResizeWindow :: Window -> X ()
 mouseResizeWindow w = whenX (isClient w) $ withDisplay $ \d -> do
     frame <- getsWindowState wsFrame w
     io $ raiseWindow d frame
-    wa <- io $ getWindowAttributes d frame
+    Just (Rectangle x y width height) <- getsFrameState fsBounds frame
     sh <- io $ getWMNormalHints d w
-    io $ warpPointer d none frame 0 0 0 0 (fromIntegral (wa_width wa)) (fromIntegral (wa_height wa))
-    mouseDrag (\ex ey -> (io $ resizeWindow d frame `uncurry` applySizeHintsContents sh (ex - fromIntegral (wa_x wa), ey - fromIntegral (wa_y wa))) >> reveal w) (float w)
+    io $ warpPointer d none frame 0 0 0 0 (fromIntegral width) (fromIntegral height)
+    mouseDrag (\ex ey -> tileWindow w (Rectangle x y `uncurry` applySizeHintsContents sh (ex - fromIntegral x, ey - fromIntegral y)) >> configure w) (float w)
diff --git a/MetaTile/Main.hsc b/MetaTile/Main.hsc
index 92692a3..f4bf691 100644
--- a/MetaTile/Main.hsc
+++ b/MetaTile/Main.hsc
@@ -253,8 +253,6 @@ handle e@(ButtonEvent {ev_window = w,ev_event_type = t,ev_button = b })
     isr <- isRoot w
     m <- cleanMask $ ev_state e
     mact <- asks (M.lookup (m, b) . buttonActions)
-    trace $ show (ev_subwindow e)
-    getsFrameState fsWindow (ev_subwindow e) >>= trace . show
     case mact of
         Just act | isr -> getsFrameState fsWindow (ev_subwindow e) >>= traverse act >> return ()
         _              -> do
@@ -288,7 +286,7 @@ handle e@(ConfigureRequestEvent {ev_window = w}) = withDisplay $ \dpy -> do
                     , wc_border_width = 0
                     , wc_sibling      = ev_above e
                     , wc_stack_mode   = ev_detail e }
-        else configureClientWindow w
+        else configure w
     io $ sync dpy False
 
 -- configuration changes in the root may mean display settings have changed
@@ -327,7 +325,7 @@ reparent w = withDisplay $ \dpy -> do
             addToSaveSet dpy w
             reparentWindow dpy w frame 0 0
         modifyWindowState (\ws -> ws { wsFrame = frame }) w
-        setFrameState frame $ FrameState { fsWindow = w, fsBorderWidth = BorderWidth 0 0 0 0 }
+        setFrameState frame $ FrameState { fsWindow = w, fsBounds = Rectangle (-1) (-1) 1 1, fsBorderWidth = BorderWidth 0 0 0 0 }
 
 hideParent :: Window -> X ()
 hideParent w = withDisplay $ \dpy -> do
diff --git a/MetaTile/Operations.hs b/MetaTile/Operations.hs
index 4edf67b..acd9898 100644
--- a/MetaTile/Operations.hs
+++ b/MetaTile/Operations.hs
@@ -126,7 +126,7 @@ windows f = do
 
     let visible = map fst3 rects
 
-    mapM_ (uncurry3 tileWindow) rects
+    mapM_ (uncurry3 tileWindow') rects
 
     whenJust (W.peek ws) $ \w -> setFrameBackground d w fbc
 
@@ -181,11 +181,10 @@ hide w = whenX (getsWindowState wsMapped w) $ withDisplay $ \d -> do
     modifyWindowState (\ws -> ws { wsMapped       = False
                                  , wsWaitingUnmap = (wsWaitingUnmap ws) + 1 }) w
 
-configureClientWindow :: Window -> X ()
-configureClientWindow w = withDisplay $ \d -> do
+configure :: Window -> X ()
+configure w = withDisplay $ \d -> do
     frame <- getsWindowState wsFrame w
-    Just bw <- getsFrameState fsBorderWidth frame
-    (_, x, y, width, height, _, _) <- io $ getGeometry d frame
+    Just (FrameState { fsBounds = Rectangle x y width height, fsBorderWidth = bw }) <- getFrameState frame
     let least1 n = max 1 n
         x' = x + (fi $ bwLeft bw)
         y' = y + (fi $ bwTop bw)
@@ -193,6 +192,8 @@ configureClientWindow w = withDisplay $ \d -> do
         height' = least1 (height - bwTop bw - bwBottom bw)
     io $ do
         moveResizeWindow d w (fi $ bwLeft bw) (fi $ bwTop bw) width' height'
+        moveResizeWindow d frame x y (least1 width) (least1 height)
+
         -- send absolute ConfigureNotify
         allocaXEvent $ \event -> do
             setEventType event configureNotify
@@ -209,7 +210,7 @@ reveal w = withDisplay $ \d -> do
     setWMState w normalState
     io $ mapWindow d w
     whenX (isClient w) $ do
-        configureClientWindow w
+        configure w
         getsWindowState wsFrame w >>= io . mapWindow d
         modifyWindowState (\ws -> ws { wsMapped = True }) w
 
@@ -239,14 +240,11 @@ clearEvents mask = withDisplay $ \d -> io $ do
 
 -- | tileWindow. Moves and resizes w such that it fits inside the given
 -- rectangle, including its border.
-tileWindow :: Window -> Rectangle -> BorderWidth -> X ()
-tileWindow w r bw = withDisplay $ \d -> do
-    -- give all windows at least 1x1 pixels
-    let least x | x <= 0  = 1
-                | otherwise  = x
-    frame <- getsWindowState wsFrame w
-    modifyFrameState (\fs -> fs {fsBorderWidth = bw}) frame
-    io $ moveResizeWindow d frame (rect_x r) (rect_y r) (least $ rect_width r) (least $ rect_height r)
+tileWindow :: Window -> Rectangle -> X ()
+tileWindow w r = getsWindowState wsFrame w >>= modifyFrameState (\fs -> fs {fsBounds = r})
+
+tileWindow' :: Window -> Rectangle -> BorderWidth -> X ()
+tileWindow' w r bw = getsWindowState wsFrame w >>= modifyFrameState (\fs -> fs {fsBounds = r, fsBorderWidth = bw})
 
 
 -- ---------------------------------------------------------------------