summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--MetaTile/Core.hs3
-rw-r--r--MetaTile/Layout/Floating.hs10
-rw-r--r--MetaTile/Main.hsc6
-rw-r--r--MetaTile/Operations.hs26
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})
-- ---------------------------------------------------------------------