{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses, TupleSections #-}
module XMonad.Layout.HintedGrid (
Grid(..), arrange, defaultRatio
) where
import Prelude hiding ((.))
import XMonad
import XMonad.Prelude (replicateM, sortBy, sortOn)
import XMonad.StackSet
import Control.Monad.State (runState)
import Data.Ord
infixr 9 .
(.) :: (Functor f) => (a -> b) -> f a -> f b
. :: (a -> b) -> f a -> f b
(.) = (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
data Grid a = Grid Bool | GridRatio Double Bool deriving (ReadPrec [Grid a]
ReadPrec (Grid a)
Int -> ReadS (Grid a)
ReadS [Grid a]
(Int -> ReadS (Grid a))
-> ReadS [Grid a]
-> ReadPrec (Grid a)
-> ReadPrec [Grid a]
-> Read (Grid a)
forall a. ReadPrec [Grid a]
forall a. ReadPrec (Grid a)
forall a. Int -> ReadS (Grid a)
forall a. ReadS [Grid a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Grid a]
$creadListPrec :: forall a. ReadPrec [Grid a]
readPrec :: ReadPrec (Grid a)
$creadPrec :: forall a. ReadPrec (Grid a)
readList :: ReadS [Grid a]
$creadList :: forall a. ReadS [Grid a]
readsPrec :: Int -> ReadS (Grid a)
$creadsPrec :: forall a. Int -> ReadS (Grid a)
Read, Int -> Grid a -> ShowS
[Grid a] -> ShowS
Grid a -> String
(Int -> Grid a -> ShowS)
-> (Grid a -> String) -> ([Grid a] -> ShowS) -> Show (Grid a)
forall a. Int -> Grid a -> ShowS
forall a. [Grid a] -> ShowS
forall a. Grid a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Grid a] -> ShowS
$cshowList :: forall a. [Grid a] -> ShowS
show :: Grid a -> String
$cshow :: forall a. Grid a -> String
showsPrec :: Int -> Grid a -> ShowS
$cshowsPrec :: forall a. Int -> Grid a -> ShowS
Show)
defaultRatio :: Double
defaultRatio :: Double
defaultRatio = Double
16Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
9
instance LayoutClass Grid Window where
doLayout :: Grid Window
-> Rectangle
-> Stack Window
-> X ([(Window, Rectangle)], Maybe (Grid Window))
doLayout (Grid Bool
m) Rectangle
r Stack Window
w = Grid Window
-> Rectangle
-> Stack Window
-> X ([(Window, Rectangle)], Maybe (Grid Window))
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a
-> Rectangle -> Stack a -> X ([(a, Rectangle)], Maybe (layout a))
doLayout (Double -> Bool -> Grid Window
forall a. Double -> Bool -> Grid a
GridRatio Double
defaultRatio Bool
m) Rectangle
r Stack Window
w
doLayout (GridRatio Double
d Bool
m) Rectangle
r Stack Window
w = (, Maybe (Grid Window)
forall a. Maybe a
Nothing) ([(Window, Rectangle)]
-> ([(Window, Rectangle)], Maybe (Grid Window)))
-> X [(Window, Rectangle)]
-> X ([(Window, Rectangle)], Maybe (Grid Window))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
. Double -> Bool -> Rectangle -> [Window] -> X [(Window, Rectangle)]
arrange Double
d Bool
m Rectangle
r (Stack Window -> [Window]
forall a. Stack a -> [a]
integrate Stack Window
w)
replicateS :: Int -> (a -> (b, a)) -> a -> ([b], a)
replicateS :: Int -> (a -> (b, a)) -> a -> ([b], a)
replicateS Int
n a -> (b, a)
f = State a [b] -> a -> ([b], a)
forall s a. State s a -> s -> (a, s)
runState (State a [b] -> a -> ([b], a))
-> (StateT a Identity b -> State a [b])
-> StateT a Identity b
-> a
-> ([b], a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
. Int -> StateT a Identity b -> State a [b]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n (StateT a Identity b -> a -> ([b], a))
-> StateT a Identity b -> a -> ([b], a)
forall a b. (a -> b) -> a -> b
$ do (b
a,a
s) <- (a -> (b, a)) -> StateT a Identity (b, a)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets a -> (b, a)
f; a -> StateT a Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put a
s; b -> StateT a Identity b
forall (m :: * -> *) a. Monad m => a -> m a
return b
a
doColumn :: Dimension -> Dimension -> Dimension -> [D -> D] -> [D]
doColumn :: Dimension -> Dimension -> Dimension -> [D -> D] -> [D]
doColumn Dimension
width Dimension
height Dimension
k [D -> D]
adjs =
let
([Int]
ind, [D -> D]
fs) = [(Int, D -> D)] -> ([Int], [D -> D])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(Int, D -> D)] -> ([Int], [D -> D]))
-> ([D -> D] -> [(Int, D -> D)]) -> [D -> D] -> ([Int], [D -> D])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
. ((Int, D -> D) -> Dimension) -> [(Int, D -> D)] -> [(Int, D -> D)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (D -> Dimension
forall a b. (a, b) -> b
snd (D -> Dimension)
-> ((Int, D -> D) -> D) -> (Int, D -> D) -> Dimension
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
. ((D -> D) -> D -> D
forall a b. (a -> b) -> a -> b
$ (Dimension
width, Dimension
height)) ((D -> D) -> D) -> ((Int, D -> D) -> D -> D) -> (Int, D -> D) -> D
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
. (Int, D -> D) -> D -> D
forall a b. (a, b) -> b
snd) ([(Int, D -> D)] -> [(Int, D -> D)])
-> ([D -> D] -> [(Int, D -> D)]) -> [D -> D] -> [(Int, D -> D)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
. [Int] -> [D -> D] -> [(Int, D -> D)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 :: Int ..] ([D -> D] -> ([Int], [D -> D])) -> [D -> D] -> ([Int], [D -> D])
forall a b. (a -> b) -> a -> b
$ [D -> D]
adjs
(Dimension
_, [D]
ds) = Dimension -> Dimension -> [D -> D] -> (Dimension, [D])
forall t a.
Integral t =>
t -> t -> [(Dimension, t) -> (a, t)] -> (t, [(a, t)])
doC Dimension
height Dimension
k [D -> D]
fs
in
((Int, D) -> D) -> [(Int, D)] -> [D]
forall a b. (a -> b) -> [a] -> [b]
map (Int, D) -> D
forall a b. (a, b) -> b
snd ([(Int, D)] -> [D]) -> ([D] -> [(Int, D)]) -> [D] -> [D]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
. ((Int, D) -> (Int, D) -> Ordering) -> [(Int, D)] -> [(Int, D)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((Int, D) -> Int) -> (Int, D) -> (Int, D) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Int, D) -> Int
forall a b. (a, b) -> a
fst) ([(Int, D)] -> [(Int, D)])
-> ([D] -> [(Int, D)]) -> [D] -> [(Int, D)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
. [Int] -> [D] -> [(Int, D)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
ind ([D] -> [D]) -> [D] -> [D]
forall a b. (a -> b) -> a -> b
$ [D]
ds
where
doC :: t -> t -> [(Dimension, t) -> (a, t)] -> (t, [(a, t)])
doC t
h t
_ [] = (t
h, [])
doC t
h t
n ((Dimension, t) -> (a, t)
f : [(Dimension, t) -> (a, t)]
fs) = ((a, t)
adj (a, t) -> [(a, t)] -> [(a, t)]
forall a. a -> [a] -> [a]
:) ([(a, t)] -> [(a, t)]) -> (t, [(a, t)]) -> (t, [(a, t)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
. t -> t -> [(Dimension, t) -> (a, t)] -> (t, [(a, t)])
doC (t
h t -> t -> t
forall a. Num a => a -> a -> a
- t
h') (t
n t -> t -> t
forall a. Num a => a -> a -> a
- t
1) [(Dimension, t) -> (a, t)]
fs
where
adj :: (a, t)
adj@(a
_, t
h') = (Dimension, t) -> (a, t)
f (Dimension
width, t
h t -> t -> t
forall a. Integral a => a -> a -> a
`div` t
n)
doRect :: Dimension -> Dimension -> Dimension -> [[D -> D]] -> [Rectangle]
doRect :: Dimension -> Dimension -> Dimension -> [[D -> D]] -> [Rectangle]
doRect Dimension
height = Dimension -> Dimension -> [[D -> D]] -> [Rectangle]
doR
where
doR :: Dimension -> Dimension -> [[D -> D]] -> [Rectangle]
doR Dimension
_ Dimension
_ [] = []
doR Dimension
width Dimension
n ([D -> D]
c : [[D -> D]]
cs) =
let
v :: Dimension
v = Int -> Dimension
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Dimension) -> Int -> Dimension
forall a b. (a -> b) -> a -> b
$ [D -> D] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [D -> D]
c
c' :: [D]
c' = Dimension -> Dimension -> Dimension -> [D -> D] -> [D]
doColumn (Dimension
width Dimension -> Dimension -> Dimension
forall a. Integral a => a -> a -> a
`div` Dimension
n) Dimension
height Dimension
v [D -> D]
c
([Dimension]
ws, [Dimension]
hs) = [D] -> ([Dimension], [Dimension])
forall a b. [(a, b)] -> ([a], [b])
unzip [D]
c'
maxw :: Dimension
maxw = [Dimension] -> Dimension
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Dimension]
ws
height' :: Dimension
height' = [Dimension] -> Dimension
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Dimension]
hs
hbonus :: Dimension
hbonus = Dimension
height Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
- Dimension
height'
hsingle :: Dimension
hsingle = Dimension
hbonus Dimension -> Dimension -> Dimension
forall a. Integral a => a -> a -> a
`div` Dimension
v
hoffset :: Dimension
hoffset = Dimension
hsingle Dimension -> Dimension -> Dimension
forall a. Integral a => a -> a -> a
`div` Dimension
2
width' :: Dimension
width' = Dimension
width Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
- Dimension
maxw
ys :: [Dimension]
ys = (Dimension -> Dimension) -> [Dimension] -> [Dimension]
forall a b. (a -> b) -> [a] -> [b]
map ((Dimension
height Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
-) (Dimension -> Dimension)
-> (Dimension -> Dimension) -> Dimension -> Dimension
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
. Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
subtract Dimension
hoffset) ([Dimension] -> [Dimension])
-> ([Dimension] -> [Dimension]) -> [Dimension] -> [Dimension]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
. (Dimension -> Dimension -> Dimension) -> [Dimension] -> [Dimension]
forall a. (a -> a -> a) -> [a] -> [a]
scanl1 Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
(+) ([Dimension] -> [Dimension])
-> ([Dimension] -> [Dimension]) -> [Dimension] -> [Dimension]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
. (Dimension -> Dimension) -> [Dimension] -> [Dimension]
forall a b. (a -> b) -> [a] -> [b]
map (Dimension
hsingle Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
+) ([Dimension] -> [Dimension]) -> [Dimension] -> [Dimension]
forall a b. (a -> b) -> a -> b
$ [Dimension]
hs
xs :: [Dimension]
xs = (Dimension -> Dimension) -> [Dimension] -> [Dimension]
forall a b. (a -> b) -> [a] -> [b]
map ((Dimension
width' Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
+) (Dimension -> Dimension)
-> (Dimension -> Dimension) -> Dimension -> Dimension
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
. (Dimension -> Dimension -> Dimension
forall a. Integral a => a -> a -> a
`div` Dimension
2) (Dimension -> Dimension)
-> (Dimension -> Dimension) -> Dimension -> Dimension
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
. (Dimension
maxw Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
-)) [Dimension]
ws
in
(Dimension -> Dimension -> D -> Rectangle)
-> [Dimension] -> [Dimension] -> [D] -> [Rectangle]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 (\Dimension
x Dimension
y (Dimension
w, Dimension
h) -> Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle (Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
x) (Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
y) Dimension
w Dimension
h) [Dimension]
xs [Dimension]
ys [D]
c' [Rectangle] -> [Rectangle] -> [Rectangle]
forall a. [a] -> [a] -> [a]
++ Dimension -> Dimension -> [[D -> D]] -> [Rectangle]
doR Dimension
width' (Dimension
n Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
- Dimension
1) [[D -> D]]
cs
arrange :: Double -> Bool -> Rectangle -> [Window] -> X [(Window, Rectangle)]
arrange :: Double -> Bool -> Rectangle -> [Window] -> X [(Window, Rectangle)]
arrange Double
aspectRatio Bool
mirror (Rectangle Position
rx Position
ry Dimension
rw Dimension
rh) [Window]
wins = do
[D -> D]
proto <- (Window -> X (D -> D)) -> [Window] -> X [D -> D]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Window -> X (D -> D)
mkAdjust [Window]
wins
let
adjs :: [D -> D]
adjs = ((D -> D) -> D -> D) -> [D -> D] -> [D -> D]
forall a b. (a -> b) -> [a] -> [b]
map (\D -> D
f -> D -> D
forall a. (a, a) -> (a, a)
twist (D -> D) -> (D -> D) -> D -> D
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
. D -> D
f (D -> D) -> (D -> D) -> D -> D
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
. D -> D
forall a. (a, a) -> (a, a)
twist) [D -> D]
proto
rs :: [Rectangle]
rs = Double -> D -> [D -> D] -> [Rectangle]
arrange' Double
aspectRatio (D -> D
forall a. (a, a) -> (a, a)
twist (Dimension
rw, Dimension
rh)) [D -> D]
adjs
rs' :: [Rectangle]
rs' = (Rectangle -> Rectangle) -> [Rectangle] -> [Rectangle]
forall a b. (a -> b) -> [a] -> [b]
map (\(Rectangle Position
x Position
y Dimension
w Dimension
h) -> (Dimension -> Dimension -> Rectangle) -> D -> Rectangle
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((Position -> Position -> Dimension -> Dimension -> Rectangle)
-> (Position, Position) -> Dimension -> Dimension -> Rectangle
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle ((Position, Position) -> (Position, Position)
forall a. (a, a) -> (a, a)
twist (Position
x, Position
y))) (D -> D
forall a. (a, a) -> (a, a)
twist (Dimension
w, Dimension
h))) [Rectangle]
rs
[(Window, Rectangle)] -> X [(Window, Rectangle)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Window, Rectangle)] -> X [(Window, Rectangle)])
-> ([Rectangle] -> [(Window, Rectangle)])
-> [Rectangle]
-> X [(Window, Rectangle)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
. [Window] -> [Rectangle] -> [(Window, Rectangle)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Window]
wins ([Rectangle] -> [(Window, Rectangle)])
-> ([Rectangle] -> [Rectangle])
-> [Rectangle]
-> [(Window, Rectangle)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
. (Rectangle -> Rectangle) -> [Rectangle] -> [Rectangle]
forall a b. (a -> b) -> [a] -> [b]
map (\Rectangle
r -> Rectangle
r{ rect_x :: Position
rect_x = Rectangle -> Position
rect_x Rectangle
r Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Position
rx, rect_y :: Position
rect_y = Rectangle -> Position
rect_y Rectangle
r Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Position
ry }) ([Rectangle] -> X [(Window, Rectangle)])
-> [Rectangle] -> X [(Window, Rectangle)]
forall a b. (a -> b) -> a -> b
$ [Rectangle]
rs'
where
twist :: (a, a) -> (a, a)
twist
| Bool
mirror = \(a
a, a
b) -> (a
b, a
a)
| Bool
otherwise = (a, a) -> (a, a)
forall a. a -> a
id
arrange' :: Double -> D -> [D -> D] -> [Rectangle]
arrange' :: Double -> D -> [D -> D] -> [Rectangle]
arrange' Double
aspectRatio (Dimension
rw, Dimension
rh) [D -> D]
adjs = [Rectangle] -> [Rectangle]
forall a. [a] -> [a]
reverse ([Rectangle] -> [Rectangle]) -> [Rectangle] -> [Rectangle]
forall a b. (a -> b) -> a -> b
$ Dimension -> Dimension -> Dimension -> [[D -> D]] -> [Rectangle]
doRect Dimension
rh Dimension
rw (Int -> Dimension
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ncolumns) ([[D -> D]]
ecols [[D -> D]] -> [[D -> D]] -> [[D -> D]]
forall a. [a] -> [a] -> [a]
++ [[D -> D]]
cols)
where
nwindows :: Int
nwindows = [D -> D] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [D -> D]
adjs
ncolumns :: Int
ncolumns = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Int -> Int) -> (Double -> Int) -> Double -> Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
. Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (Double -> Int) -> (Double -> Double) -> Double -> Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
. Double -> Double
forall a. Floating a => a -> a
sqrt (Double -> Int) -> Double -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nwindows Double -> Double -> Double
forall a. Num a => a -> a -> a
* Dimension -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
rw Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Dimension -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
rh Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
aspectRatio)
nrows :: Int
nrows = Int
nwindows Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
ncolumns
nextras :: Int
nextras = Int
nwindows Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ncolumns Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
nrows
([[D -> D]]
ecols, [D -> D]
adjs') = Int
-> ([D -> D] -> ([D -> D], [D -> D]))
-> [D -> D]
-> ([[D -> D]], [D -> D])
forall a b. Int -> (a -> (b, a)) -> a -> ([b], a)
replicateS Int
nextras (Int -> [D -> D] -> ([D -> D], [D -> D])
forall a. Int -> [a] -> ([a], [a])
splitAt (Int
nrows Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)) ([D -> D] -> ([[D -> D]], [D -> D]))
-> [D -> D] -> ([[D -> D]], [D -> D])
forall a b. (a -> b) -> a -> b
$ [D -> D] -> [D -> D]
forall a. [a] -> [a]
reverse [D -> D]
adjs
([[D -> D]]
cols, [D -> D]
_) = Int
-> ([D -> D] -> ([D -> D], [D -> D]))
-> [D -> D]
-> ([[D -> D]], [D -> D])
forall a b. Int -> (a -> (b, a)) -> a -> ([b], a)
replicateS (Int
ncolumns Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
nextras) (Int -> [D -> D] -> ([D -> D], [D -> D])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
nrows) [D -> D]
adjs'