diff options
| -rw-r--r-- | MetaTile/Core.hs | 3 | ||||
| -rw-r--r-- | MetaTile/Layout/Floating.hs | 10 | ||||
| -rw-r--r-- | MetaTile/Main.hsc | 6 | ||||
| -rw-r--r-- | MetaTile/Operations.hs | 26 |
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}) -- --------------------------------------------------------------------- |