Vertical/horizontal split, and resizability.

darcs-hash:20070401014706-3a569-26a764b57274f67057adf0b81eb71158b58f49de

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