-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Actions.ConstrainedResize
-- Description :  Constrain the aspect ratio of a floating window.
-- Copyright   :  (c) Dougal Stanton
-- License     :  BSD3-style (see LICENSE)
--
-- Maintainer  :  <dougal@dougalstanton.net>
-- Stability   :  stable
-- Portability :  unportable
--
-- Lets you constrain the aspect ratio of a floating
-- window (by, say, holding shift while you resize).
--
-- Useful for making a nice circular XClock window.
--
-----------------------------------------------------------------------------

module XMonad.Actions.ConstrainedResize (
        -- * Usage
        -- $usage
        XMonad.Actions.ConstrainedResize.mouseResizeWindow
) where

import XMonad

-- $usage
--
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
--
-- > import qualified XMonad.Actions.ConstrainedResize as Sqr
--
-- Then add something like the following to your mouse bindings:
--
-- >     , ((modm, button3),               (\w -> focus w >> Sqr.mouseResizeWindow w False))
-- >     , ((modm .|. shiftMask, button3), (\w -> focus w >> Sqr.mouseResizeWindow w True ))
--
-- The line without the shiftMask replaces the standard mouse resize
-- function call, so it's not completely necessary but seems neater
-- this way.
--
-- For detailed instructions on editing your mouse bindings, see
-- "XMonad.Doc.Extending#Editing_mouse_bindings".

-- | Resize (floating) window with optional aspect ratio constraints.
mouseResizeWindow :: Window -> Bool -> X ()
mouseResizeWindow :: Window -> Bool -> X ()
mouseResizeWindow Window
w Bool
c = X Bool -> X () -> X ()
whenX (Window -> X Bool
isClient Window
w) (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$ (Display -> X ()) -> X ()
forall a. (Display -> X a) -> X a
withDisplay ((Display -> X ()) -> X ()) -> (Display -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \Display
d -> do
    WindowAttributes
wa <- IO WindowAttributes -> X WindowAttributes
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO WindowAttributes -> X WindowAttributes)
-> IO WindowAttributes -> X WindowAttributes
forall a b. (a -> b) -> a -> b
$ Display -> Window -> IO WindowAttributes
getWindowAttributes Display
d Window
w
    SizeHints
sh <- IO SizeHints -> X SizeHints
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO SizeHints -> X SizeHints) -> IO SizeHints -> X SizeHints
forall a b. (a -> b) -> a -> b
$ Display -> Window -> IO SizeHints
getWMNormalHints Display
d Window
w
    IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ Display
-> Window
-> Window
-> Position
-> Position
-> Dimension
-> Dimension
-> Position
-> Position
-> IO ()
warpPointer Display
d Window
none Window
w Position
0 Position
0 Dimension
0 Dimension
0 (CInt -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral (WindowAttributes -> CInt
wa_width WindowAttributes
wa)) (CInt -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral (WindowAttributes -> CInt
wa_height WindowAttributes
wa))
    (Position -> Position -> X ()) -> X () -> X ()
mouseDrag (\Position
ex Position
ey -> do
                 let x :: Position
x = Position
ex Position -> Position -> Position
forall a. Num a => a -> a -> a
- CInt -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral (WindowAttributes -> CInt
wa_x WindowAttributes
wa)
                     y :: Position
y = Position
ey Position -> Position -> Position
forall a. Num a => a -> a -> a
- CInt -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral (WindowAttributes -> CInt
wa_y WindowAttributes
wa)
                     sz :: (Position, Position)
sz = if Bool
c then (Position -> Position -> Position
forall a. Ord a => a -> a -> a
max Position
x Position
y, Position -> Position -> Position
forall a. Ord a => a -> a -> a
max Position
x Position
y) else (Position
x,Position
y)
                 IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ Display -> Window -> Dimension -> Dimension -> IO ()
resizeWindow Display
d Window
w (Dimension -> Dimension -> IO ())
-> (Dimension, Dimension) -> IO ()
forall a b c. (a -> b -> c) -> (a, b) -> c
`uncurry`
                    SizeHints -> (Position, Position) -> (Dimension, Dimension)
forall a.
Integral a =>
SizeHints -> (a, a) -> (Dimension, Dimension)
applySizeHintsContents SizeHints
sh (Position, Position)
sz
                 Window -> X ()
float Window
w)
              (Window -> X ()
float Window
w)