diff options
| -rw-r--r-- | Config.hs | 24 | ||||
| -rw-r--r-- | Main.hs | 2 | ||||
| -rw-r--r-- | Operations.hs | 81 | ||||
| -rw-r--r-- | XMonad.hs | 42 |
4 files changed, 111 insertions, 38 deletions
@@ -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) @@ -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 () @@ -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 |