From 53e7c0286ba79eea01975d60de49bf5f6c3e59b7 Mon Sep 17 00:00:00 2001 From: "joe.thornber" Date: Thu, 24 May 2007 12:04:23 +0200 Subject: [Spiral] Introduce a simpler Rect data type to remove a lot of the fromIntegrals darcs-hash:20070524100423-db939-055745b5398e184e9e259619c0d776fe8ad14bb3.gz --- Spiral.hs | 49 +++++++++++++++++++++++++++---------------------- 1 file changed, 27 insertions(+), 22 deletions(-) (limited to 'Spiral.hs') diff --git a/Spiral.hs b/Spiral.hs index e4cf2d9..ca8f891 100644 --- a/Spiral.hs +++ b/Spiral.hs @@ -26,36 +26,41 @@ data Direction = East | South | West | North deriving (Enum) spiral :: Rational -> Layout spiral scale = Layout { doLayout = fibLayout, - modifyLayout = \m -> fmap resize (fromMessage m) } + modifyLayout = \m -> fmap resize $ fromMessage m } where fibLayout sc ws = return $ zip ws rects - where len = length ws - ratios = map (* scale) . reverse . take len . mkRatios $ fibs - rects = divideRects ratios (cycle [East .. North]) len sc + where ratios = map (* scale) . reverse . take (length ws) . mkRatios $ fibs + rects = divideRects (zip ratios (cycle [East .. North])) sc resize Expand = spiral $ (21 % 20) * scale resize Shrink = spiral $ (20 % 21) * scale -divideRects :: [Rational] -> [Direction] -> Int -> Rectangle -> [Rectangle] -divideRects [] _ _ _ = [] -divideRects _ [] _ _ = [] -divideRects (r:rs) (d:ds) n rect | n <= 1 = [rect] - | otherwise = case divideRect r d rect of - (r1, r2) -> r1 : (divideRects rs ds (n - 1) r2) +divideRects :: [(Rational, Direction)] -> Rectangle -> [Rectangle] +divideRects [] _ = [] +divideRects ((r,d):xs) rect = case divideRect r d rect of + (r1, r2) -> r1 : (divideRects xs r2) + +-- It's much simpler if we work with all Integers and convert to +-- Rectangle at the end. +data Rect = Rect Integer Integer Integer Integer + +fromRect :: Rect -> Rectangle +fromRect (Rect x y w h) = Rectangle (fromIntegral x) (fromIntegral y) (fromIntegral w) (fromIntegral h) + +toRect :: Rectangle -> Rect +toRect (Rectangle x y w h) = Rect (fromIntegral x) (fromIntegral y) (fromIntegral w) (fromIntegral h) divideRect :: Rational -> Direction -> Rectangle -> (Rectangle, Rectangle) -divideRect ratio East (Rectangle x y w h) = let (w1, w2) = chop ratio (fromIntegral w) in - (Rectangle x y (fromIntegral w1) h, - Rectangle (x + (fromIntegral w1)) y (fromIntegral w2) h) -divideRect ratio South (Rectangle x y w h) = let (h1, h2) = chop ratio (fromIntegral h) in - (Rectangle x y w (fromIntegral h1), - Rectangle x (y + (fromIntegral h1)) w (fromIntegral h2)) -divideRect ratio West (Rectangle x y w h) = let (w1, w2) = chop (1 - ratio) (fromIntegral w) in - (Rectangle (x + (fromIntegral w1)) y (fromIntegral w2) h, - Rectangle x y (fromIntegral w1) h) -divideRect ratio North (Rectangle x y w h) = let (h1, h2) = chop (1 - ratio) (fromIntegral h) in - (Rectangle x (y + (fromIntegral h1)) w (fromIntegral h2), - Rectangle x y w (fromIntegral h1)) +divideRect r d rect = let (r1, r2) = divideRect' r d $ toRect rect in + (fromRect r1, fromRect r2) + +divideRect' :: Rational -> Direction -> Rect -> (Rect, Rect) +divideRect' ratio dir (Rect x y w h) = + case dir of + East -> let (w1, w2) = chop ratio w in (Rect x y w1 h, Rect (x + w1) y w2 h) + South -> let (h1, h2) = chop ratio h in (Rect x y w h1, Rect x (y + h1) w h2) + West -> let (w1, w2) = chop (1 - ratio) w in (Rect (x + w1) y w2 h, Rect x y w1 h) + North -> let (h1, h2) = chop (1 - ratio) h in (Rect x (y + h1) w h2, Rect x y w h1) chop :: Rational -> Integer -> (Integer, Integer) chop rat n = let f = ((fromIntegral n) * (numerator rat)) `div` (denominator rat) in -- cgit v1.2.3