From a130477abe176d41c01a176b509b249fb4d40bb3 Mon Sep 17 00:00:00 2001
From: matsuyama3 <matsuyama3@ariel-networks.com>
Date: Mon, 1 Oct 2007 11:14:11 +0200
Subject: XMonadContrib.ResizableTile in darcs patch.

I have fixed error "" to return Nothing. Thanks Andrea.

darcs-hash:20071001091411-989c7-3a3718517203884ab0d0f338db089255d246e5ae.gz
---
 ResizableTile.hs | 87 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 87 insertions(+)
 create mode 100644 ResizableTile.hs

(limited to 'ResizableTile.hs')

diff --git a/ResizableTile.hs b/ResizableTile.hs
new file mode 100644
index 0000000..7f0fa60
--- /dev/null
+++ b/ResizableTile.hs
@@ -0,0 +1,87 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonadContrib.ResizableTile
+-- Copyright   :  (c) MATSUYAMA Tomohiro <t.matsuyama.pub@gmail.com>
+-- License     :  BSD-style (see LICENSE)
+--
+-- Maintainer  :  MATSUYAMA Tomohiro <t.matsuyama.pub@gmail.com>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- More useful tiled layout that allows you to change a width/height of window.
+--
+-----------------------------------------------------------------------------
+
+module XMonadContrib.ResizableTile (Tall(..), MirrorResize(..)) where
+
+import XMonad
+import Operations (Resize(..), IncMasterN(..))
+import qualified StackSet as W
+import Graphics.X11.Xlib
+import Control.Monad.State
+import Control.Monad
+
+-- $usage
+--
+-- To use, modify your Config.hs to:
+--
+-- >    import XMonadContrib.ResizableTile as T
+--
+-- and add a keybinding:
+--
+-- >    , ((modMask,               xK_a     ), sendMessage MirrorShrink)
+-- >    , ((modMask,               xK_z     ), sendMessage MirrorExpand)
+--
+-- and redefine "tiled" as:
+--
+-- >     tiled   = T.Tall nmaster delta ratio (repeat 1)
+
+data MirrorResize = MirrorShrink | MirrorExpand deriving Typeable
+instance Message MirrorResize
+
+data Tall a = Tall Int Rational Rational [Rational] deriving (Show, Read)
+instance Layout Tall a where
+    doLayout (Tall nmaster _ frac mfrac) r =
+        return . (\x->(x,Nothing)) .
+        ap zip (tile frac mfrac r nmaster . length) . W.integrate
+    handleMessage (Tall nmaster delta frac mfrac) m =
+        do ms <- (W.stack . W.workspace . W.current) `fmap` gets windowset
+           case ms of
+             Nothing -> return Nothing
+             Just s -> return $ msum [fmap resize (fromMessage m)
+                                     ,fmap (\x -> mresize x s) (fromMessage m)
+                                     ,fmap incmastern (fromMessage m)]
+        where resize Shrink = Tall nmaster delta (max 0 $ frac-delta) mfrac
+              resize Expand = Tall nmaster delta (min 1 $ frac+delta) mfrac
+              mresize MirrorShrink s = mresize' s delta
+              mresize MirrorExpand s = mresize' s (0-delta)
+              mresize' s d = let n = length $ W.up s
+                                 total = n + (length $ W.down s) + 1
+                             in Tall nmaster delta frac
+                                    (modifymfrac mfrac d (if n == (nmaster-1) || n == (total-1)
+                                                          then n-1
+                                                          else n))
+              modifymfrac [] _ _ = []
+              modifymfrac (f:fx) d n | n == 0    = f+d : fx
+                                     | otherwise = f : modifymfrac fx d (n-1)
+              incmastern (IncMasterN d) = Tall (max 0 (nmaster+d)) delta frac mfrac
+    description _ = "ResizableTall"
+
+tile :: Rational -> [Rational] -> Rectangle -> Int -> Int -> [Rectangle]
+tile f mf r nmaster n = if n <= nmaster || nmaster == 0
+    then splitVertically mf n r
+    else splitVertically mf nmaster r1 ++ splitVertically (drop nmaster mf) (n-nmaster) r2 -- two columns
+  where (r1,r2) = splitHorizontallyBy f r
+
+splitVertically :: RealFrac r => [r] -> Int -> Rectangle -> [Rectangle]
+splitVertically [] _ r = [r]
+splitVertically _ n r | n < 2 = [r]
+splitVertically (f:fx) n (Rectangle sx sy sw sh) = Rectangle sx sy sw smallh :
+    splitVertically fx (n-1) (Rectangle sx (sy+fromIntegral smallh) sw (sh-smallh))
+  where smallh = floor $ fromIntegral (sh `div` fromIntegral n) * f --hmm, this is a fold or map.
+
+splitHorizontallyBy :: RealFrac r => r -> Rectangle -> (Rectangle, Rectangle)
+splitHorizontallyBy f (Rectangle sx sy sw sh) =
+    ( Rectangle sx sy leftw sh
+    , Rectangle (sx + fromIntegral leftw) sy (sw-fromIntegral leftw) sh)
+  where leftw = floor $ fromIntegral sw * f
-- 
cgit v1.2.3