summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorDavid Roundy <droundy@darcs.net>2007-05-15 17:40:11 +0200
committerDavid Roundy <droundy@darcs.net>2007-05-15 17:40:11 +0200
commit2e1cce72a76b26e798af5b2046bf2508569446c9 (patch)
tree7e39585390d77721394a10b0388469ffdbc50d33
parentd2e3f0eb762968cf6a75f828d82477c7ee4ed99f (diff)
downloadmetatile-2e1cce72a76b26e798af5b2046bf2508569446c9.tar
metatile-2e1cce72a76b26e798af5b2046bf2508569446c9.zip
beautify tile
darcs-hash:20070515154011-72aca-1557c99da679a2be1e52f365f6ae72cfaf40fc87
-rw-r--r--Operations.hs29
-rw-r--r--tests/Properties.hs6
2 files changed, 21 insertions, 14 deletions
diff --git a/Operations.hs b/Operations.hs
index 93fdba1..a966430 100644
--- a/Operations.hs
+++ b/Operations.hs
@@ -108,7 +108,7 @@ full = Layout { doLayout = \sc ws -> return [ (w,sc) | w <- ws ]
tall, wide :: Rational -> Rational -> Layout
wide delta frac = mirrorLayout (tall delta frac)
-tall delta frac = Layout { doLayout = \a b -> return $ tile frac a b
+tall delta frac = Layout { doLayout = \r w -> return $ zip w $ tile frac r (length w)
, modifyLayout = fmap handler . fromMessage }
where handler s = tall delta $ (case s of
@@ -131,16 +131,23 @@ mirrorLayout (Layout { doLayout = dl, modifyLayout = ml }) =
-- * no windows overlap
-- * no gaps exist between windows.
--
-tile :: Rational -> Rectangle -> [Window] -> [(Window, Rectangle)]
-tile _ _ [] = []
-tile _ d [w] = [(w, d)]
-tile r (Rectangle sx sy sw sh) (w:s) =
- (w, Rectangle sx sy (fromIntegral lw) sh) : zipWith f [sy, sy + rh ..] s
- where
- lw = floor $ fromIntegral sw * r
- rw = sw - fromIntegral lw
- rh = fromIntegral sh `div` fromIntegral (length s)
- f i a = (a, Rectangle (sx + lw) i rw (fromIntegral rh))
+tile :: Rational -> Rectangle -> Int -> [Rectangle]
+tile _ d n | n < 2 = [d]
+tile f r n = r1 : split_vertically (n-1) r2
+ where (r1,r2) = split_horizontally_by f r
+
+split_vertically, split_horizontally :: Int -> Rectangle -> [Rectangle]
+split_vertically n r | n < 2 = [r]
+split_vertically n (Rectangle sx sy sw sh) = Rectangle sx sy sw smallh :
+ split_vertically (n-1) (Rectangle sx (sy+fromIntegral smallh) sw (sh-smallh))
+ where smallh = sh `div` fromIntegral n
+split_horizontally n r = map mirrorRect $ split_vertically n $ mirrorRect r
+
+split_horizontally_by, split_vertically_by :: Rational -> Rectangle -> (Rectangle, Rectangle)
+split_horizontally_by 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
+split_vertically_by f r = (\(a,b)->(mirrorRect a,mirrorRect b)) $ split_horizontally_by f $ mirrorRect r
------------------------------------------------------------------------
diff --git a/tests/Properties.hs b/tests/Properties.hs
index b97423f..d9f1fb5 100644
--- a/tests/Properties.hs
+++ b/tests/Properties.hs
@@ -265,7 +265,7 @@ prop_push_local (x :: T) i = not (member i x) ==> hidden x == hidden (push i x)
-- some properties for layouts:
-- 1 window should always be tiled fullscreen
-prop_tile_fullscreen rect = tile pct rect [1] == [(1, rect)]
+prop_tile_fullscreen rect = tile pct rect 1 == [rect]
-- multiple windows
prop_tile_non_overlap rect windows = noOverlaps (tile pct rect windows)
@@ -276,8 +276,8 @@ pct = 3 % 100
noOverlaps [] = True
noOverlaps [_] = True
noOverlaps xs = and [ verts a `notOverlap` verts b
- | (_,a) <- xs
- , (_,b) <- filter (\(_,b) -> a /= b) xs
+ | a <- xs
+ , b <- filter (a /=) xs
]
where
verts (Rectangle a b w h) = (a,b,a + fromIntegral w - 1, b + fromIntegral h - 1)