{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.Mosaic -- Description : Give each window a specified amount of screen space relative to the others. -- Copyright : (c) 2009 Adam Vogt, 2007 James Webb -- License : BSD-style (see xmonad/LICENSE) -- -- Maintainer : vogt.adam<at>gmail.com -- Stability : unstable -- Portability : unportable -- -- Based on MosaicAlt, but aspect ratio messages always change the aspect -- ratios, and rearranging the window stack changes the window sizes. -- ----------------------------------------------------------------------------- module XMonad.Layout.Mosaic ( -- * Usage -- $usage Aspect(..) ,mosaic ,changeMaster ,changeFocused ,Mosaic ) where import Prelude hiding (sum) import XMonad(LayoutClass(doLayout, handleMessage, pureMessage, description), Message, X, fromMessage, withWindowSet, Resize(..), splitHorizontallyBy, splitVerticallyBy, sendMessage, Rectangle) import XMonad.Prelude (mplus, on, sortBy, sum) import qualified XMonad.StackSet as W import Control.Arrow(second, first) -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Layout.Mosaic -- -- Then edit your @layoutHook@ by adding the Mosaic layout: -- -- > myLayout = mosaic 2 [3,2] ||| Full ||| etc.. -- > main = xmonad $ def { layoutHook = myLayout } -- -- Unfortunately, infinite lists break serialization, so don't use them. And if -- the list is too short, it is extended with @++ repeat 1@, which covers the -- main use case. -- -- To change the choice in aspect ratio and the relative sizes of windows, add -- to your keybindings: -- -- > , ((modm, xK_a), sendMessage Taller) -- > , ((modm, xK_z), sendMessage Wider) -- -- > , ((modm, xK_r), sendMessage Reset) -- -- For more detailed instructions on editing the layoutHook see: -- -- "XMonad.Doc.Extending#Editing_the_layout_hook" data Aspect = Taller | Wider | Reset | SlopeMod ([Rational] -> [Rational]) instance Message Aspect -- | The relative magnitudes (the sign is ignored) of the rational numbers in -- the second argument determine the relative areas that the windows receive. -- The first number represents the size of the master window, the second is for -- the next window in the stack, and so on. -- -- The list is extended with @++ repeat 1@, so @mosaic 1.5 []@ is like a -- resizable grid. -- -- The first parameter is the multiplicative factor to use when responding to -- the 'Expand' message. mosaic :: Rational -> [Rational] -> Mosaic a mosaic :: Rational -> [Rational] -> Mosaic a mosaic = Maybe (Bool, Rational, Int) -> Rational -> [Rational] -> Mosaic a forall a. Maybe (Bool, Rational, Int) -> Rational -> [Rational] -> Mosaic a Mosaic Maybe (Bool, Rational, Int) forall a. Maybe a Nothing data Mosaic a = -- | True to override the aspect, current index, maximum index Mosaic (Maybe(Bool,Rational,Int)) Rational [Rational] deriving (ReadPrec [Mosaic a] ReadPrec (Mosaic a) Int -> ReadS (Mosaic a) ReadS [Mosaic a] (Int -> ReadS (Mosaic a)) -> ReadS [Mosaic a] -> ReadPrec (Mosaic a) -> ReadPrec [Mosaic a] -> Read (Mosaic a) forall a. ReadPrec [Mosaic a] forall a. ReadPrec (Mosaic a) forall a. Int -> ReadS (Mosaic a) forall a. ReadS [Mosaic a] forall a. (Int -> ReadS a) -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a readListPrec :: ReadPrec [Mosaic a] $creadListPrec :: forall a. ReadPrec [Mosaic a] readPrec :: ReadPrec (Mosaic a) $creadPrec :: forall a. ReadPrec (Mosaic a) readList :: ReadS [Mosaic a] $creadList :: forall a. ReadS [Mosaic a] readsPrec :: Int -> ReadS (Mosaic a) $creadsPrec :: forall a. Int -> ReadS (Mosaic a) Read,Int -> Mosaic a -> ShowS [Mosaic a] -> ShowS Mosaic a -> String (Int -> Mosaic a -> ShowS) -> (Mosaic a -> String) -> ([Mosaic a] -> ShowS) -> Show (Mosaic a) forall a. Int -> Mosaic a -> ShowS forall a. [Mosaic a] -> ShowS forall a. Mosaic a -> String forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [Mosaic a] -> ShowS $cshowList :: forall a. [Mosaic a] -> ShowS show :: Mosaic a -> String $cshow :: forall a. Mosaic a -> String showsPrec :: Int -> Mosaic a -> ShowS $cshowsPrec :: forall a. Int -> Mosaic a -> ShowS Show) instance LayoutClass Mosaic a where description :: Mosaic a -> String description = String -> Mosaic a -> String forall a b. a -> b -> a const String "Mosaic" pureMessage :: Mosaic a -> SomeMessage -> Maybe (Mosaic a) pureMessage (Mosaic Maybe (Bool, Rational, Int) Nothing Rational _ [Rational] _) SomeMessage _ = Maybe (Mosaic a) forall a. Maybe a Nothing pureMessage (Mosaic (Just(Bool _,Rational ix,Int mix)) Rational delta [Rational] ss) SomeMessage ms = SomeMessage -> Maybe Aspect forall m. Message m => SomeMessage -> Maybe m fromMessage SomeMessage ms Maybe Aspect -> (Aspect -> Maybe (Mosaic a)) -> Maybe (Mosaic a) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= Aspect -> Maybe (Mosaic a) forall a. Aspect -> Maybe (Mosaic a) ixMod where ixMod :: Aspect -> Maybe (Mosaic a) ixMod Aspect Taller | Rational -> Int forall a b. (RealFrac a, Integral b) => a -> b round Rational ix Int -> Int -> Bool forall a. Ord a => a -> a -> Bool >= Int mix = Maybe (Mosaic a) forall a. Maybe a Nothing | Bool otherwise = Mosaic a -> Maybe (Mosaic a) forall a. a -> Maybe a Just (Mosaic a -> Maybe (Mosaic a)) -> Mosaic a -> Maybe (Mosaic a) forall a b. (a -> b) -> a -> b $ Maybe (Bool, Rational, Int) -> Rational -> [Rational] -> Mosaic a forall a. Maybe (Bool, Rational, Int) -> Rational -> [Rational] -> Mosaic a Mosaic ((Bool, Rational, Int) -> Maybe (Bool, Rational, Int) forall a. a -> Maybe a Just(Bool False,Rational -> Rational forall a. Enum a => a -> a succ Rational ix,Int mix)) Rational delta [Rational] ss ixMod Aspect Wider | Rational -> Integer forall a b. (RealFrac a, Integral b) => a -> b round Rational ix Integer -> Integer -> Bool forall a. Ord a => a -> a -> Bool <= (Integer 0::Integer) = Maybe (Mosaic a) forall a. Maybe a Nothing | Bool otherwise = Mosaic a -> Maybe (Mosaic a) forall a. a -> Maybe a Just (Mosaic a -> Maybe (Mosaic a)) -> Mosaic a -> Maybe (Mosaic a) forall a b. (a -> b) -> a -> b $ Maybe (Bool, Rational, Int) -> Rational -> [Rational] -> Mosaic a forall a. Maybe (Bool, Rational, Int) -> Rational -> [Rational] -> Mosaic a Mosaic ((Bool, Rational, Int) -> Maybe (Bool, Rational, Int) forall a. a -> Maybe a Just(Bool False,Rational -> Rational forall a. Enum a => a -> a pred Rational ix,Int mix)) Rational delta [Rational] ss ixMod Aspect Reset = Mosaic a -> Maybe (Mosaic a) forall a. a -> Maybe a Just (Mosaic a -> Maybe (Mosaic a)) -> Mosaic a -> Maybe (Mosaic a) forall a b. (a -> b) -> a -> b $ Maybe (Bool, Rational, Int) -> Rational -> [Rational] -> Mosaic a forall a. Maybe (Bool, Rational, Int) -> Rational -> [Rational] -> Mosaic a Mosaic Maybe (Bool, Rational, Int) forall a. Maybe a Nothing Rational delta [Rational] ss ixMod (SlopeMod [Rational] -> [Rational] f) = Mosaic a -> Maybe (Mosaic a) forall a. a -> Maybe a Just (Mosaic a -> Maybe (Mosaic a)) -> Mosaic a -> Maybe (Mosaic a) forall a b. (a -> b) -> a -> b $ Maybe (Bool, Rational, Int) -> Rational -> [Rational] -> Mosaic a forall a. Maybe (Bool, Rational, Int) -> Rational -> [Rational] -> Mosaic a Mosaic ((Bool, Rational, Int) -> Maybe (Bool, Rational, Int) forall a. a -> Maybe a Just(Bool False,Rational ix,Int mix)) Rational delta ([Rational] -> [Rational] f [Rational] ss) handleMessage :: Mosaic a -> SomeMessage -> X (Maybe (Mosaic a)) handleMessage l :: Mosaic a l@(Mosaic Maybe (Bool, Rational, Int) _ Rational delta [Rational] _) SomeMessage ms | Just Resize Expand <- SomeMessage -> Maybe Resize forall m. Message m => SomeMessage -> Maybe m fromMessage SomeMessage ms = (Rational -> Rational) -> X () changeFocused (Rational -> Rational -> Rational forall a. Num a => a -> a -> a *Rational delta) X () -> X (Maybe (Mosaic a)) -> X (Maybe (Mosaic a)) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >> Maybe (Mosaic a) -> X (Maybe (Mosaic a)) forall (m :: * -> *) a. Monad m => a -> m a return Maybe (Mosaic a) forall a. Maybe a Nothing | Just Resize Shrink <- SomeMessage -> Maybe Resize forall m. Message m => SomeMessage -> Maybe m fromMessage SomeMessage ms = (Rational -> Rational) -> X () changeFocused (Rational -> Rational -> Rational forall a. Fractional a => a -> a -> a /Rational delta) X () -> X (Maybe (Mosaic a)) -> X (Maybe (Mosaic a)) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >> Maybe (Mosaic a) -> X (Maybe (Mosaic a)) forall (m :: * -> *) a. Monad m => a -> m a return Maybe (Mosaic a) forall a. Maybe a Nothing | Bool otherwise = Maybe (Mosaic a) -> X (Maybe (Mosaic a)) forall (m :: * -> *) a. Monad m => a -> m a return (Maybe (Mosaic a) -> X (Maybe (Mosaic a))) -> Maybe (Mosaic a) -> X (Maybe (Mosaic a)) forall a b. (a -> b) -> a -> b $ Mosaic a -> SomeMessage -> Maybe (Mosaic a) forall (layout :: * -> *) a. LayoutClass layout a => layout a -> SomeMessage -> Maybe (layout a) pureMessage Mosaic a l SomeMessage ms doLayout :: Mosaic a -> Rectangle -> Stack a -> X ([(a, Rectangle)], Maybe (Mosaic a)) doLayout (Mosaic Maybe (Bool, Rational, Int) state Rational delta [Rational] ss) Rectangle r Stack a st = let ssExt :: [Rational] ssExt = (Rational -> a -> Rational) -> [Rational] -> [a] -> [Rational] forall a b c. (a -> b -> c) -> [a] -> [b] -> [c] zipWith Rational -> a -> Rational forall a b. a -> b -> a const ([Rational] ss [Rational] -> [Rational] -> [Rational] forall a. [a] -> [a] -> [a] ++ Rational -> [Rational] forall a. a -> [a] repeat Rational 1) ([a] -> [Rational]) -> [a] -> [Rational] forall a b. (a -> b) -> a -> b $ Stack a -> [a] forall a. Stack a -> [a] W.integrate Stack a st rects :: [[Rectangle]] rects = Rectangle -> [Rational] -> [[Rectangle]] splits Rectangle r [Rational] ssExt nls :: Int nls = [[Rectangle]] -> Int forall (t :: * -> *) a. Foldable t => t a -> Int length [[Rectangle]] rects fi :: Int -> Rational fi = Int -> Rational forall a b. (Integral a, Num b) => a -> b fromIntegral nextIx :: (Bool, Rational, Int) -> Rational nextIx (Bool ov,Rational ix,Int mix) | Int mix Int -> Int -> Bool forall a. Ord a => a -> a -> Bool <= Int 0 Bool -> Bool -> Bool || Bool ov = Int -> Rational forall a b. (Integral a, Num b) => a -> b fromIntegral (Int -> Rational) -> Int -> Rational forall a b. (a -> b) -> a -> b $ Int nls Int -> Int -> Int forall a. Integral a => a -> a -> a `div` Int 2 | Bool otherwise = Rational -> Rational -> Rational forall a. Ord a => a -> a -> a max Rational 0 (Rational -> Rational) -> Rational -> Rational forall a b. (a -> b) -> a -> b $ (Rational -> Rational -> Rational forall a. Num a => a -> a -> a *Int -> Rational fi (Int -> Int forall a. Enum a => a -> a pred Int nls)) (Rational -> Rational) -> Rational -> Rational forall a b. (a -> b) -> a -> b $ Rational -> Rational -> Rational forall a. Ord a => a -> a -> a min Rational 1 (Rational -> Rational) -> Rational -> Rational forall a b. (a -> b) -> a -> b $ Rational ix Rational -> Rational -> Rational forall a. Fractional a => a -> a -> a / Int -> Rational fi Int mix rect :: [Rectangle] rect = [[Rectangle]] rects [[Rectangle]] -> Int -> [Rectangle] forall a. [a] -> Int -> a !! Int -> (Rational -> Int) -> Maybe Rational -> Int forall b a. b -> (a -> b) -> Maybe a -> b maybe (Int nls Int -> Int -> Int forall a. Integral a => a -> a -> a `div` Int 2) Rational -> Int forall a b. (RealFrac a, Integral b) => a -> b round ((Bool, Rational, Int) -> Rational nextIx ((Bool, Rational, Int) -> Rational) -> Maybe (Bool, Rational, Int) -> Maybe Rational forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Maybe (Bool, Rational, Int) state) state' :: Maybe (Bool, Rational, Int) state' = ((Bool, Rational, Int) -> (Bool, Rational, Int)) -> Maybe (Bool, Rational, Int) -> Maybe (Bool, Rational, Int) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (\x :: (Bool, Rational, Int) x@(Bool ov,Rational _,Int _) -> (Bool ov,(Bool, Rational, Int) -> Rational nextIx (Bool, Rational, Int) x,Int -> Int forall a. Enum a => a -> a pred Int nls)) Maybe (Bool, Rational, Int) state Maybe (Bool, Rational, Int) -> Maybe (Bool, Rational, Int) -> Maybe (Bool, Rational, Int) forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a `mplus` (Bool, Rational, Int) -> Maybe (Bool, Rational, Int) forall a. a -> Maybe a Just (Bool True,Int -> Rational forall a b. (Integral a, Num b) => a -> b fromIntegral Int nls Rational -> Rational -> Rational forall a. Fractional a => a -> a -> a / Rational 2,Int -> Int forall a. Enum a => a -> a pred Int nls) ss' :: [Rational] ss' = [Rational] -> (Either [Rational] [Rational] -> [Rational]) -> Maybe (Either [Rational] [Rational]) -> [Rational] forall b a. b -> (a -> b) -> Maybe a -> b maybe [Rational] ss ([Rational] -> [Rational] -> [Rational] forall a b. a -> b -> a const [Rational] ss ([Rational] -> [Rational]) -> ([Rational] -> [Rational]) -> Either [Rational] [Rational] -> [Rational] forall a c b. (a -> c) -> (b -> c) -> Either a b -> c `either` [Rational] -> [Rational] -> [Rational] forall a b. a -> b -> a const [Rational] ssExt) (Maybe (Either [Rational] [Rational]) -> [Rational]) -> Maybe (Either [Rational] [Rational]) -> [Rational] forall a b. (a -> b) -> a -> b $ [Rational] -> [Rational] -> Maybe (Either [Rational] [Rational]) forall a b. [a] -> [b] -> Maybe (Either [a] [b]) zipRemain [Rational] ss [Rational] ssExt in ([(a, Rectangle)], Maybe (Mosaic a)) -> X ([(a, Rectangle)], Maybe (Mosaic a)) forall (m :: * -> *) a. Monad m => a -> m a return ([a] -> [Rectangle] -> [(a, Rectangle)] forall a b. [a] -> [b] -> [(a, b)] zip (Stack a -> [a] forall a. Stack a -> [a] W.integrate Stack a st) [Rectangle] rect, Mosaic a -> Maybe (Mosaic a) forall a. a -> Maybe a Just (Mosaic a -> Maybe (Mosaic a)) -> Mosaic a -> Maybe (Mosaic a) forall a b. (a -> b) -> a -> b $ Maybe (Bool, Rational, Int) -> Rational -> [Rational] -> Mosaic a forall a. Maybe (Bool, Rational, Int) -> Rational -> [Rational] -> Mosaic a Mosaic Maybe (Bool, Rational, Int) state' Rational delta [Rational] ss') zipRemain :: [a] -> [b] -> Maybe (Either [a] [b]) zipRemain :: [a] -> [b] -> Maybe (Either [a] [b]) zipRemain (a _:[a] xs) (b _:[b] ys) = [a] -> [b] -> Maybe (Either [a] [b]) forall a b. [a] -> [b] -> Maybe (Either [a] [b]) zipRemain [a] xs [b] ys zipRemain [] [] = Maybe (Either [a] [b]) forall a. Maybe a Nothing zipRemain [] [b] y = Either [a] [b] -> Maybe (Either [a] [b]) forall a. a -> Maybe a Just ([b] -> Either [a] [b] forall a b. b -> Either a b Right [b] y) zipRemain [a] x [] = Either [a] [b] -> Maybe (Either [a] [b]) forall a. a -> Maybe a Just ([a] -> Either [a] [b] forall a b. a -> Either a b Left [a] x) -- | These sample functions are meant to be applied to the list of window sizes -- through the 'SlopeMod' message. changeMaster :: (Rational -> Rational) -> X () changeMaster :: (Rational -> Rational) -> X () changeMaster = Aspect -> X () forall a. Message a => a -> X () sendMessage (Aspect -> X ()) -> ((Rational -> Rational) -> Aspect) -> (Rational -> Rational) -> X () forall b c a. (b -> c) -> (a -> b) -> a -> c . ([Rational] -> [Rational]) -> Aspect SlopeMod (([Rational] -> [Rational]) -> Aspect) -> ((Rational -> Rational) -> [Rational] -> [Rational]) -> (Rational -> Rational) -> Aspect forall b c a. (b -> c) -> (a -> b) -> a -> c . (Rational -> Rational) -> [Rational] -> [Rational] forall a. (a -> a) -> [a] -> [a] onHead -- | Apply a function to the Rational that represents the currently focused -- window. -- -- 'Expand' and 'Shrink' messages are responded to with @changeFocused -- (*delta)@ or @changeFocused (delta/)@ where @delta@ is the first argument to -- 'mosaic'. -- -- This is exported because other functions (ex. @const 1@, @(+1)@) may be -- useful to apply to the current area. changeFocused :: (Rational -> Rational) -> X () changeFocused :: (Rational -> Rational) -> X () changeFocused Rational -> Rational f = (WindowSet -> X ()) -> X () forall a. (WindowSet -> X a) -> X a withWindowSet ((WindowSet -> X ()) -> X ()) -> (WindowSet -> X ()) -> X () forall a b. (a -> b) -> a -> b $ Aspect -> X () forall a. Message a => a -> X () sendMessage (Aspect -> X ()) -> (WindowSet -> Aspect) -> WindowSet -> X () forall b c a. (b -> c) -> (a -> b) -> a -> c . ([Rational] -> [Rational]) -> Aspect SlopeMod (([Rational] -> [Rational]) -> Aspect) -> (WindowSet -> [Rational] -> [Rational]) -> WindowSet -> Aspect forall b c a. (b -> c) -> (a -> b) -> a -> c . ([Rational] -> [Rational]) -> (Stack Window -> [Rational] -> [Rational]) -> Maybe (Stack Window) -> [Rational] -> [Rational] forall b a. b -> (a -> b) -> Maybe a -> b maybe [Rational] -> [Rational] forall a. a -> a id (Int -> [Rational] -> [Rational] mulIx (Int -> [Rational] -> [Rational]) -> (Stack Window -> Int) -> Stack Window -> [Rational] -> [Rational] forall b c a. (b -> c) -> (a -> b) -> a -> c . [Window] -> Int forall (t :: * -> *) a. Foldable t => t a -> Int length ([Window] -> Int) -> (Stack Window -> [Window]) -> Stack Window -> Int forall b c a. (b -> c) -> (a -> b) -> a -> c . Stack Window -> [Window] forall a. Stack a -> [a] W.up) (Maybe (Stack Window) -> [Rational] -> [Rational]) -> (WindowSet -> Maybe (Stack Window)) -> WindowSet -> [Rational] -> [Rational] forall b c a. (b -> c) -> (a -> b) -> a -> c . Workspace String (Layout Window) Window -> Maybe (Stack Window) forall i l a. Workspace i l a -> Maybe (Stack a) W.stack (Workspace String (Layout Window) Window -> Maybe (Stack Window)) -> (WindowSet -> Workspace String (Layout Window) Window) -> WindowSet -> Maybe (Stack Window) forall b c a. (b -> c) -> (a -> b) -> a -> c . Screen String (Layout Window) Window ScreenId ScreenDetail -> Workspace String (Layout Window) Window forall i l a sid sd. Screen i l a sid sd -> Workspace i l a W.workspace (Screen String (Layout Window) Window ScreenId ScreenDetail -> Workspace String (Layout Window) Window) -> (WindowSet -> Screen String (Layout Window) Window ScreenId ScreenDetail) -> WindowSet -> Workspace String (Layout Window) Window forall b c a. (b -> c) -> (a -> b) -> a -> c . WindowSet -> Screen String (Layout Window) Window ScreenId ScreenDetail forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd W.current where mulIx :: Int -> [Rational] -> [Rational] mulIx Int i = ([Rational] -> [Rational] -> [Rational]) -> ([Rational], [Rational]) -> [Rational] forall a b c. (a -> b -> c) -> (a, b) -> c uncurry [Rational] -> [Rational] -> [Rational] forall a. [a] -> [a] -> [a] (++) (([Rational], [Rational]) -> [Rational]) -> ([Rational] -> ([Rational], [Rational])) -> [Rational] -> [Rational] forall b c a. (b -> c) -> (a -> b) -> a -> c . ([Rational] -> [Rational]) -> ([Rational], [Rational]) -> ([Rational], [Rational]) forall (a :: * -> * -> *) b c d. Arrow a => a b c -> a (d, b) (d, c) second ((Rational -> Rational) -> [Rational] -> [Rational] forall a. (a -> a) -> [a] -> [a] onHead Rational -> Rational f) (([Rational], [Rational]) -> ([Rational], [Rational])) -> ([Rational] -> ([Rational], [Rational])) -> [Rational] -> ([Rational], [Rational]) forall b c a. (b -> c) -> (a -> b) -> a -> c . Int -> [Rational] -> ([Rational], [Rational]) forall a. Int -> [a] -> ([a], [a]) splitAt Int i onHead :: (a -> a) -> [a] -> [a] onHead :: (a -> a) -> [a] -> [a] onHead a -> a f = ([a] -> [a] -> [a]) -> ([a], [a]) -> [a] forall a b c. (a -> b -> c) -> (a, b) -> c uncurry [a] -> [a] -> [a] forall a. [a] -> [a] -> [a] (++) (([a], [a]) -> [a]) -> ([a] -> ([a], [a])) -> [a] -> [a] forall b c a. (b -> c) -> (a -> b) -> a -> c . ([a] -> [a]) -> ([a], [a]) -> ([a], [a]) forall (a :: * -> * -> *) b c d. Arrow a => a b c -> a (b, d) (c, d) first ((a -> a) -> [a] -> [a] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap a -> a f) (([a], [a]) -> ([a], [a])) -> ([a] -> ([a], [a])) -> [a] -> ([a], [a]) forall b c a. (b -> c) -> (a -> b) -> a -> c . Int -> [a] -> ([a], [a]) forall a. Int -> [a] -> ([a], [a]) splitAt Int 1 splits :: Rectangle -> [Rational] -> [[Rectangle]] splits :: Rectangle -> [Rational] -> [[Rectangle]] splits Rectangle rect = ([(Int, Rectangle)] -> [Rectangle]) -> [[(Int, Rectangle)]] -> [[Rectangle]] forall a b. (a -> b) -> [a] -> [b] map ([Rectangle] -> [Rectangle] forall a. [a] -> [a] reverse ([Rectangle] -> [Rectangle]) -> ([(Int, Rectangle)] -> [Rectangle]) -> [(Int, Rectangle)] -> [Rectangle] forall b c a. (b -> c) -> (a -> b) -> a -> c . ((Int, Rectangle) -> Rectangle) -> [(Int, Rectangle)] -> [Rectangle] forall a b. (a -> b) -> [a] -> [b] map (Int, Rectangle) -> Rectangle forall a b. (a, b) -> b snd ([(Int, Rectangle)] -> [Rectangle]) -> ([(Int, Rectangle)] -> [(Int, Rectangle)]) -> [(Int, Rectangle)] -> [Rectangle] forall b c a. (b -> c) -> (a -> b) -> a -> c . ((Int, Rectangle) -> (Int, Rectangle) -> Ordering) -> [(Int, Rectangle)] -> [(Int, Rectangle)] forall a. (a -> a -> Ordering) -> [a] -> [a] sortBy (Int -> Int -> Ordering forall a. Ord a => a -> a -> Ordering compare (Int -> Int -> Ordering) -> ((Int, Rectangle) -> Int) -> (Int, Rectangle) -> (Int, Rectangle) -> Ordering forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c `on` (Int, Rectangle) -> Int forall a b. (a, b) -> a fst)) ([[(Int, Rectangle)]] -> [[Rectangle]]) -> ([Rational] -> [[(Int, Rectangle)]]) -> [Rational] -> [[Rectangle]] forall b c a. (b -> c) -> (a -> b) -> a -> c . Rectangle -> Tree (Int, Rational) -> [[(Int, Rectangle)]] splitsL Rectangle rect (Tree (Int, Rational) -> [[(Int, Rectangle)]]) -> ([Rational] -> Tree (Int, Rational)) -> [Rational] -> [[(Int, Rectangle)]] forall b c a. (b -> c) -> (a -> b) -> a -> c . ((Int, Rational) -> Rational) -> [(Int, Rational)] -> Tree (Int, Rational) forall a1 a. (Num a1, Ord a1) => (a -> a1) -> [a] -> Tree a makeTree (Int, Rational) -> Rational forall a b. (a, b) -> b snd ([(Int, Rational)] -> Tree (Int, Rational)) -> ([Rational] -> [(Int, Rational)]) -> [Rational] -> Tree (Int, Rational) forall b c a. (b -> c) -> (a -> b) -> a -> c . [Int] -> [Rational] -> [(Int, Rational)] forall a b. [a] -> [b] -> [(a, b)] zip [Int 1..] ([Rational] -> [(Int, Rational)]) -> ([Rational] -> [Rational]) -> [Rational] -> [(Int, Rational)] forall b c a. (b -> c) -> (a -> b) -> a -> c . [Rational] -> [Rational] forall a. Fractional a => [a] -> [a] normalize ([Rational] -> [Rational]) -> ([Rational] -> [Rational]) -> [Rational] -> [Rational] forall b c a. (b -> c) -> (a -> b) -> a -> c . [Rational] -> [Rational] forall a. [a] -> [a] reverse ([Rational] -> [Rational]) -> ([Rational] -> [Rational]) -> [Rational] -> [Rational] forall b c a. (b -> c) -> (a -> b) -> a -> c . (Rational -> Rational) -> [Rational] -> [Rational] forall a b. (a -> b) -> [a] -> [b] map Rational -> Rational forall a. Num a => a -> a abs splitsL :: Rectangle -> Tree (Int,Rational) -> [[(Int,Rectangle)]] splitsL :: Rectangle -> Tree (Int, Rational) -> [[(Int, Rectangle)]] splitsL Rectangle _rect Tree (Int, Rational) Empty = [] splitsL Rectangle rect (Leaf (Int x,Rational _)) = [[(Int x,Rectangle rect)]] splitsL Rectangle rect (Branch Tree (Int, Rational) l Tree (Int, Rational) r) = do let mkSplit :: (Rational -> Rectangle -> t) -> t mkSplit Rational -> Rectangle -> t f = Rational -> Rectangle -> t f ((Tree (Int, Rational) -> Rational forall a. Tree (a, Rational) -> Rational sumSnd Tree (Int, Rational) l Rational -> Rational -> Rational forall a. Fractional a => a -> a -> a /) (Rational -> Rational) -> Rational -> Rational forall a b. (a -> b) -> a -> b $ Tree (Int, Rational) -> Rational forall a. Tree (a, Rational) -> Rational sumSnd Tree (Int, Rational) l Rational -> Rational -> Rational forall a. Num a => a -> a -> a + Tree (Int, Rational) -> Rational forall a. Tree (a, Rational) -> Rational sumSnd Tree (Int, Rational) r) Rectangle rect sumSnd :: Tree (a, Rational) -> Rational sumSnd = Tree Rational -> Rational forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a sum (Tree Rational -> Rational) -> (Tree (a, Rational) -> Tree Rational) -> Tree (a, Rational) -> Rational forall b c a. (b -> c) -> (a -> b) -> a -> c . ((a, Rational) -> Rational) -> Tree (a, Rational) -> Tree Rational forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (a, Rational) -> Rational forall a b. (a, b) -> b snd (Rectangle rl,Rectangle rr) <- ((Rational -> Rectangle -> (Rectangle, Rectangle)) -> (Rectangle, Rectangle)) -> [Rational -> Rectangle -> (Rectangle, Rectangle)] -> [(Rectangle, Rectangle)] forall a b. (a -> b) -> [a] -> [b] map (Rational -> Rectangle -> (Rectangle, Rectangle)) -> (Rectangle, Rectangle) forall t. (Rational -> Rectangle -> t) -> t mkSplit [Rational -> Rectangle -> (Rectangle, Rectangle) forall r. RealFrac r => r -> Rectangle -> (Rectangle, Rectangle) splitVerticallyBy,Rational -> Rectangle -> (Rectangle, Rectangle) forall r. RealFrac r => r -> Rectangle -> (Rectangle, Rectangle) splitHorizontallyBy] Rectangle -> Tree (Int, Rational) -> [[(Int, Rectangle)]] splitsL Rectangle rl Tree (Int, Rational) l [[(Int, Rectangle)]] -> [[(Int, Rectangle)]] -> [[(Int, Rectangle)]] forall a. [[a]] -> [[a]] -> [[a]] `interleave` Rectangle -> Tree (Int, Rational) -> [[(Int, Rectangle)]] splitsL Rectangle rr Tree (Int, Rational) r -- like zipWith (++), but when one list is shorter, its elements are duplicated -- so that they match interleave :: [[a]] -> [[a]] -> [[a]] interleave :: [[a]] -> [[a]] -> [[a]] interleave [[a]] xs [[a]] ys | Int lx Int -> Int -> Bool forall a. Ord a => a -> a -> Bool > Int ly = [[a]] -> [[a]] -> [[a]] forall a. [[a]] -> [[a]] -> [[a]] zc [[a]] xs (Int -> [[a]] -> [[a]] forall a. Int -> [a] -> [a] extend Int lx [[a]] ys) | Bool otherwise = [[a]] -> [[a]] -> [[a]] forall a. [[a]] -> [[a]] -> [[a]] zc (Int -> [[a]] -> [[a]] forall a. Int -> [a] -> [a] extend Int ly [[a]] xs) [[a]] ys where lx :: Int lx = [[a]] -> Int forall (t :: * -> *) a. Foldable t => t a -> Int length [[a]] xs ly :: Int ly = [[a]] -> Int forall (t :: * -> *) a. Foldable t => t a -> Int length [[a]] ys zc :: [[a]] -> [[a]] -> [[a]] zc = ([a] -> [a] -> [a]) -> [[a]] -> [[a]] -> [[a]] forall a b c. (a -> b -> c) -> [a] -> [b] -> [c] zipWith [a] -> [a] -> [a] forall a. [a] -> [a] -> [a] (++) extend :: Int -> [a] -> [a] extend :: Int -> [a] -> [a] extend Int n [a] pat = do (a p,Bool e) <- [a] -> [Bool] -> [(a, Bool)] forall a b. [a] -> [b] -> [(a, b)] zip [a] pat ([Bool] -> [(a, Bool)]) -> [Bool] -> [(a, Bool)] forall a b. (a -> b) -> a -> b $ Int -> Bool -> [Bool] forall a. Int -> a -> [a] replicate Int m Bool True [Bool] -> [Bool] -> [Bool] forall a. [a] -> [a] -> [a] ++ Bool -> [Bool] forall a. a -> [a] repeat Bool False [a p | Bool e] [a] -> [a] -> [a] forall a. [a] -> [a] -> [a] ++ Int -> a -> [a] forall a. Int -> a -> [a] replicate Int d a p where (Int d,Int m) = Int n Int -> Int -> (Int, Int) forall a. Integral a => a -> a -> (a, a) `divMod` [a] -> Int forall (t :: * -> *) a. Foldable t => t a -> Int length [a] pat normalize :: Fractional a => [a] -> [a] normalize :: [a] -> [a] normalize [a] x = let s :: a s = [a] -> a forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a sum [a] x in (a -> a) -> [a] -> [a] forall a b. (a -> b) -> [a] -> [b] map (a -> a -> a forall a. Fractional a => a -> a -> a /a s) [a] x data Tree a = Branch (Tree a) (Tree a) | Leaf a | Empty instance Foldable Tree where foldMap :: (a -> m) -> Tree a -> m foldMap a -> m _f Tree a Empty = m forall a. Monoid a => a mempty foldMap a -> m f (Leaf a x) = a -> m f a x foldMap a -> m f (Branch Tree a l Tree a r) = (a -> m) -> Tree a -> m forall (t :: * -> *) m a. (Foldable t, Monoid m) => (a -> m) -> t a -> m foldMap a -> m f Tree a l m -> m -> m forall a. Monoid a => a -> a -> a `mappend` (a -> m) -> Tree a -> m forall (t :: * -> *) m a. (Foldable t, Monoid m) => (a -> m) -> t a -> m foldMap a -> m f Tree a r instance Functor Tree where fmap :: (a -> b) -> Tree a -> Tree b fmap a -> b f (Leaf a x) = b -> Tree b forall a. a -> Tree a Leaf (b -> Tree b) -> b -> Tree b forall a b. (a -> b) -> a -> b $ a -> b f a x fmap a -> b f (Branch Tree a l Tree a r) = Tree b -> Tree b -> Tree b forall a. Tree a -> Tree a -> Tree a Branch ((a -> b) -> Tree a -> Tree b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap a -> b f Tree a l) ((a -> b) -> Tree a -> Tree b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap a -> b f Tree a r) fmap a -> b _ Tree a Empty = Tree b forall a. Tree a Empty instance Semigroup (Tree a) where Tree a Empty <> :: Tree a -> Tree a -> Tree a <> Tree a x = Tree a x Tree a x <> Tree a Empty = Tree a x Tree a x <> Tree a y = Tree a -> Tree a -> Tree a forall a. Tree a -> Tree a -> Tree a Branch Tree a x Tree a y instance Monoid (Tree a) where mempty :: Tree a mempty = Tree a forall a. Tree a Empty makeTree :: (Num a1, Ord a1) => (a -> a1) -> [a] -> Tree a makeTree :: (a -> a1) -> [a] -> Tree a makeTree a -> a1 _ [] = Tree a forall a. Tree a Empty makeTree a -> a1 _ [a x] = a -> Tree a forall a. a -> Tree a Leaf a x makeTree a -> a1 f [a] xs = Tree a -> Tree a -> Tree a forall a. Tree a -> Tree a -> Tree a Branch ((a -> a1) -> [a] -> Tree a forall a1 a. (Num a1, Ord a1) => (a -> a1) -> [a] -> Tree a makeTree a -> a1 f [a] a) ((a -> a1) -> [a] -> Tree a forall a1 a. (Num a1, Ord a1) => (a -> a1) -> [a] -> Tree a makeTree a -> a1 f [a] b) where (([a] a,[a] b),(a1, a1) _) = (a -> (([a], [a]), (a1, a1)) -> (([a], [a]), (a1, a1))) -> (([a], [a]), (a1, a1)) -> [a] -> (([a], [a]), (a1, a1)) forall (t :: * -> *) a b. Foldable t => (a -> b -> b) -> b -> t a -> b foldr a -> (([a], [a]), (a1, a1)) -> (([a], [a]), (a1, a1)) go (([],[]),(a1 0,a1 0)) [a] xs go :: a -> (([a], [a]), (a1, a1)) -> (([a], [a]), (a1, a1)) go a n (([a] ls,[a] rs),(a1 l,a1 r)) | a1 l a1 -> a1 -> Bool forall a. Ord a => a -> a -> Bool > a1 r = (([a] ls,a na -> [a] -> [a] forall a. a -> [a] -> [a] :[a] rs),(a1 l,a -> a1 f a na1 -> a1 -> a1 forall a. Num a => a -> a -> a +a1 r)) | Bool otherwise = ((a na -> [a] -> [a] forall a. a -> [a] -> [a] :[a] ls,[a] rs),(a -> a1 f a na1 -> a1 -> a1 forall a. Num a => a -> a -> a +a1 l,a1 r))