summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorhughes <hughes@rpi.edu>2007-04-01 03:47:06 +0200
committerhughes <hughes@rpi.edu>2007-04-01 03:47:06 +0200
commitf649b54049a3a184a89070772cd45d0c5c015b1c (patch)
treef4c38c17a83bf624c4cd1122e88d78f55951caeb
parentdd72a298b8f79546105ffbbd6005bbfa887e1e6a (diff)
downloadmetatile-f649b54049a3a184a89070772cd45d0c5c015b1c.tar
metatile-f649b54049a3a184a89070772cd45d0c5c015b1c.zip
Vertical/horizontal split, and resizability.
darcs-hash:20070401014706-3a569-26a764b57274f67057adf0b81eb71158b58f49de
-rw-r--r--Config.hs24
-rw-r--r--Main.hs2
-rw-r--r--Operations.hs81
-rw-r--r--XMonad.hs42
4 files changed, 111 insertions, 38 deletions
diff --git a/Config.hs b/Config.hs
index b6904c1..e368665 100644
--- a/Config.hs
+++ b/Config.hs
@@ -49,10 +49,14 @@ workspaces = 9
modMask :: KeyMask
modMask = mod1Mask
--- How much to change the size of the windows on the left by default.
+-- How much to change the horizontal/vertical split bar by defalut.
defaultDelta :: Rational
defaultDelta = 3%100
+-- How much to change the size of a tiled window, by default.
+sizeDelta :: Rational
+sizeDelta = 3%100
+
-- The mask for the numlock key. You may need to change this on some systems.
numlockMask :: KeySym
numlockMask = lockMask
@@ -61,21 +65,23 @@ numlockMask = lockMask
-- left pane should be in the tiled layout. See LayoutDesc and
-- friends in XMonad.hs for options.
startingLayoutDesc :: LayoutDesc
-startingLayoutDesc =
- LayoutDesc { layoutType = Full
- , tileFraction = 1%2 }
+startingLayoutDesc = LayoutDesc { layoutType = Full
+ , tileFraction = 1%2
+ }
-- The keys list.
keys :: M.Map (KeyMask, KeySym) (X ())
keys = M.fromList $
[ ((modMask .|. shiftMask, xK_Return), spawn "xterm")
, ((modMask, xK_p ), spawn "exe=`dmenu_path | dmenu` && exec $exe")
--- , ((modMask .|. shiftMask, xK_F11 ), spawn "gmrun")
+ , ((modMask .|. shiftMask, xK_F11 ), spawn "gmrun")
, ((modMask, xK_Tab ), raise GT)
- , ((modMask, xK_j ), raise GT)
- , ((modMask, xK_k ), raise LT)
- , ((modMask, xK_h ), changeWidth (negate defaultDelta))
- , ((modMask, xK_l ), changeWidth defaultDelta)
+ , ((modMask, xK_j ), changeVert defaultDelta)
+ , ((modMask, xK_k ), changeVert (negate defaultDelta))
+ , ((modMask, xK_h ), changeHorz (negate defaultDelta))
+ , ((modMask, xK_l ), changeHorz defaultDelta)
+ , ((modMask, xK_F10 ), changeSize sizeDelta (1%100))
+ , ((modMask, xK_F9 ), changeSize (negate sizeDelta) (1%100))
, ((modMask .|. shiftMask, xK_c ), kill)
, ((modMask .|. shiftMask, xK_q ), io $ exitWith ExitSuccess)
, ((modMask .|. shiftMask, xK_F12 ), io restart)
diff --git a/Main.hs b/Main.hs
index 71d7eb2..d571f96 100644
--- a/Main.hs
+++ b/Main.hs
@@ -50,8 +50,8 @@ main = do
, wmprotocols = wmprot
, dimensions = (displayWidth dpy dflt, displayHeight dpy dflt)
, workspace = W.empty workspaces
- , defaultLayoutDesc = startingLayoutDesc
, layoutDescs = M.empty
+ , dispositions = M.empty
}
xSetErrorHandler -- in C, I'm too lazy to write the binding
diff --git a/Operations.hs b/Operations.hs
index 5a31c5a..f828a49 100644
--- a/Operations.hs
+++ b/Operations.hs
@@ -14,6 +14,7 @@ import Graphics.X11.Xlib
import Graphics.X11.Xlib.Extras
import XMonad
+import Data.Ratio
import qualified StackSet as W
@@ -30,20 +31,56 @@ refresh = do
xinesc <- gets xineScreens
d <- gets display
fls <- gets layoutDescs
- dfltfl <- gets defaultLayoutDesc
- let move w a b c e = io $ moveResizeWindow d w a b c e
+ let move w (Rectangle p q r s) = io $ moveResizeWindow d w p q r s
+ flipRect (Rectangle p q r s) = Rectangle q p s r
flip mapM_ (M.assocs ws2sc) $ \(n, scn) -> do
let sc = xinesc !! scn
- sx = rect_x sc
- sy = rect_y sc
- sw = rect_width sc
- sh = rect_height sc
- fl = M.findWithDefault dfltfl n fls
+ fl = M.findWithDefault basicLayoutDesc n fls
l = layoutType fl
- ratio = tileFraction fl
+ fullWindow w = move w sc >> io (raiseWindow d w)
+
+ -- runRects draws the windows, figuring out their rectangles.
+ -- The code here is for a horizontal split, and tr is possibly
+ -- used to convert to the vertical case.
+ runRects :: Rectangle -> (Rectangle -> Rectangle) -> (Rational -> Disposition -> Disposition)
+ -> (Disposition -> Rational) -> Rational -> [Window] -> X ()
+ runRects _ _ _ _ _ [] = return () -- impossible
+ runRects (Rectangle sx sy sw sh) tr dfix fracFn tf (w:s) = do
+ -- get the dispositions in the relevant direction (vert/horz)
+ -- as specified by fracFn.
+ ds <- mapM (liftM fracFn . gets . disposition) s
+
+ -- do some math.
+ let lw = round (fromIntegral sw * tf) -- lhs width
+ rw = sw - fromIntegral lw -- rhs width
+ ns = map (/ sum ds) ds -- normalized ratios for rhs.
+
+ -- Normalize dispositions while we have the opportunity.
+ -- This is BAD. Rational numbers will SPACE LEAK each
+ -- time we make an adjustment. Floating point numbers are
+ -- better here. (Change it when somebody complains.)
+ zipWithM_ (\ratio a -> disposeW a (dfix ratio)) ns s
+
+ -- do some more math.
+ let ps = map (round . (* fromIntegral sh)) . scanl (+) 0 $ ns
+ -- ps are the vertical positions, [p1 = 0, p2, ..., pn, sh]
+ xs = map fromIntegral . zipWith (-) (tail ps) $ ps
+ -- xs are the heights of windows, [p2-p1,p3-p2,...,sh-pn]
+ rects = zipWith (\p q -> Rectangle (sx + lw) p rw q) ps xs
+ -- rects are the rectangles of our windows.
+
+ -- Move our lhs window, the big main one.
+ move w (tr (Rectangle sx sy (fromIntegral lw) sh))
+
+ -- Move our rhs windows.
+ zipWithM_ (\r a -> move a (tr r)) rects s
+
+ -- And raise this one, for good measure.
+ whenJust (W.peek ws) (io . raiseWindow d)
case l of
- Full -> whenJust (W.peekStack n ws) $ \w ->
- do move w sx sy sw sh; io $ raiseWindow d w
+ Full -> whenJust (W.peekStack n ws) $ \w -> do
+ move w sx sy sw sh
+ io $ raiseWindow d w
Tile -> case W.index n ws of
[] -> return ()
[w] -> do move w sx sy sw sh; io $ raiseWindow d w
@@ -52,29 +89,29 @@ refresh = do
rw = sw - fromIntegral lw
rh = fromIntegral sh `div` fromIntegral (length s)
move w sx sy (fromIntegral lw) sh
- zipWithM_ (\i a -> move a (sx + lw) (sy + i * rh) rw (fromIntegral rh))
- [0..] s
+ zipWithM_ (\i a -> move a (sx + lw) (sy + i * rh) rw (fromIntegral rh)) [0..] s
whenJust (W.peek ws) (io . raiseWindow d) -- this is always Just
whenJust (W.peek ws) setFocus
-- | switchLayout. Switch to another layout scheme. Switches the current workspace.
switchLayout :: X ()
-switchLayout = layout $ \fl -> fl { layoutType = swap (layoutType fl) }
+switchLayout = layout $ \fl -> fl { layoutType = case layoutType fl of
+ Full -> Tile
+ Tile -> Full }
-- | changeWidth. Change the width of the main window in tiling mode.
changeWidth :: Rational -> X ()
-changeWidth delta = layout $ \fl ->
- fl { tileFraction = min 1 (max 0 (tileFraction fl + delta)) }
+changeWidth delta = do
+ layout $ \fl -> fl { tileFraction = min 1 $ max 0 $ tileFraction fl + delta }
-- | layout. Modify the current workspace's layout with a pure function and refresh.
layout :: (LayoutDesc -> LayoutDesc) -> X ()
-layout f = do
- modify $ \s ->
- let fls = layoutDescs s
- n = W.current . workspace $ s
- fl = M.findWithDefault (defaultLayoutDesc s) n fls
- in s { layoutDescs = M.insert n (f fl) fls }
- refresh
+layout f = do modify $ \s -> let fls = layoutDescs s
+ n = W.current . workspace $ s
+ fl = M.findWithDefault (defaultLayoutDesc s) n fls
+ in s { layoutDescs = M.insert n (f fl) fls }
+ refresh
+
-- | windows. Modify the current window list with a pure function, and refresh
windows :: (WorkSpace -> WorkSpace) -> X ()
diff --git a/XMonad.hs b/XMonad.hs
index 7ffab6c..c70ead1 100644
--- a/XMonad.hs
+++ b/XMonad.hs
@@ -15,12 +15,15 @@
--
module XMonad (
- X, WorkSpace, XState(..), Layout(..), LayoutDesc(..),
+ X, WorkSpace, XState(..), Layout(..), LayoutDesc(..), Disposition(..),
+ basicLayoutDesc, currentDesc, disposition,
runX, io, withDisplay, isRoot,
spawn, trace, whenJust, swap
) where
import StackSet (StackSet)
+import qualified StackSet as W
+import Data.Ratio
import Control.Monad.State
import System.IO
@@ -43,15 +46,27 @@ data XState = XState
, wmprotocols :: {-# UNPACK #-} !Atom
, dimensions :: {-# UNPACK #-} !(Int,Int)
, workspace :: {-# UNPACK #-} !WorkSpace -- ^ workspace list
- , defaultLayoutDesc :: {-# UNPACK #-} !LayoutDesc
, layoutDescs :: {-# UNPACK #-} !(M.Map Int LayoutDesc)
+ , dispositions :: {-# UNPACK #-} !(M.Map Window Disposition)
-- ^ mapping of workspaces to descriptions of their layouts
}
type WorkSpace = StackSet Window
+
+-- ---------------------------------------------------------------------
+-- Dispositions and Layout
+
+-- | Disposition. Short for 'Display Position,' it describes how much
+-- of the screen a window would like to occupy, when tiled with others.
+data Disposition
+ = Disposition { vertFrac, horzFrac :: {-# UNPACK #-} !Rational }
+
+basicDisposition :: Disposition
+basicDisposition = Disposition (1%3) (1%3)
+
-- | The different layout modes
-data Layout = Full | Tile
+data Layout = Full | Horz | Vert
-- | 'not' for Layout.
swap :: Layout -> Layout
@@ -59,10 +74,23 @@ swap Full = Tile
swap _ = Full
-- | A full description of a particular workspace's layout parameters.
-data LayoutDesc = LayoutDesc { layoutType :: !Layout
- , tileFraction :: !Rational
- }
+data LayoutDesc = LayoutDesc { layoutType :: !Layout,
+ horzTileFrac :: !Rational,
+ vertTileFrac :: !Rational }
+basicLayoutDesc :: LayoutDesc
+basicLayoutDesc = LayoutDesc { layoutType = Full,
+ horzTileFrac = 1%2,
+ vertTileFrac = 1%2 }
+
+-- | disposition. Gets the disposition of a particular window.
+disposition :: Window -> XState -> Disposition
+disposition w s = M.findWithDefault basicDisposition w (dispositions s)
+
+-- | Gets the current layoutDesc.
+currentDesc :: XState -> LayoutDesc
+currentDesc s = M.findWithDefault basicLayoutDesc n (layoutDescs s)
+ where n = (W.current . workspace $ s)
@@ -87,6 +115,8 @@ withDisplay f = gets display >>= f
isRoot :: Window -> X Bool
isRoot w = liftM (w==) (gets theRoot)
+
+
-- ---------------------------------------------------------------------
-- Utilities