{-# LANGUAGE PatternGuards, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, TupleSections #-}
module XMonad.Layout.AvoidFloats (
avoidFloats,
avoidFloats',
AvoidFloatMsg(..),
AvoidFloatItemMsg(..),
) where
import XMonad
import XMonad.Layout.LayoutModifier
import XMonad.Prelude (fi, mapMaybe, maximumBy, sortOn)
import qualified XMonad.StackSet as W
import Data.Ord
import qualified Data.Map as M
import qualified Data.Set as S
avoidFloats
:: l a
-> ModifiedLayout AvoidFloats l a
avoidFloats :: forall (l :: * -> *) a. l a -> ModifiedLayout AvoidFloats l a
avoidFloats = forall (l :: * -> *) a.
Int -> Int -> Bool -> l a -> ModifiedLayout AvoidFloats l a
avoidFloats' Int
100 Int
100 Bool
False
avoidFloats'
:: Int
-> Int
-> Bool
-> l a
-> ModifiedLayout AvoidFloats l a
avoidFloats' :: forall (l :: * -> *) a.
Int -> Int -> Bool -> l a -> ModifiedLayout AvoidFloats l a
avoidFloats' Int
w Int
h Bool
act = forall (m :: * -> *) (l :: * -> *) a.
m a -> l a -> ModifiedLayout m l a
ModifiedLayout (forall a.
Maybe ((Map a RationalRect, Rectangle), Rectangle)
-> Set a -> Int -> Int -> Bool -> AvoidFloats a
AvoidFloats forall a. Maybe a
Nothing forall a. Set a
S.empty Int
w Int
h Bool
act)
data AvoidFloats a = AvoidFloats
{ forall a.
AvoidFloats a -> Maybe ((Map a RationalRect, Rectangle), Rectangle)
cache :: Maybe ((M.Map a W.RationalRect, Rectangle), Rectangle)
, forall a. AvoidFloats a -> Set a
chosen :: S.Set a
, forall a. AvoidFloats a -> Int
minw :: Int
, forall a. AvoidFloats a -> Int
minh :: Int
, forall a. AvoidFloats a -> Bool
avoidAll :: Bool
} deriving (ReadPrec [AvoidFloats a]
ReadPrec (AvoidFloats a)
ReadS [AvoidFloats a]
forall a. (Ord a, Read a) => ReadPrec [AvoidFloats a]
forall a. (Ord a, Read a) => ReadPrec (AvoidFloats a)
forall a. (Ord a, Read a) => Int -> ReadS (AvoidFloats a)
forall a. (Ord a, Read a) => ReadS [AvoidFloats a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AvoidFloats a]
$creadListPrec :: forall a. (Ord a, Read a) => ReadPrec [AvoidFloats a]
readPrec :: ReadPrec (AvoidFloats a)
$creadPrec :: forall a. (Ord a, Read a) => ReadPrec (AvoidFloats a)
readList :: ReadS [AvoidFloats a]
$creadList :: forall a. (Ord a, Read a) => ReadS [AvoidFloats a]
readsPrec :: Int -> ReadS (AvoidFloats a)
$creadsPrec :: forall a. (Ord a, Read a) => Int -> ReadS (AvoidFloats a)
Read, Int -> AvoidFloats a -> ShowS
forall a. Show a => Int -> AvoidFloats a -> ShowS
forall a. Show a => [AvoidFloats a] -> ShowS
forall a. Show a => AvoidFloats a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AvoidFloats a] -> ShowS
$cshowList :: forall a. Show a => [AvoidFloats a] -> ShowS
show :: AvoidFloats a -> String
$cshow :: forall a. Show a => AvoidFloats a -> String
showsPrec :: Int -> AvoidFloats a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> AvoidFloats a -> ShowS
Show)
data AvoidFloatMsg
= AvoidFloatToggle
| AvoidFloatSet Bool
| AvoidFloatClearItems
data AvoidFloatItemMsg a
= AvoidFloatAddItem a
| AvoidFloatRemoveItem a
| AvoidFloatToggleItem a
instance Message AvoidFloatMsg
instance Typeable a => Message (AvoidFloatItemMsg a)
instance LayoutModifier AvoidFloats Window where
modifyLayoutWithUpdate :: forall (l :: * -> *).
LayoutClass l Window =>
AvoidFloats Window
-> Workspace String (l Window) Window
-> Rectangle
-> X (([(Window, Rectangle)], Maybe (l Window)),
Maybe (AvoidFloats Window))
modifyLayoutWithUpdate AvoidFloats Window
lm Workspace String (l Window) Window
w Rectangle
r = forall a. (Display -> X a) -> X a
withDisplay forall a b. (a -> b) -> a -> b
$ \Display
d -> do
Map Window RationalRect
floating <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a b. (a -> b) -> a -> b
$ forall i l a sid sd. StackSet i l a sid sd -> Map a RationalRect
W.floating forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset
case forall a.
AvoidFloats a -> Maybe ((Map a RationalRect, Rectangle), Rectangle)
cache AvoidFloats Window
lm of
Just ((Map Window RationalRect, Rectangle)
key, Rectangle
mer) | (Map Window RationalRect, Rectangle)
key forall a. Eq a => a -> a -> Bool
== (Map Window RationalRect
floating,Rectangle
r) -> (, forall a. Maybe a
Nothing) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (layout :: * -> *) a.
LayoutClass layout a =>
Workspace String (layout a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
runLayout Workspace String (l Window) Window
w Rectangle
mer
Maybe ((Map Window RationalRect, Rectangle), Rectangle)
_ -> do [Rectangle]
rs <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map WindowAttributes -> Rectangle
toRect forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Display -> Window -> IO WindowAttributes
getWindowAttributes Display
d) (forall a. (a -> Bool) -> [a] -> [a]
filter Window -> Bool
shouldAvoid forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [k]
M.keys Map Window RationalRect
floating)
let mer :: Rectangle
mer = forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy (forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing Rectangle -> Int
area) forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter Rectangle -> Bool
bigEnough forall a b. (a -> b) -> a -> b
$ Rectangle -> [Rectangle] -> [Rectangle]
maxEmptyRectangles Rectangle
r [Rectangle]
rs
(, forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ AvoidFloats Window -> AvoidFloats Window
pruneWindows forall a b. (a -> b) -> a -> b
$ AvoidFloats Window
lm { cache :: Maybe ((Map Window RationalRect, Rectangle), Rectangle)
cache = forall a. a -> Maybe a
Just ((Map Window RationalRect
floating,Rectangle
r),Rectangle
mer) }) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (layout :: * -> *) a.
LayoutClass layout a =>
Workspace String (layout a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
runLayout Workspace String (l Window) Window
w Rectangle
mer
where
toRect :: WindowAttributes -> Rectangle
toRect :: WindowAttributes -> Rectangle
toRect WindowAttributes
wa = let b :: CInt
b = forall a b. (Integral a, Num b) => a -> b
fi forall a b. (a -> b) -> a -> b
$ WindowAttributes -> CInt
wa_border_width WindowAttributes
wa
in Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle (forall a b. (Integral a, Num b) => a -> b
fi forall a b. (a -> b) -> a -> b
$ WindowAttributes -> CInt
wa_x WindowAttributes
wa) (forall a b. (Integral a, Num b) => a -> b
fi forall a b. (a -> b) -> a -> b
$ WindowAttributes -> CInt
wa_y WindowAttributes
wa) (forall a b. (Integral a, Num b) => a -> b
fi forall a b. (a -> b) -> a -> b
$ WindowAttributes -> CInt
wa_width WindowAttributes
wa forall a. Num a => a -> a -> a
+ CInt
2forall a. Num a => a -> a -> a
*CInt
b) (forall a b. (Integral a, Num b) => a -> b
fi forall a b. (a -> b) -> a -> b
$ WindowAttributes -> CInt
wa_height WindowAttributes
wa forall a. Num a => a -> a -> a
+ CInt
2forall a. Num a => a -> a -> a
*CInt
b)
bigEnough :: Rectangle -> Bool
bigEnough :: Rectangle -> Bool
bigEnough Rectangle
rect = Rectangle -> Dimension
rect_width Rectangle
rect forall a. Ord a => a -> a -> Bool
>= forall a b. (Integral a, Num b) => a -> b
fi (forall a. AvoidFloats a -> Int
minw AvoidFloats Window
lm) Bool -> Bool -> Bool
&& Rectangle -> Dimension
rect_height Rectangle
rect forall a. Ord a => a -> a -> Bool
>= forall a b. (Integral a, Num b) => a -> b
fi (forall a. AvoidFloats a -> Int
minh AvoidFloats Window
lm)
shouldAvoid :: Window -> Bool
shouldAvoid Window
a = forall a. AvoidFloats a -> Bool
avoidAll AvoidFloats Window
lm Bool -> Bool -> Bool
|| Window
a forall a. Ord a => a -> Set a -> Bool
`S.member` forall a. AvoidFloats a -> Set a
chosen AvoidFloats Window
lm
pureMess :: AvoidFloats Window -> SomeMessage -> Maybe (AvoidFloats Window)
pureMess AvoidFloats Window
lm SomeMessage
m
| Just AvoidFloatMsg
AvoidFloatToggle <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ AvoidFloats Window
lm { avoidAll :: Bool
avoidAll = Bool -> Bool
not (forall a. AvoidFloats a -> Bool
avoidAll AvoidFloats Window
lm), cache :: Maybe ((Map Window RationalRect, Rectangle), Rectangle)
cache = forall a. Maybe a
Nothing }
| Just (AvoidFloatSet Bool
s) <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m, Bool
s forall a. Eq a => a -> a -> Bool
/= forall a. AvoidFloats a -> Bool
avoidAll AvoidFloats Window
lm = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ AvoidFloats Window
lm { avoidAll :: Bool
avoidAll = Bool
s, cache :: Maybe ((Map Window RationalRect, Rectangle), Rectangle)
cache = forall a. Maybe a
Nothing }
| Just AvoidFloatMsg
AvoidFloatClearItems <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ AvoidFloats Window
lm { chosen :: Set Window
chosen = forall a. Set a
S.empty, cache :: Maybe ((Map Window RationalRect, Rectangle), Rectangle)
cache = forall a. Maybe a
Nothing }
| Just (AvoidFloatAddItem Window
a) <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m, Window
a forall a. Ord a => a -> Set a -> Bool
`S.notMember` forall a. AvoidFloats a -> Set a
chosen AvoidFloats Window
lm = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ AvoidFloats Window
lm { chosen :: Set Window
chosen = forall a. Ord a => a -> Set a -> Set a
S.insert Window
a (forall a. AvoidFloats a -> Set a
chosen AvoidFloats Window
lm), cache :: Maybe ((Map Window RationalRect, Rectangle), Rectangle)
cache = forall a. Maybe a
Nothing }
| Just (AvoidFloatRemoveItem Window
a) <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m, Window
a forall a. Ord a => a -> Set a -> Bool
`S.member` forall a. AvoidFloats a -> Set a
chosen AvoidFloats Window
lm = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ AvoidFloats Window
lm { chosen :: Set Window
chosen = forall a. Ord a => a -> Set a -> Set a
S.delete Window
a (forall a. AvoidFloats a -> Set a
chosen AvoidFloats Window
lm), cache :: Maybe ((Map Window RationalRect, Rectangle), Rectangle)
cache = forall a. Maybe a
Nothing }
| Just (AvoidFloatToggleItem Window
a) <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = let op :: Window -> Set Window -> Set Window
op = if Window
a forall a. Ord a => a -> Set a -> Bool
`S.member` forall a. AvoidFloats a -> Set a
chosen AvoidFloats Window
lm then forall a. Ord a => a -> Set a -> Set a
S.delete else forall a. Ord a => a -> Set a -> Set a
S.insert
in forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ AvoidFloats Window
lm { chosen :: Set Window
chosen = Window -> Set Window -> Set Window
op Window
a (forall a. AvoidFloats a -> Set a
chosen AvoidFloats Window
lm), cache :: Maybe ((Map Window RationalRect, Rectangle), Rectangle)
cache = forall a. Maybe a
Nothing }
| Bool
otherwise = forall a. Maybe a
Nothing
pruneWindows :: AvoidFloats Window -> AvoidFloats Window
pruneWindows :: AvoidFloats Window -> AvoidFloats Window
pruneWindows AvoidFloats Window
lm = case forall a.
AvoidFloats a -> Maybe ((Map a RationalRect, Rectangle), Rectangle)
cache AvoidFloats Window
lm of
Maybe ((Map Window RationalRect, Rectangle), Rectangle)
Nothing -> AvoidFloats Window
lm
Just ((Map Window RationalRect
floating,Rectangle
_),Rectangle
_) -> AvoidFloats Window
lm { chosen :: Set Window
chosen = forall a. (a -> Bool) -> Set a -> Set a
S.filter (forall k a. Ord k => k -> Map k a -> Bool
`M.member` Map Window RationalRect
floating) (forall a. AvoidFloats a -> Set a
chosen AvoidFloats Window
lm) }
maxEmptyRectangles :: Rectangle -> [Rectangle] -> [Rectangle]
maxEmptyRectangles :: Rectangle -> [Rectangle] -> [Rectangle]
maxEmptyRectangles Rectangle
br [Rectangle]
rectangles = forall a. (a -> Bool) -> [a] -> [a]
filter (\Rectangle
a -> Rectangle -> Int
area Rectangle
a forall a. Ord a => a -> a -> Bool
> Int
0) forall a b. (a -> b) -> a -> b
$ [Rectangle]
upAndDownEdge forall a. [a] -> [a] -> [a]
++ [Rectangle]
noneOrUpEdge forall a. [a] -> [a] -> [a]
++ [Rectangle]
downEdge
where
upAndDownEdge :: [Rectangle]
upAndDownEdge = Rectangle -> [Rectangle] -> [Rectangle]
findGaps Rectangle
br [Rectangle]
rectangles
noneOrUpEdge :: [Rectangle]
noneOrUpEdge = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Rectangle -> [Rectangle] -> Rectangle -> [Rectangle]
everyLower Rectangle
br [Rectangle]
bottoms) [Rectangle]
bottoms
downEdge :: [Rectangle]
downEdge = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Rectangle -> [Rectangle] -> Rectangle -> Maybe Rectangle
bottomEdge Rectangle
br [Rectangle]
bottoms) [Rectangle]
bottoms
bottoms :: [Rectangle]
bottoms = forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn Rectangle -> Int
bottom forall a b. (a -> b) -> a -> b
$ [Rectangle] -> [Rectangle]
splitContainers [Rectangle]
rectangles
everyLower :: Rectangle -> [Rectangle] -> Rectangle -> [Rectangle]
everyLower :: Rectangle -> [Rectangle] -> Rectangle -> [Rectangle]
everyLower Rectangle
br [Rectangle]
bottoms Rectangle
r = let ([Rectangle]
rs, Int
boundLeft, Int
boundRight, [Rectangle]
boundRects) = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Rectangle
-> Rectangle
-> ([Rectangle], Int, Int, [Rectangle])
-> ([Rectangle], Int, Int, [Rectangle])
everyUpper Rectangle
r) ([], Rectangle -> Int
left Rectangle
br, Rectangle -> Int
right Rectangle
br, forall a. [a] -> [a]
reverse [Rectangle]
bottoms) [Rectangle]
bottoms
(Int
boundLeft', Int
boundRight', [Rectangle]
_) = Int
-> Int
-> [Rectangle]
-> Rectangle
-> Int
-> (Int, Int, [Rectangle])
shrinkBounds Int
boundLeft Int
boundRight [Rectangle]
boundRects Rectangle
r (Rectangle -> Int
top Rectangle
br)
in Int -> Int -> Int -> Int -> Maybe Rectangle
mkRect Int
boundLeft' Int
boundRight' (Rectangle -> Int
top Rectangle
br) (Rectangle -> Int
top Rectangle
r) forall a. Maybe a -> [a] -> [a]
?: [Rectangle]
rs
everyUpper
:: Rectangle
-> Rectangle
-> ([Rectangle],Int,Int,[Rectangle])
-> ([Rectangle],Int,Int,[Rectangle])
everyUpper :: Rectangle
-> Rectangle
-> ([Rectangle], Int, Int, [Rectangle])
-> ([Rectangle], Int, Int, [Rectangle])
everyUpper Rectangle
lower Rectangle
upper ([Rectangle]
rs, Int
boundLeft, Int
boundRight, [Rectangle]
boundRects) = (Maybe Rectangle
rforall a. Maybe a -> [a] -> [a]
?:[Rectangle]
rs, Int
boundLeft', Int
boundRight', [Rectangle]
boundRects')
where
r :: Maybe Rectangle
r = Int -> Int -> Int -> Int -> Maybe Rectangle
mkRect Int
boundLeft' Int
boundRight' (Rectangle -> Int
bottom Rectangle
upper) (Rectangle -> Int
top Rectangle
lower)
(Int
boundLeft', Int
boundRight', [Rectangle]
boundRects') = Int
-> Int
-> [Rectangle]
-> Rectangle
-> Int
-> (Int, Int, [Rectangle])
shrinkBounds Int
boundLeft Int
boundRight [Rectangle]
boundRects Rectangle
lower (Rectangle -> Int
bottom Rectangle
upper)
shrinkBounds :: Int -> Int -> [Rectangle] -> Rectangle -> Int -> (Int, Int, [Rectangle])
shrinkBounds :: Int
-> Int
-> [Rectangle]
-> Rectangle
-> Int
-> (Int, Int, [Rectangle])
shrinkBounds Int
boundLeft Int
boundRight [Rectangle]
boundRects Rectangle
lower Int
upperLimit = (Int
boundLeft', Int
boundRight', [Rectangle]
boundRects')
where
([Rectangle]
shrinkers, [Rectangle]
boundRects') = forall a. (a -> Bool) -> [a] -> ([a], [a])
span (\Rectangle
a -> Rectangle -> Int
bottom Rectangle
a forall a. Ord a => a -> a -> Bool
> Int
upperLimit) [Rectangle]
boundRects
(Int
boundLeft', Int
boundRight') = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Rectangle -> Rectangle -> (Int, Int) -> (Int, Int)
shrinkBounds' Rectangle
lower) (Int
boundLeft, Int
boundRight) forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (\Rectangle
a -> Rectangle -> Int
top Rectangle
a forall a. Ord a => a -> a -> Bool
< Rectangle -> Int
top Rectangle
lower) [Rectangle]
shrinkers
shrinkBounds' :: Rectangle -> Rectangle -> (Int, Int) -> (Int, Int)
shrinkBounds' :: Rectangle -> Rectangle -> (Int, Int) -> (Int, Int)
shrinkBounds' Rectangle
mr Rectangle
r (Int
boundLeft, Int
boundRight)
| Rectangle -> Int
right Rectangle
r forall a. Ord a => a -> a -> Bool
< Rectangle -> Int
right Rectangle
mr = (forall a. Ord a => a -> a -> a
max Int
boundLeft forall a b. (a -> b) -> a -> b
$ Rectangle -> Int
right Rectangle
r, Int
boundRight)
| Rectangle -> Int
left Rectangle
r forall a. Ord a => a -> a -> Bool
> Rectangle -> Int
left Rectangle
mr = (Int
boundLeft, forall a. Ord a => a -> a -> a
min Int
boundRight forall a b. (a -> b) -> a -> b
$ Rectangle -> Int
left Rectangle
r)
| Bool
otherwise = (Rectangle -> Int
right Rectangle
r, Rectangle -> Int
left Rectangle
r)
bottomEdge :: Rectangle -> [Rectangle] -> Rectangle -> Maybe Rectangle
bottomEdge :: Rectangle -> [Rectangle] -> Rectangle -> Maybe Rectangle
bottomEdge Rectangle
br [Rectangle]
bottoms Rectangle
r = let rs :: [Rectangle]
rs = forall a. (a -> Bool) -> [a] -> [a]
filter (\Rectangle
a -> Rectangle -> Int
bottom Rectangle
r forall a. Ord a => a -> a -> Bool
< Rectangle -> Int
bottom Rectangle
a Bool -> Bool -> Bool
&& Rectangle -> Int
top Rectangle
a forall a. Ord a => a -> a -> Bool
< Rectangle -> Int
bottom Rectangle
br) [Rectangle]
bottoms
boundLeft :: Int
boundLeft = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall a b. (a -> b) -> a -> b
$ Rectangle -> Int
left Rectangle
br forall a. a -> [a] -> [a]
: forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Ord a => a -> a -> Bool
< Rectangle -> Int
right Rectangle
r) (forall a b. (a -> b) -> [a] -> [b]
map Rectangle -> Int
right [Rectangle]
rs)
boundRight :: Int
boundRight = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum forall a b. (a -> b) -> a -> b
$ Rectangle -> Int
right Rectangle
br forall a. a -> [a] -> [a]
: forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Ord a => a -> a -> Bool
> Rectangle -> Int
left Rectangle
r) (forall a b. (a -> b) -> [a] -> [b]
map Rectangle -> Int
left [Rectangle]
rs)
in if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Rectangle
a -> Rectangle -> Int
left Rectangle
a forall a. Ord a => a -> a -> Bool
<= Rectangle -> Int
left Rectangle
r Bool -> Bool -> Bool
&& Rectangle -> Int
right Rectangle
r forall a. Ord a => a -> a -> Bool
<= Rectangle -> Int
right Rectangle
a) [Rectangle]
rs
then forall a. Maybe a
Nothing
else Int -> Int -> Int -> Int -> Maybe Rectangle
mkRect Int
boundLeft Int
boundRight (Rectangle -> Int
bottom Rectangle
r) (Rectangle -> Int
bottom Rectangle
br)
splitContainers :: [Rectangle] -> [Rectangle]
splitContainers :: [Rectangle] -> [Rectangle]
splitContainers [Rectangle]
rects = [Rectangle] -> [Rectangle] -> [Rectangle]
splitContainers' [] forall a b. (a -> b) -> a -> b
$ forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn Rectangle -> Dimension
rect_width [Rectangle]
rects
where
splitContainers' :: [Rectangle] -> [Rectangle] -> [Rectangle]
splitContainers' :: [Rectangle] -> [Rectangle] -> [Rectangle]
splitContainers' [Rectangle]
res [] = [Rectangle]
res
splitContainers' [Rectangle]
res (Rectangle
r:[Rectangle]
rs) = [Rectangle] -> [Rectangle] -> [Rectangle]
splitContainers' (Rectangle
rforall a. a -> [a] -> [a]
:[Rectangle]
res) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Rectangle -> Rectangle -> [Rectangle]
doSplit Rectangle
r) [Rectangle]
rs
doSplit :: Rectangle -> Rectangle -> [Rectangle]
doSplit :: Rectangle -> Rectangle -> [Rectangle]
doSplit Rectangle
guide Rectangle
r
| Rectangle -> Int
left Rectangle
guide forall a. Ord a => a -> a -> Bool
<= Rectangle -> Int
left Rectangle
r Bool -> Bool -> Bool
|| Rectangle -> Int
right Rectangle
r forall a. Ord a => a -> a -> Bool
<= Rectangle -> Int
right Rectangle
guide = [Rectangle
r]
| Bool
otherwise = let w0 :: Dimension
w0 = forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> Position
rect_x Rectangle
guide forall a. Num a => a -> a -> a
- Rectangle -> Position
rect_x Rectangle
r) forall a. Num a => a -> a -> a
+ (Rectangle -> Dimension
rect_width Rectangle
guide forall a. Integral a => a -> a -> a
`div` Dimension
2)
w1 :: Dimension
w1 = Rectangle -> Dimension
rect_width Rectangle
r forall a. Num a => a -> a -> a
- Dimension
w0
in [ Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle (Rectangle -> Position
rect_x Rectangle
r) (Rectangle -> Position
rect_y Rectangle
r) Dimension
w0 (Rectangle -> Dimension
rect_height Rectangle
r)
, Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle (Rectangle -> Position
rect_x Rectangle
r forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fi Dimension
w0) (Rectangle -> Position
rect_y Rectangle
r) Dimension
w1 (Rectangle -> Dimension
rect_height Rectangle
r)
]
findGaps
:: Rectangle
-> [Rectangle]
-> [Rectangle]
findGaps :: Rectangle -> [Rectangle] -> [Rectangle]
findGaps Rectangle
br [Rectangle]
rs = let ([Rectangle]
gaps,Int
end) = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Rectangle -> ([Rectangle], Int) -> ([Rectangle], Int)
findGaps' ([], Rectangle -> Int
left Rectangle
br) forall a b. (a -> b) -> a -> b
$ forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (forall a. a -> Down a
Down forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rectangle -> Int
left) forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter Rectangle -> Bool
inBounds [Rectangle]
rs
lastgap :: Maybe Rectangle
lastgap = Int -> Int -> Int -> Int -> Maybe Rectangle
mkRect Int
end (Rectangle -> Int
right Rectangle
br) (Rectangle -> Int
top Rectangle
br) (Rectangle -> Int
bottom Rectangle
br)
in Maybe Rectangle
lastgapforall a. Maybe a -> [a] -> [a]
?:[Rectangle]
gaps
where
findGaps' :: Rectangle -> ([Rectangle], Int) -> ([Rectangle], Int)
findGaps' :: Rectangle -> ([Rectangle], Int) -> ([Rectangle], Int)
findGaps' Rectangle
r ([Rectangle]
gaps, Int
end) = let gap :: Maybe Rectangle
gap = Int -> Int -> Int -> Int -> Maybe Rectangle
mkRect Int
end (Rectangle -> Int
left Rectangle
r) (Rectangle -> Int
top Rectangle
br) (Rectangle -> Int
bottom Rectangle
br)
in (Maybe Rectangle
gapforall a. Maybe a -> [a] -> [a]
?:[Rectangle]
gaps, forall a. Ord a => a -> a -> a
max Int
end (Rectangle -> Int
right Rectangle
r))
inBounds :: Rectangle -> Bool
inBounds :: Rectangle -> Bool
inBounds Rectangle
r = Rectangle -> Int
left Rectangle
r forall a. Ord a => a -> a -> Bool
< Rectangle -> Int
right Rectangle
br Bool -> Bool -> Bool
&& Rectangle -> Int
left Rectangle
br forall a. Ord a => a -> a -> Bool
< Rectangle -> Int
right Rectangle
r
(?:) :: Maybe a -> [a] -> [a]
Just a
x ?: :: forall a. Maybe a -> [a] -> [a]
?: [a]
xs = a
xforall a. a -> [a] -> [a]
:[a]
xs
Maybe a
_ ?: [a]
xs = [a]
xs
left, right, top, bottom, area :: Rectangle -> Int
left :: Rectangle -> Int
left Rectangle
r = forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> Position
rect_x Rectangle
r)
right :: Rectangle -> Int
right Rectangle
r = forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> Position
rect_x Rectangle
r) forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> Dimension
rect_width Rectangle
r)
top :: Rectangle -> Int
top Rectangle
r = forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> Position
rect_y Rectangle
r)
bottom :: Rectangle -> Int
bottom Rectangle
r = forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> Position
rect_y Rectangle
r) forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> Dimension
rect_height Rectangle
r)
area :: Rectangle -> Int
area Rectangle
r = forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> Dimension
rect_width Rectangle
r forall a. Num a => a -> a -> a
* Rectangle -> Dimension
rect_height Rectangle
r)
mkRect :: Int -> Int -> Int -> Int -> Maybe Rectangle
mkRect :: Int -> Int -> Int -> Int -> Maybe Rectangle
mkRect Int
l Int
r Int
t Int
b = let rect :: Rectangle
rect = Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle (forall a b. (Integral a, Num b) => a -> b
fi Int
l) (forall a b. (Integral a, Num b) => a -> b
fi Int
t) (forall a b. (Integral a, Num b) => a -> b
fi forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> a
max Int
0 forall a b. (a -> b) -> a -> b
$ Int
rforall a. Num a => a -> a -> a
-Int
l) (forall a b. (Integral a, Num b) => a -> b
fi forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> a
max Int
0 forall a b. (a -> b) -> a -> b
$ Int
bforall a. Num a => a -> a -> a
-Int
t)
in if Rectangle -> Int
area Rectangle
rect forall a. Ord a => a -> a -> Bool
> Int
0
then forall a. a -> Maybe a
Just Rectangle
rect
else forall a. Maybe a
Nothing