aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorJan Vornberger <jan.vornberger@informatik.uni-oldenburg.de>2009-09-30 14:11:05 +0200
committerJan Vornberger <jan.vornberger@informatik.uni-oldenburg.de>2009-09-30 14:11:05 +0200
commitb6df0054423d652b71f78113a87e31dbef56a26e (patch)
tree7c0676cef403feb0c7030b06785444c9a29d2cad
parent010cd5bed00564e875a10685048d4db16ced7223 (diff)
downloadXMonadContrib-b6df0054423d652b71f78113a87e31dbef56a26e.tar.gz
XMonadContrib-b6df0054423d652b71f78113a87e31dbef56a26e.tar.xz
XMonadContrib-b6df0054423d652b71f78113a87e31dbef56a26e.zip
A ResizableTile-like layout that can be resized using the mouse.
Ignore-this: 8941ecfb0e5653663db29e9f195e23f2 All separations between windows can be dragged to modify the layout. Keyboard commands can also be used to achieve the same effect. darcs-hash:20090930121105-594c5-b950c74d30248aa223aeea25bb29b331c11fa594.gz
-rw-r--r--XMonad/Layout/MouseResizableTile.hs279
-rw-r--r--xmonad-contrib.cabal1
2 files changed, 280 insertions, 0 deletions
diff --git a/XMonad/Layout/MouseResizableTile.hs b/XMonad/Layout/MouseResizableTile.hs
new file mode 100644
index 0000000..20cd830
--- /dev/null
+++ b/XMonad/Layout/MouseResizableTile.hs
@@ -0,0 +1,279 @@
+{-# OPTIONS_GHC -fglasgow-exts #-} -- For deriving Data/Typeable
+----------------------------------------------------------------------------
+-- |
+-- Module : XMonad.Layout.MouseResizableTile
+-- Copyright : (c) Jan Vornberger 2009
+-- License : BSD3-style (see LICENSE)
+--
+-- Maintainer : jan.vornberger@informatik.uni-oldenburg.de
+-- Stability : unstable
+-- Portability : not portable
+--
+-- A layout in the spirit of XMonad.Layout.ResizableTile, but with the option
+-- to use the mouse to adjust the layout.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Layout.MouseResizableTile (
+ -- * Usage
+ -- $usage
+ mouseResizableTile,
+ mouseResizableTileMirrored,
+ MRTMessage (ShrinkSlave, ExpandSlave)
+ ) where
+
+import XMonad hiding (tile, splitVertically, splitHorizontallyBy)
+import qualified XMonad.StackSet as W
+import XMonad.Util.XUtils
+
+-- $usage
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Layout.MouseResizableTile
+--
+-- Then edit your @layoutHook@ by adding the MouseResizableTile layout.
+-- Either in its normal form or the mirrored version. (The mirror layout modifier
+-- will not work correctly here because of the use of the mouse.)
+--
+-- > myLayouts = mouseResizableTile ||| etc..
+-- > main = xmonad defaultConfig { layoutHook = myLayouts }
+-- or
+-- > myLayouts = mouseResizableTileMirrored ||| etc..
+-- > main = xmonad defaultConfig { layoutHook = myLayouts }
+--
+-- For more detailed instructions on editing the layoutHook see:
+--
+-- "XMonad.Doc.Extending#Editing_the_layout_hook"
+--
+-- You may also want to add the following key bindings:
+--
+-- > , ((modMask x, xK_u), sendMessage ShrinkSlave) -- %! Shrink a slave area
+-- > , ((modMask x, xK_i), sendMessage ExpandSlave) -- %! Expand a slave area
+--
+-- For detailed instruction on editing the key binding see:
+--
+-- "XMonad.Doc.Extending#Editing_key_bindings".
+
+data MRTMessage = SetMasterFraction Rational
+ | SetLeftSlaveFraction Int Rational
+ | SetRightSlaveFraction Int Rational
+ | ShrinkSlave
+ | ExpandSlave
+ deriving Typeable
+instance Message MRTMessage
+
+data DraggerInfo = MasterDragger Position Rational
+ | LeftSlaveDragger Position Rational Int
+ | RightSlaveDragger Position Rational Int
+ deriving (Show, Read)
+type DraggerWithRect = (Rectangle, Glyph, DraggerInfo)
+type DraggerWithWin = (Window, DraggerInfo)
+
+data MouseResizableTile a = MRT { nmaster :: Int,
+ masterFrac :: Rational,
+ leftFracs :: [Rational],
+ rightFracs :: [Rational],
+ draggers :: [DraggerWithWin],
+ focusPos :: Int,
+ numWindows :: Int,
+ isMirrored :: Bool
+ } deriving (Show, Read)
+
+mrtFraction :: Rational
+mrtFraction = 0.5
+mrtDelta :: Rational
+mrtDelta = 0.03
+mrtDraggerOffset :: Position
+mrtDraggerOffset = 3
+mrtDraggerSize :: Dimension
+mrtDraggerSize = 6
+mrtHDoubleArrow :: Glyph
+mrtHDoubleArrow = 108
+mrtVDoubleArrow :: Glyph
+mrtVDoubleArrow = 116
+
+mouseResizableTile :: MouseResizableTile a
+mouseResizableTile = MRT 1 mrtFraction [] [] [] 0 0 False
+
+mouseResizableTileMirrored :: MouseResizableTile a
+mouseResizableTileMirrored= MRT 1 mrtFraction [] [] [] 0 0 True
+
+instance LayoutClass MouseResizableTile a where
+ doLayout state sr (W.Stack w l r) =
+ let wins = reverse l ++ w : r
+ num = length wins
+ sr' = mirrorAdjust sr (mirrorRect sr)
+ (rects, preparedDraggers) = tile (nmaster state) (masterFrac state)
+ ((leftFracs state) ++ repeat mrtFraction)
+ ((rightFracs state) ++ repeat mrtFraction) sr' num
+ rects' = map (mirrorAdjust id mirrorRect . sanitizeRectangle sr') rects
+ in do
+ mapM_ deleteDragger $ draggers state
+ newDraggers <- mapM (createDragger sr . adjustForMirror (isMirrored state)) preparedDraggers
+ return (zip wins rects', Just $ state { draggers = newDraggers,
+ focusPos = length l,
+ numWindows = length wins })
+ where
+ mirrorAdjust a b = if (isMirrored state)
+ then b
+ else a
+
+ handleMessage state m
+ | Just (IncMasterN d) <- fromMessage m =
+ return $ Just $ state { nmaster = max 0 (nmaster state + d) }
+ | Just (Shrink) <- fromMessage m =
+ return $ Just $ state { masterFrac = max 0 (masterFrac state - mrtDelta) }
+ | Just (Expand) <- fromMessage m =
+ return $ Just $ state { masterFrac = min 1 (masterFrac state + mrtDelta) }
+ | Just ShrinkSlave <- fromMessage m =
+ return $ Just $ modifySlave state (-mrtDelta)
+ | Just ExpandSlave <- fromMessage m =
+ return $ Just $ modifySlave state mrtDelta
+ | Just (SetMasterFraction f) <- fromMessage m =
+ return $ Just $ state { masterFrac = max 0 (min 1 f) }
+ | Just (SetLeftSlaveFraction pos f) <- fromMessage m =
+ return $ Just $ state { leftFracs = replaceAtPos (leftFracs state) pos (max 0 (min 1 f)) }
+ | Just (SetRightSlaveFraction pos f) <- fromMessage m =
+ return $ Just $ state { rightFracs = replaceAtPos (rightFracs state) pos (max 0 (min 1 f)) }
+
+ | Just e <- fromMessage m :: Maybe Event = handleResize (draggers state) (isMirrored state) e >> return Nothing
+ | Just Hide <- fromMessage m = releaseResources >> return (Just $ state { draggers = [] })
+ | Just ReleaseResources <- fromMessage m = releaseResources >> return (Just $ state { draggers = [] })
+ where releaseResources = mapM_ deleteDragger $ draggers state
+ handleMessage _ _ = return Nothing
+
+ description _ = "MouseResizableTile"
+
+adjustForMirror :: Bool -> DraggerWithRect -> DraggerWithRect
+adjustForMirror False dragger = dragger
+adjustForMirror True (draggerRect, draggerCursor, draggerInfo) =
+ (mirrorRect draggerRect, draggerCursor', draggerInfo)
+ where
+ draggerCursor' = if (draggerCursor == mrtHDoubleArrow)
+ then mrtVDoubleArrow
+ else mrtHDoubleArrow
+
+modifySlave :: MouseResizableTile a -> Rational-> MouseResizableTile a
+modifySlave state delta =
+ let pos = focusPos state
+ num = numWindows state
+ nmaster' = nmaster state
+ leftFracs' = leftFracs state
+ rightFracs' = rightFracs state
+ draggersLeft = nmaster' - 1
+ draggersRight = (num - nmaster') - 1
+ in if pos < nmaster'
+ then if draggersLeft > 0
+ then let draggerPos = min (draggersLeft - 1) pos
+ oldFraction = (leftFracs' ++ repeat mrtFraction) !! draggerPos
+ in state { leftFracs = replaceAtPos leftFracs' draggerPos
+ (max 0 (min 1 (oldFraction + delta))) }
+ else state
+ else if draggersRight > 0
+ then let draggerPos = min (draggersRight - 1) (pos - nmaster')
+ oldFraction = (rightFracs' ++ repeat mrtFraction) !! draggerPos
+ in state { rightFracs = replaceAtPos rightFracs' draggerPos
+ (max 0 (min 1 (oldFraction + delta))) }
+ else state
+
+replaceAtPos :: (Num t) => [Rational] -> t -> Rational -> [Rational]
+replaceAtPos [] 0 x' = [x']
+replaceAtPos [] pos x' = mrtFraction : replaceAtPos [] (pos - 1) x'
+replaceAtPos (_:xs) 0 x' = x' : xs
+replaceAtPos (x:xs) pos x' = x : replaceAtPos xs (pos -1 ) x'
+
+sanitizeRectangle :: Rectangle -> Rectangle -> Rectangle
+sanitizeRectangle (Rectangle sx sy swh sht) (Rectangle x y wh ht) =
+ (Rectangle (within 0 (sx + fromIntegral swh) x) (within 0 (sy + fromIntegral sht) y)
+ (within 1 swh wh) (within 1 sht ht))
+
+within :: (Ord a) => a -> a -> a -> a
+within low high a = max low $ min high a
+
+tile :: Int -> Rational -> [Rational] -> [Rational] -> Rectangle -> Int -> ([Rectangle], [DraggerWithRect])
+tile nmaster' masterFrac' leftFracs' rightFracs' sr num
+ | num <= nmaster' = splitVertically (take (num - 1) leftFracs') sr True 0
+ | nmaster' == 0 = splitVertically (take (num - 1) rightFracs') sr False 0
+ | otherwise = (leftRects ++ rightRects, [masterDragger] ++ leftDraggers ++ rightDraggers)
+ where ((sr1, sr2), masterDragger) = splitHorizontallyBy masterFrac' sr
+ (leftRects, leftDraggers) = splitVertically (take (nmaster' - 1) leftFracs') sr1 True 0
+ (rightRects, rightDraggers) = splitVertically (take (num - nmaster' - 1) rightFracs') sr2 False 0
+
+splitVertically :: RealFrac r => [r] -> Rectangle -> Bool -> Int -> ([Rectangle], [DraggerWithRect])
+splitVertically [] r _ _ = ([r], [])
+splitVertically (f:fx) (Rectangle sx sy sw sh) isLeft num =
+ let nextRect = Rectangle sx sy sw (smallh - (div mrtDraggerSize 2))
+ (otherRects, otherDragger) = splitVertically fx
+ (Rectangle sx (sy + fromIntegral smallh + mrtDraggerOffset)
+ sw (sh - smallh - (div mrtDraggerSize 2)))
+ isLeft (num + 1)
+ draggerRect = Rectangle sx (sy + fromIntegral smallh - mrtDraggerOffset) sw mrtDraggerSize
+ draggerInfo = if isLeft
+ then LeftSlaveDragger sy (fromIntegral sh) num
+ else RightSlaveDragger sy (fromIntegral sh) num
+ nextDragger = (draggerRect, mrtVDoubleArrow, draggerInfo)
+ in (nextRect : otherRects, nextDragger : otherDragger)
+ where smallh = floor $ fromIntegral sh * f
+
+splitHorizontallyBy :: RealFrac r => r -> Rectangle -> ((Rectangle, Rectangle), DraggerWithRect)
+splitHorizontallyBy f (Rectangle sx sy sw sh) = ((leftHalf, rightHalf), (draggerRect, mrtHDoubleArrow, draggerInfo))
+ where leftw = floor $ fromIntegral sw * f
+ leftHalf = Rectangle sx sy (leftw - (div mrtDraggerSize 2)) sh
+ rightHalf = Rectangle (sx + fromIntegral leftw + mrtDraggerOffset) sy
+ (sw - fromIntegral leftw - (div mrtDraggerSize 2)) sh
+ draggerRect = Rectangle (sx + fromIntegral leftw - mrtDraggerOffset) sy mrtDraggerSize sh
+ draggerInfo = MasterDragger sx (fromIntegral sw)
+
+createDragger :: Rectangle -> DraggerWithRect -> X DraggerWithWin
+createDragger sr (draggerRect, draggerCursor, draggerInfo) = do
+ draggerWin <- createInputWindow draggerCursor $ sanitizeRectangle sr draggerRect
+ return (draggerWin, draggerInfo)
+
+deleteDragger :: DraggerWithWin -> X ()
+deleteDragger (draggerWin, _) = deleteWindow draggerWin
+
+
+handleResize :: [DraggerWithWin] -> Bool -> Event -> X ()
+handleResize draggers' isM ButtonEvent { ev_window = ew, ev_event_type = et }
+ | et == buttonPress = do
+ case (lookup ew draggers') of
+ Just (MasterDragger lowerBound range) -> do
+ mouseDrag (\x y -> do
+ let axis = chooseAxis isM x y
+ fraction = fromIntegral (axis - lowerBound) / range
+ sendMessage (SetMasterFraction fraction)) (return ())
+ Just (LeftSlaveDragger lowerBound range num) -> do
+ mouseDrag (\x y -> do
+ let axis = chooseAxis isM y x
+ fraction = fromIntegral (axis - lowerBound) / range
+ sendMessage (SetLeftSlaveFraction num fraction)) (return ())
+ Just (RightSlaveDragger lowerBound range num) -> do
+ mouseDrag (\x y -> do
+ let axis = chooseAxis isM y x
+ fraction = fromIntegral (axis - lowerBound) / range
+ sendMessage (SetRightSlaveFraction num fraction)) (return ())
+ Nothing -> return ()
+ where
+ chooseAxis isM' axis1 axis2 = if isM' then axis2 else axis1
+handleResize _ _ _ = return ()
+
+createInputWindow :: Glyph -> Rectangle -> X Window
+createInputWindow cursorGlyph r = withDisplay $ \d -> do
+ win <- mkInputWindow d r
+ io $ selectInput d win (exposureMask .|. buttonPressMask)
+ cursor <- io $ createFontCursor d cursorGlyph
+ io $ defineCursor d win cursor
+ io $ freeCursor d cursor
+ showWindow win
+ return win
+
+mkInputWindow :: Display -> Rectangle -> X Window
+mkInputWindow d (Rectangle x y w h) = do
+ rw <- asks theRoot
+ let screen = defaultScreenOfDisplay d
+ visual = defaultVisualOfScreen screen
+ attrmask = cWOverrideRedirect
+ io $ allocaSetWindowAttributes $
+ \attributes -> do
+ set_override_redirect attributes True
+ createWindow d rw x y w h 0 0 inputOnly visual attrmask attributes
diff --git a/xmonad-contrib.cabal b/xmonad-contrib.cabal
index a45ff72..768231d 100644
--- a/xmonad-contrib.cabal
+++ b/xmonad-contrib.cabal
@@ -167,6 +167,7 @@ library
XMonad.Layout.Monitor
XMonad.Layout.Mosaic
XMonad.Layout.MosaicAlt
+ XMonad.Layout.MouseResizableTile
XMonad.Layout.MultiToggle
XMonad.Layout.MultiToggle.Instances
XMonad.Layout.Named