From 0fc3a5bab0ebedefadec6a4cc80b7d257e6b6424 Mon Sep 17 00:00:00 2001
From: Jason Creighton <jcreigh@gmail.com>
Date: Fri, 4 May 2007 03:46:53 +0200
Subject: added mirrorLayout to mirror arbitrary layouts

darcs-hash:20070504014653-b9aa7-1709cb0b718a7a058021c76fb95f9654c43f54b1.gz
---
 Operations.hs       | 19 +++++++++----------
 tests/Properties.hs | 10 ++--------
 2 files changed, 11 insertions(+), 18 deletions(-)

diff --git a/Operations.hs b/Operations.hs
index c1aa876..faf5e8b 100644
--- a/Operations.hs
+++ b/Operations.hs
@@ -82,13 +82,15 @@ tile r (Rectangle sx sy sw sh) (w:s)
     rh = fromIntegral sh `div` fromIntegral (length s)
     f i a = (a, Rectangle (sx + lw) i rw (fromIntegral rh))
 
--- | vtile. Tile vertically.
-vtile :: Rational -> Rectangle -> [Window] -> [(Window, Rectangle)]
-vtile r rect = map (second flipRect) . tile r (flipRect rect)
+-- | Mirror a rectangle
+mirrorRect :: Rectangle -> Rectangle
+mirrorRect (Rectangle rx ry rw rh) = (Rectangle ry rx rh rw)
 
--- | Flip rectangles around
-flipRect :: Rectangle -> Rectangle
-flipRect (Rectangle rx ry rw rh) = (Rectangle ry rx rh rw)
+-- | Mirror a layout
+mirrorLayout :: Layout -> Layout
+mirrorLayout (Layout { doLayout = dl, modifyLayout = ml })
+ = Layout { doLayout = (\sc ws -> map (second mirrorRect) $ dl (mirrorRect sc) ws)
+          , modifyLayout = fmap mirrorLayout . ml }
 
 -- | switchLayout.  Switch to another layout scheme.  Switches the
 -- current workspace. By convention, a window set as master in Tall mode
@@ -114,10 +116,7 @@ tall delta tileFrac = Layout { doLayout = \sc -> tile tileFrac sc
     where m Shrink = tall delta (tileFrac-delta)
           m Expand = tall delta (tileFrac+delta)
 
-wide delta tileFrac = Layout { doLayout = \sc -> vtile tileFrac sc
-                             , modifyLayout = (fmap m) . fromDynamic }
-    where m Shrink = wide delta (tileFrac-delta)
-          m Expand = wide delta (tileFrac+delta)
+wide delta tileFrac = mirrorLayout (tall delta tileFrac)
 
 -- | layout. Modify the current workspace's layout with a pure
 -- function and refresh.
diff --git a/tests/Properties.hs b/tests/Properties.hs
index c8b7e05..d630d0c 100644
--- a/tests/Properties.hs
+++ b/tests/Properties.hs
@@ -1,7 +1,7 @@
 {-# OPTIONS -fglasgow-exts #-}
 
 import StackSet
-import Operations (tile,vtile)
+import Operations (tile)
 
 import Debug.Trace
 import Data.Word
@@ -226,15 +226,10 @@ prop_push_local (x :: T) i = not (member i x) ==> hidden x == hidden (push i x)
 -- 1 window should always be tiled fullscreen
 prop_tile_fullscreen rect = tile pct rect [1] == [(1, rect)]
 
-prop_vtile_fullscreen rect = vtile pct rect [1] == [(1, rect)]
-
 -- multiple windows 
 prop_tile_non_overlap rect windows = noOverlaps (tile pct rect windows)
   where _ = rect :: Rectangle
 
-prop_vtile_non_overlap rect windows = noOverlaps (vtile pct rect windows)
-  where _ = rect :: Rectangle
-
 pct = 3 % 100
 
 noOverlaps []  = True
@@ -363,8 +358,7 @@ main = do
 ------------------------------------------------------------------------
 
         ,("tile 1 window fullsize", mytest prop_tile_fullscreen)
-        ,("vtile 1 window fullsize", mytest prop_vtile_fullscreen)
-        ,("vtiles never overlap",    mytest prop_vtile_non_overlap     )
+        ,("tiles never overlap",    mytest prop_tile_non_overlap)
 
         ]
 
-- 
cgit v1.2.3