From eb5addb90f58ed0aa7e6f504fa2c960dd8228b1e Mon Sep 17 00:00:00 2001 From: Matthias Schiffer Date: Wed, 11 Sep 2013 19:14:25 +0200 Subject: Rename XMonad to MetaTile --- MetaTile/Operations.hs | 588 +++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 588 insertions(+) create mode 100644 MetaTile/Operations.hs (limited to 'MetaTile/Operations.hs') diff --git a/MetaTile/Operations.hs b/MetaTile/Operations.hs new file mode 100644 index 0000000..1a2fd11 --- /dev/null +++ b/MetaTile/Operations.hs @@ -0,0 +1,588 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-} + +-- -------------------------------------------------------------------------- +-- | +-- Module : MetaTile.Operations +-- Copyright : (c) Spencer Janssen 2007 +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : dons@cse.unsw.edu.au +-- Stability : unstable +-- Portability : not portable, Typeable deriving, mtl, posix +-- +-- Operations. +-- +----------------------------------------------------------------------------- + +module MetaTile.Operations where + +import MetaTile.Core +import MetaTile.Layout (Full(..)) +import qualified MetaTile.StackSet as W + +import Data.Maybe +import Data.Monoid (Endo(..)) +import Data.List (nub, (\\), find) +import Data.Bits ((.|.), (.&.), complement, testBit) +import Data.Ratio +import qualified Data.Map as M + +import Control.Applicative +import Control.Arrow ((&&&)) +import Control.Monad.Reader +import Control.Monad.State +import qualified Control.Exception.Extensible as C + +import System.Posix.Process (executeFile) +import Graphics.X11.Xlib +import Graphics.X11.Xinerama (getScreenInfo) +import Graphics.X11.Xlib.Extras + +-- --------------------------------------------------------------------- +-- | +-- Window manager operations +-- manage. Add a new window to be managed in the current workspace. +-- Bring it into focus. +-- +-- Whether the window is already managed, or not, it is mapped, has its +-- border set, and its event mask set. +-- +manage :: Window -> X () +manage w = whenX (not <$> isClient w) $ do + mh <- asks (manageHook . config) + g <- appEndo <$> userCodeDef (Endo id) (runQuery mh w) + windows (g . W.insertUp w) + +-- | unmanage. A window no longer exists, remove it from the window +-- list, on whatever workspace it is. +-- +unmanage :: Window -> X () +unmanage = windows . W.delete + +-- | Kill the specified window. If we do kill it, we'll get a +-- delete notify back from X. +-- +-- There are two ways to delete a window. Either just kill it, or if it +-- supports the delete protocol, send a delete event (e.g. firefox) +-- +killWindow :: Window -> X () +killWindow w = withDisplay $ \d -> do + wmdelt <- atom_WM_DELETE_WINDOW ; wmprot <- atom_WM_PROTOCOLS + + protocols <- io $ getWMProtocols d w + io $ if wmdelt `elem` protocols + then allocaXEvent $ \ev -> do + setEventType ev clientMessage + setClientMessageEvent ev w wmprot 32 wmdelt 0 + sendEvent d w False noEventMask ev + else killClient d w >> return () + +-- | Kill the currently focused client. +kill :: X () +kill = withFocused killWindow + +-- --------------------------------------------------------------------- +-- Managing windows + +-- | windows. Modify the current window list with a pure function, and refresh +windows :: (WindowSet -> WindowSet) -> X () +windows f = do + XState { windowset = old } <- get + let oldvisible = concatMap (W.integrate' . W.stack . W.screenWorkspace) $ W.screens old + newwindows = W.allWindows ws \\ W.allWindows old + ws = f old + XConf { display = d , normalBorder = nbc, focusedBorder = fbc } <- ask + + mapM_ setInitialProperties newwindows + + whenJust (W.peek old) $ \otherw -> setFrameBackground d otherw nbc + modify (\s -> s { windowset = ws }) + + -- notify non visibility + let tags_oldvisible = map (W.tag . W.screenWorkspace) $ W.screens old + gottenhidden = filter (flip elem tags_oldvisible . W.tag) $ W.hidden ws + mapM_ (sendMessageWithNoRefresh Hide) gottenhidden + + -- for each workspace, layout the currently visible workspaces + let allscreens = W.screens ws + summed_visible = scanl (++) [] $ map (W.integrate' . W.stack . W.screenWorkspace) allscreens + rects <- fmap concat $ forM (zip allscreens summed_visible) $ \ (w, vis) -> do + let wsp = W.screenWorkspace w + this = W.view n ws + n = W.tag wsp + tiled = (W.stack . W.screenWorkspace . W.current $ this) + >>= W.filter (`notElem` vis) + viewrect = screenRect $ W.screenDetail w + + -- just the tiled windows: + -- now tile the windows on this workspace, modified by the gap + (rs, ml') <- runLayout wsp { W.stack = tiled } viewrect `catchX` + runLayout wsp { W.stack = tiled, W.layout = Layout Full } viewrect + updateLayout n ml' + + io $ restackWindows d (map fst rs) + -- return the visible windows for this workspace: + return rs + + let visible = map fst rects + + mapM_ (uncurry tileWindow) rects + + whenJust (W.peek ws) $ \w -> setFrameBackground d w fbc + + mapM_ reveal visible + setTopFocus + + -- hide every window that was potentially visible before, but is not + -- given a position by a layout now. + mapM_ hide (nub (oldvisible ++ newwindows) \\ visible) + + -- all windows that are no longer in the windowset are marked as + -- withdrawn, it is important to do this after the above, otherwise 'hide' + -- will overwrite withdrawnState with iconicState + mapM_ (flip setWMState withdrawnState) (W.allWindows old \\ W.allWindows ws) + + isMouseFocused <- asks mouseFocused + unless isMouseFocused $ clearEvents enterWindowMask + asks (logHook . config) >>= userCodeDef () + where + setFrameBackground :: Display -> Window -> Pixel -> X () + setFrameBackground d w p = do + frame <- getsWindowState wsFrame w + io $ do + setWindowBackground d frame p + clearWindow d frame + +-- | Produce the actual rectangle from a screen and a ratio on that screen. +scaleRationalRect :: Rectangle -> W.RationalRect -> Rectangle +scaleRationalRect (Rectangle sx sy sw sh) (W.RationalRect rx ry rw rh) + = Rectangle (sx + scale sw rx) (sy + scale sh ry) (scale sw rw) (scale sh rh) + where scale s r = floor (toRational s * r) + +-- | setWMState. set the WM_STATE property +setWMState :: Window -> Int -> X () +setWMState w v = withDisplay $ \dpy -> do + a <- atom_WM_STATE + io $ changeProperty32 dpy w a a propModeReplace [fromIntegral v, fromIntegral none] + +-- | hide. Hide a window by unmapping it, and setting Iconified. +hide :: Window -> X () +hide w = whenX (getsWindowState wsMapped w) $ withDisplay $ \d -> do + (cMask,fMask) <- asks $ (clientMask &&& frameMask) . config + frame <- getsWindowState wsFrame w + io $ do selectInput d w (cMask .&. complement structureNotifyMask) + selectInput d frame (fMask .&. complement structureNotifyMask) + unmapWindow d frame + selectInput d frame fMask + selectInput d w cMask + setWMState w iconicState + -- this part is key: we increment the waitingUnmap counter to distinguish + -- between client and xmonad initiated unmaps. + modifyWindowState (\ws -> ws { wsMapped = False + , wsWaitingUnmap = (wsWaitingUnmap ws) + 1 }) w + +configureClientWindow :: Window -> X () +configureClientWindow w = withDisplay $ \d -> do + (frame, bw) <- getsWindowState (wsFrame &&& wsBorderWidth) w + (_, x, y, width, height, _, _) <- io $ getGeometry d frame + let least1 n = max 1 n + x' = x + (fi $ bwLeft bw) + y' = y + (fi $ bwTop bw) + width' = least1 (width - bwLeft bw - bwRight bw) + height' = least1 (height - bwTop bw - bwBottom bw) + io $ do + moveResizeWindow d w (fi $ bwLeft bw) (fi $ bwTop bw) width' height' + -- send absolute ConfigureNotify + allocaXEvent $ \event -> do + setEventType event configureNotify + setConfigureEvent event w w (fi x') (fi y') (fi width') (fi height') 0 none False + sendEvent d w False 0 event + where + fi :: (Integral a, Num b) => a -> b + fi = fromIntegral + +-- | reveal. Show a window by mapping it and setting Normal +-- this is harmless if the window was already visible +reveal :: Window -> X () +reveal w = withDisplay $ \d -> do + setWMState w normalState + io $ mapWindow d w + whenX (isClient w) $ do + configureClientWindow w + getsWindowState wsFrame w >>= io . mapWindow d + modifyWindowState (\ws -> ws { wsMapped = True }) w + +-- | Set some properties when we initially gain control of a window +setInitialProperties :: Window -> X () +setInitialProperties w = withDisplay $ \d -> do + setWMState w iconicState + asks (clientMask . config) >>= io . selectInput d w + io $ setWindowBorderWidth d w 0 + +-- | refresh. Render the currently visible workspaces, as determined by +-- the 'StackSet'. Also, set focus to the focused window. +-- +-- This is our 'view' operation (MVC), in that it pretty prints our model +-- with X calls. +-- +refresh :: X () +refresh = windows id + +-- | clearEvents. Remove all events of a given type from the event queue. +clearEvents :: EventMask -> X () +clearEvents mask = withDisplay $ \d -> io $ do + sync d False + allocaXEvent $ \p -> fix $ \again -> do + more <- checkMaskEvent d mask p + when more again -- beautiful + +-- | tileWindow. Moves and resizes w such that it fits inside the given +-- rectangle, including its border. +tileWindow :: Window -> Rectangle -> X () +tileWindow w r = withDisplay $ \d -> do + -- give all windows at least 1x1 pixels + let least x | x <= 0 = 1 + | otherwise = x + frame <- getsWindowState wsFrame w + io $ moveResizeWindow d frame (rect_x r) (rect_y r) (least $ rect_width r) (least $ rect_height r) + +-- --------------------------------------------------------------------- + +-- | Returns 'True' if the first rectangle is contained within, but not equal +-- to the second. +containedIn :: Rectangle -> Rectangle -> Bool +containedIn r1@(Rectangle x1 y1 w1 h1) r2@(Rectangle x2 y2 w2 h2) + = and [ r1 /= r2 + , x1 >= x2 + , y1 >= y2 + , fromIntegral x1 + w1 <= fromIntegral x2 + w2 + , fromIntegral y1 + h1 <= fromIntegral y2 + h2 ] + +-- | Given a list of screens, remove all duplicated screens and screens that +-- are entirely contained within another. +nubScreens :: [Rectangle] -> [Rectangle] +nubScreens xs = nub . filter (\x -> not $ any (x `containedIn`) xs) $ xs + +-- | Cleans the list of screens according to the rules documented for +-- nubScreens. +getCleanedScreenInfo :: MonadIO m => Display -> m [Rectangle] +getCleanedScreenInfo = io . fmap nubScreens . getScreenInfo + +-- | rescreen. The screen configuration may have changed (due to +-- xrandr), update the state and refresh the screen, and reset the gap. +rescreen :: X () +rescreen = do + xinesc <- withDisplay getCleanedScreenInfo + + windows $ \ws -> + let (xs, ys) = splitAt (length xinesc) $ W.workspaces ws + (a:as) = zipWith3 (flip W.Screen []) xs [0..] $ map SD xinesc + in ws { W.current = a { W.screenHidden = ys } + , W.visible = as } + +-- --------------------------------------------------------------------- + +-- | setButtonGrab. Tell whether or not to intercept clicks on a given window +setButtonGrab :: Bool -> Window -> X () +setButtonGrab grab w = do + pointerMode <- asks $ \c -> if clickJustFocuses (config c) + then grabModeAsync + else grabModeSync + withDisplay $ \d -> io $ if grab + then forM_ [button1, button2, button3] $ \b -> + grabButton d b anyModifier w False buttonPressMask + pointerMode grabModeSync none none + else ungrabButton d anyButton anyModifier w + +-- --------------------------------------------------------------------- +-- Setting keyboard focus + +-- | Set the focus to the window on top of the stack, or root +setTopFocus :: X () +setTopFocus = withWindowSet $ maybe (setFocusX =<< asks theRoot) setFocusX . W.peek + +-- | Set focus explicitly to window 'w' if it is managed by us, or root. +-- This happens if X notices we've moved the mouse (and perhaps moved +-- the mouse to a new screen). +focus :: Window -> X () +focus w = local (\c -> c { mouseFocused = True }) $ withWindowSet $ \s -> do + let stag = W.tag . W.screenWorkspace + curr = stag $ W.current s + mnew <- maybe (return Nothing) (fmap (fmap stag) . uncurry pointScreen) + =<< asks mousePosition + root <- asks theRoot + case () of + _ | W.member w s && W.peek s /= Just w -> windows (W.focusWindow w) + | Just new <- mnew, w == root && curr /= new + -> windows (W.view new) + | otherwise -> return () + +-- | Call X to set the keyboard focus details. +setFocusX :: Window -> X () +setFocusX w = withWindowSet $ \ws -> do + dpy <- asks display + + -- clear mouse button grab and border on other windows + forM_ (W.screens ws) $ \wk -> + forM_ (W.index (W.view (W.tag (W.screenWorkspace wk)) ws)) $ \otherw -> + setButtonGrab True otherw + + -- If we ungrab buttons on the root window, we lose our mouse bindings. + whenX (not <$> isRoot w) $ setButtonGrab False w + + hints <- io $ getWMHints dpy w + protocols <- io $ getWMProtocols dpy w + wmprot <- atom_WM_PROTOCOLS + wmtf <- atom_WM_TAKE_FOCUS + currevt <- asks currentEvent + let inputHintSet = wmh_flags hints `testBit` inputHintBit + + when ((inputHintSet && wmh_input hints) || (not inputHintSet)) $ + io $ do setInputFocus dpy w revertToPointerRoot 0 + when (wmtf `elem` protocols) $ + io $ allocaXEvent $ \ev -> do + setEventType ev clientMessage + setClientMessageEvent ev w wmprot 32 wmtf $ maybe currentTime event_time currevt + sendEvent dpy w False noEventMask ev + where event_time ev = + if (ev_event_type ev) `elem` timedEvents then + ev_time ev + else + currentTime + timedEvents = [ keyPress, keyRelease, buttonPress, buttonRelease, enterNotify, leaveNotify, selectionRequest ] + +------------------------------------------------------------------------ +-- Message handling + +-- | Throw a message to the current 'LayoutClass' possibly modifying how we +-- layout the windows, then refresh. +sendMessage :: Message a => a -> X () +sendMessage a = do + w <- W.screenWorkspace . W.current <$> gets windowset + ml' <- handleMessage (W.layout w) (SomeMessage a) `catchX` return Nothing + whenJust ml' $ \l' -> + windows $ \ws -> ws { W.current = (W.current ws) + { W.screenWorkspace = (W.screenWorkspace $ W.current ws) + { W.layout = l' }}} + +-- | Send a message to all layouts, without refreshing. +broadcastMessage :: Message a => a -> X () +broadcastMessage a = withWindowSet $ \ws -> + mapM_ (sendMessageWithNoRefresh a) (W.workspaces ws) + +-- | Send a message to a layout, without refreshing. +sendMessageWithNoRefresh :: Message a => a -> W.Workspace WorkspaceId (Layout Window) Window -> X () +sendMessageWithNoRefresh a w = + handleMessage (W.layout w) (SomeMessage a) `catchX` return Nothing >>= + updateLayout (W.tag w) + +-- | Update the layout field of a workspace +updateLayout :: WorkspaceId -> Maybe (Layout Window) -> X () +updateLayout i ml = whenJust ml $ \l -> + runOnWorkspaces $ \ww -> return $ if W.tag ww == i then ww { W.layout = l} else ww + +-- | Set the layout of the currently viewed workspace +setLayout :: Layout Window -> X () +setLayout l = do + ss@(W.StackSet { W.current = c@(W.Screen { W.screenWorkspace = ws })}) <- gets windowset + handleMessage (W.layout ws) (SomeMessage ReleaseResources) + windows $ const $ ss {W.current = c { W.screenWorkspace = ws { W.layout = l } } } + +------------------------------------------------------------------------ +-- Utilities + +-- | Return workspace visible on screen 'sc', or 'Nothing'. +screenWorkspace :: ScreenId -> X (Maybe WorkspaceId) +screenWorkspace sc = withWindowSet $ return . W.lookupWorkspace sc + +-- | Apply an 'X' operation to the currently focused window, if there is one. +withFocused :: (Window -> X ()) -> X () +withFocused f = withWindowSet $ \w -> whenJust (W.peek w) f + +-- | 'True' if window is under management by us +isClient :: Window -> X Bool +isClient w = withWindowSet $ return . W.member w + +-- | Combinations of extra modifier masks we need to grab keys\/buttons for. +-- (numlock and capslock) +extraModifiers :: X [KeyMask] +extraModifiers = do + nlm <- gets numberlockMask + return [0, nlm, lockMask, nlm .|. lockMask ] + +-- | Strip numlock\/capslock from a mask +cleanMask :: KeyMask -> X KeyMask +cleanMask km = do + nlm <- gets numberlockMask + return (complement (nlm .|. lockMask) .&. km) + +-- | Get the 'Pixel' value for a named color +initColor :: Display -> String -> IO (Maybe Pixel) +initColor dpy c = C.handle (\(C.SomeException _) -> return Nothing) $ + (Just . color_pixel . fst) <$> allocNamedColor dpy colormap c + where colormap = defaultColormap dpy (defaultScreen dpy) + +------------------------------------------------------------------------ + +-- | @restart name resume@. Attempt to restart xmonad by executing the program +-- @name@. If @resume@ is 'True', restart with the current window state. +-- When executing another window manager, @resume@ should be 'False'. +restart :: String -> Bool -> X () +restart prog resume = do + broadcastMessage ReleaseResources + io . flush =<< asks display + let wsData = show . W.mapLayout show . windowset + maybeShow (t, Right (PersistentExtension ext)) = Just (t, show ext) + maybeShow (t, Left str) = Just (t, str) + maybeShow _ = Nothing + extState = return . show . catMaybes . map maybeShow . M.toList . extensibleState + args <- if resume then gets (\s -> "--resume":wsData s:extState s) else return [] + catchIO (executeFile prog True args Nothing) + +------------------------------------------------------------------------ +-- | Floating layer support + +-- | Given a window, find the screen it is located on, and compute +-- the geometry of that window wrt. that screen. +floatLocation :: Window -> X (ScreenId, W.RationalRect) +floatLocation w = withDisplay $ \d -> do + ws <- gets windowset + wa <- io $ getWindowAttributes d w + let bw = (fromIntegral . wa_border_width) wa + sc <- fromMaybe (W.current ws) <$> pointScreen (fi $ wa_x wa) (fi $ wa_y wa) + + let sr = screenRect . W.screenDetail $ sc + rr = W.RationalRect ((fi (wa_x wa) - fi (rect_x sr)) % fi (rect_width sr)) + ((fi (wa_y wa) - fi (rect_y sr)) % fi (rect_height sr)) + (fi (wa_width wa + bw*2) % fi (rect_width sr)) + (fi (wa_height wa + bw*2) % fi (rect_height sr)) + + return (W.screen sc, rr) + where fi x = fromIntegral x + +-- | Given a point, determine the screen (if any) that contains it. +pointScreen :: Position -> Position + -> X (Maybe (W.Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)) +pointScreen x y = withWindowSet $ return . find p . W.screens + where p = pointWithin x y . screenRect . W.screenDetail + +-- | @pointWithin x y r@ returns 'True' if the @(x, y)@ co-ordinate is within +-- @r@. +pointWithin :: Position -> Position -> Rectangle -> Bool +pointWithin x y r = x >= rect_x r && + x < rect_x r + fromIntegral (rect_width r) && + y >= rect_y r && + y < rect_y r + fromIntegral (rect_height r) + +-- | Make a tiled window floating, using its suggested rectangle +{-float :: Window -> X () +float w = do + (sc, rr) <- floatLocation w + windows $ \ws -> W.float w rr . fromMaybe ws $ do + i <- W.findTag w ws + guard $ i `elem` concatMap (map W.tag . W.screenWorkspaces) (W.screens ws) + f <- W.peek ws + sw <- W.lookupWorkspace sc ws + return (W.focusWindow f . W.shiftWin sw w $ ws)-} + +-- --------------------------------------------------------------------- +-- Mouse handling + +-- | Accumulate mouse motion events +mouseDrag :: (Position -> Position -> X ()) -> X () -> X () +mouseDrag f done = do + drag <- gets dragging + case drag of + Just _ -> return () -- error case? we're already dragging + Nothing -> do + XConf { theRoot = root, display = d } <- ask + io $ grabPointer d root False (buttonReleaseMask .|. pointerMotionMask) + grabModeAsync grabModeAsync none none currentTime + modify $ \s -> s { dragging = Just (motion, cleanup) } + where + cleanup = do + withDisplay $ io . flip ungrabPointer currentTime + modify $ \s -> s { dragging = Nothing } + done + motion x y = do z <- f x y + clearEvents pointerMotionMask + return z + +-- | XXX comment me +{-mouseMoveWindow :: Window -> X () +mouseMoveWindow w = whenX (isClient w) $ withDisplay $ \d -> do + io $ raiseWindow d w + wa <- io $ getWindowAttributes d w + (_, _, _, ox', oy', _, _, _) <- io $ queryPointer d w + let ox = fromIntegral ox' + oy = fromIntegral oy' + mouseDrag (\ex ey -> io $ moveWindow d w (fromIntegral (fromIntegral (wa_x wa) + (ex - ox))) + (fromIntegral (fromIntegral (wa_y wa) + (ey - oy)))) + (float w) + +-- | XXX comment me +mouseResizeWindow :: Window -> X () +mouseResizeWindow w = whenX (isClient w) $ withDisplay $ \d -> do + io $ raiseWindow d w + wa <- io $ getWindowAttributes d w + sh <- io $ getWMNormalHints d w + io $ warpPointer d none w 0 0 0 0 (fromIntegral (wa_width wa)) (fromIntegral (wa_height wa)) + mouseDrag (\ex ey -> + io $ resizeWindow d w `uncurry` + applySizeHintsContents sh (ex - fromIntegral (wa_x wa), + ey - fromIntegral (wa_y wa))) + (float w)-} + +-- --------------------------------------------------------------------- +-- | Support for window size hints + +type D = (Dimension, Dimension) + +-- | Given a window, build an adjuster function that will reduce the given +-- dimensions according to the window's border width and size hints. +mkAdjust :: Window -> X (D -> D) +mkAdjust w = withDisplay $ \d -> liftIO $ do + sh <- getWMNormalHints d w + bw <- fmap (fromIntegral . wa_border_width) $ getWindowAttributes d w + return $ applySizeHints bw sh + +-- | Reduce the dimensions if needed to comply to the given SizeHints, taking +-- window borders into account. +applySizeHints :: Integral a => Dimension -> SizeHints -> (a, a) -> D +applySizeHints bw sh = + tmap (+ 2 * bw) . applySizeHintsContents sh . tmap (subtract $ 2 * fromIntegral bw) + where + tmap f (x, y) = (f x, f y) + +-- | Reduce the dimensions if needed to comply to the given SizeHints. +applySizeHintsContents :: Integral a => SizeHints -> (a, a) -> D +applySizeHintsContents sh (w, h) = + applySizeHints' sh (fromIntegral $ max 1 w, fromIntegral $ max 1 h) + +-- | XXX comment me +applySizeHints' :: SizeHints -> D -> D +applySizeHints' sh = + maybe id applyMaxSizeHint (sh_max_size sh) + . maybe id (\(bw, bh) (w, h) -> (w+bw, h+bh)) (sh_base_size sh) + . maybe id applyResizeIncHint (sh_resize_inc sh) + . maybe id applyAspectHint (sh_aspect sh) + . maybe id (\(bw,bh) (w,h) -> (w-bw, h-bh)) (sh_base_size sh) + +-- | Reduce the dimensions so their aspect ratio falls between the two given aspect ratios. +applyAspectHint :: (D, D) -> D -> D +applyAspectHint ((minx, miny), (maxx, maxy)) x@(w,h) + | or [minx < 1, miny < 1, maxx < 1, maxy < 1] = x + | w * maxy > h * maxx = (h * maxx `div` maxy, h) + | w * miny < h * minx = (w, w * miny `div` minx) + | otherwise = x + +-- | Reduce the dimensions so they are a multiple of the size increments. +applyResizeIncHint :: D -> D -> D +applyResizeIncHint (iw,ih) x@(w,h) = + if iw > 0 && ih > 0 then (w - w `mod` iw, h - h `mod` ih) else x + +-- | Reduce the dimensions if they exceed the given maximum dimensions. +applyMaxSizeHint :: D -> D -> D +applyMaxSizeHint (mw,mh) x@(w,h) = + if mw > 0 && mh > 0 then (min w mw,min h mh) else x -- cgit v1.2.3