{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses, TupleSections #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Layout.HintedGrid
-- Description :  A layout that puts all windows in a square grid while obeying their size hints.
-- Copyright   :  (c) Lukas Mai
-- License     :  BSD-style (see LICENSE)
--
-- Maintainer  :  <l.mai@web.de>
-- Stability   :  unstable
-- Portability :  unportable
--
-- A not so simple layout that attempts to put all windows in a square grid
-- while obeying their size hints.
--
-----------------------------------------------------------------------------

module XMonad.Layout.HintedGrid (
    -- * Usage
    -- $usage
    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
. :: forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
(.) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap

-- $usage
-- You can use this module with the following in your @xmonad.hs@:
--
-- > import XMonad.Layout.HintedGrid
--
-- Then edit your @layoutHook@ by adding the 'Grid' layout:
--
-- > myLayout = Grid False ||| Full ||| etc..
-- > main = xmonad def { layoutHook = myLayout }
--
-- You can also specify an aspect ratio for Grid to strive for with the
-- GridRatio constructor:
--
-- > myLayout = GridRatio (4/3) False ||| etc.
--
-- For more detailed instructions on editing the layoutHook see
-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial> and
-- "XMonad.Doc.Extending#Editing_the_layout_hook".

-- | Automatic mirroring of hinted layouts doesn't work very well, so this
-- 'Grid' comes with built-in mirroring. @Grid False@ is the normal layout,
-- @Grid True@ is the mirrored variant (rotated by 90 degrees).
data Grid a = Grid Bool | GridRatio Double Bool deriving (ReadPrec [Grid a]
ReadPrec (Grid a)
ReadS [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
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
16forall 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 = forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a
-> Rectangle -> Stack a -> X ([(a, Rectangle)], Maybe (layout a))
doLayout (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 = (, forall a. Maybe a
Nothing) 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 (forall a. Stack a -> [a]
integrate Stack Window
w)

replicateS :: Int -> (a -> (b, a)) -> a -> ([b], a)
replicateS :: forall a b. Int -> (a -> (b, a)) -> a -> ([b], a)
replicateS Int
n a -> (b, a)
f = forall s a. State s a -> s -> (a, s)
runState forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
. forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n forall a b. (a -> b) -> a -> b
$ do (b
a,a
s) <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets a -> (b, a)
f; forall s (m :: * -> *). MonadState s m => s -> m ()
put a
s; forall (m :: * -> *) a. Monad m => a -> m a
return b
a

doColumn :: Dimension -> Dimension -> Dimension -> [D -> D] -> [D]
doColumn :: Dimension
-> Dimension
-> Dimension
-> [(Dimension, Dimension) -> (Dimension, Dimension)]
-> [(Dimension, Dimension)]
doColumn Dimension
width Dimension
height Dimension
k [(Dimension, Dimension) -> (Dimension, Dimension)]
adjs =
    let
        ([Int]
ind, [(Dimension, Dimension) -> (Dimension, Dimension)]
fs) = forall a b. [(a, b)] -> ([a], [b])
unzip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
. forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
. (forall a b. (a -> b) -> a -> b
$ (Dimension
width, Dimension
height)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
. forall a b. (a, b) -> b
snd) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
. forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 :: Int ..] forall a b. (a -> b) -> a -> b
$ [(Dimension, Dimension) -> (Dimension, Dimension)]
adjs
        (Dimension
_, [(Dimension, Dimension)]
ds) = forall {t} {a}.
Integral t =>
t -> t -> [(Dimension, t) -> (a, t)] -> (t, [(a, t)])
doC Dimension
height Dimension
k [(Dimension, Dimension) -> (Dimension, Dimension)]
fs
    in
    forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
. forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing forall a b. (a, b) -> a
fst) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
. forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
ind forall a b. (a -> b) -> a -> b
$ [(Dimension, Dimension)]
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 forall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
. t -> t -> [(Dimension, t) -> (a, t)] -> (t, [(a, t)])
doC (t
h forall a. Num a => a -> a -> a
- t
h') (t
n 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 forall a. Integral a => a -> a -> a
`div` t
n)

doRect :: Dimension -> Dimension -> Dimension -> [[D -> D]] -> [Rectangle]
doRect :: Dimension
-> Dimension
-> Dimension
-> [[(Dimension, Dimension) -> (Dimension, Dimension)]]
-> [Rectangle]
doRect Dimension
height = Dimension
-> Dimension
-> [[(Dimension, Dimension) -> (Dimension, Dimension)]]
-> [Rectangle]
doR
    where
    doR :: Dimension
-> Dimension
-> [[(Dimension, Dimension) -> (Dimension, Dimension)]]
-> [Rectangle]
doR Dimension
_ Dimension
_ [] = []
    doR Dimension
width Dimension
n ([(Dimension, Dimension) -> (Dimension, Dimension)]
c : [[(Dimension, Dimension) -> (Dimension, Dimension)]]
cs) =
        let
            v :: Dimension
v = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Dimension, Dimension) -> (Dimension, Dimension)]
c
            c' :: [(Dimension, Dimension)]
c' = Dimension
-> Dimension
-> Dimension
-> [(Dimension, Dimension) -> (Dimension, Dimension)]
-> [(Dimension, Dimension)]
doColumn (Dimension
width forall a. Integral a => a -> a -> a
`div` Dimension
n) Dimension
height Dimension
v [(Dimension, Dimension) -> (Dimension, Dimension)]
c
            ([Dimension]
ws, [Dimension]
hs) = forall a b. [(a, b)] -> ([a], [b])
unzip [(Dimension, Dimension)]
c'
            maxw :: Dimension
maxw = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Dimension]
ws
            height' :: Dimension
height' = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Dimension]
hs
            hbonus :: Dimension
hbonus = Dimension
height forall a. Num a => a -> a -> a
- Dimension
height'
            hsingle :: Dimension
hsingle = Dimension
hbonus forall a. Integral a => a -> a -> a
`div` Dimension
v
            hoffset :: Dimension
hoffset = Dimension
hsingle forall a. Integral a => a -> a -> a
`div` Dimension
2
            width' :: Dimension
width' = Dimension
width forall a. Num a => a -> a -> a
- Dimension
maxw
            ys :: [Dimension]
ys = forall a b. (a -> b) -> [a] -> [b]
map ((Dimension
height forall a. Num a => a -> a -> a
-) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
. forall a. Num a => a -> a -> a
subtract Dimension
hoffset) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
. forall a. (a -> a -> a) -> [a] -> [a]
scanl1 forall a. Num a => a -> a -> a
(+) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
. forall a b. (a -> b) -> [a] -> [b]
map (Dimension
hsingle forall a. Num a => a -> a -> a
+) forall a b. (a -> b) -> a -> b
$ [Dimension]
hs
            xs :: [Dimension]
xs = forall a b. (a -> b) -> [a] -> [b]
map ((Dimension
width' forall a. Num a => a -> a -> a
+) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
. (forall a. Integral a => a -> a -> a
`div` Dimension
2) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
. (Dimension
maxw forall a. Num a => a -> a -> a
-)) [Dimension]
ws
        in
        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 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
x) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
y) Dimension
w Dimension
h) [Dimension]
xs [Dimension]
ys [(Dimension, Dimension)]
c' forall a. [a] -> [a] -> [a]
++ Dimension
-> Dimension
-> [[(Dimension, Dimension) -> (Dimension, Dimension)]]
-> [Rectangle]
doR Dimension
width' (Dimension
n forall a. Num a => a -> a -> a
- Dimension
1) [[(Dimension, Dimension) -> (Dimension, Dimension)]]
cs

-- | The internal function for computing the grid layout.
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
    [(Dimension, Dimension) -> (Dimension, Dimension)]
proto <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Window -> X ((Dimension, Dimension) -> (Dimension, Dimension))
mkAdjust [Window]
wins
    let
        adjs :: [(Dimension, Dimension) -> (Dimension, Dimension)]
adjs = forall a b. (a -> b) -> [a] -> [b]
map (\(Dimension, Dimension) -> (Dimension, Dimension)
f -> forall {a}. (a, a) -> (a, a)
twist forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
. (Dimension, Dimension) -> (Dimension, Dimension)
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
. forall {a}. (a, a) -> (a, a)
twist) [(Dimension, Dimension) -> (Dimension, Dimension)]
proto
        rs :: [Rectangle]
rs = Double
-> (Dimension, Dimension)
-> [(Dimension, Dimension) -> (Dimension, Dimension)]
-> [Rectangle]
arrange' Double
aspectRatio (forall {a}. (a, a) -> (a, a)
twist (Dimension
rw, Dimension
rh)) [(Dimension, Dimension) -> (Dimension, Dimension)]
adjs
        rs' :: [Rectangle]
rs' = forall a b. (a -> b) -> [a] -> [b]
map (\(Rectangle Position
x Position
y Dimension
w Dimension
h) -> forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle (forall {a}. (a, a) -> (a, a)
twist (Position
x, Position
y))) (forall {a}. (a, a) -> (a, a)
twist (Dimension
w, Dimension
h))) [Rectangle]
rs
    forall (m :: * -> *) a. Monad m => a -> m a
return forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
. forall a b. [a] -> [b] -> [(a, b)]
zip [Window]
wins forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
. forall a b. (a -> b) -> [a] -> [b]
map (\Rectangle
r -> Rectangle
r{ rect_x :: Position
rect_x = Rectangle -> Position
rect_x Rectangle
r forall a. Num a => a -> a -> a
+ Position
rx, rect_y :: Position
rect_y = Rectangle -> Position
rect_y Rectangle
r forall a. Num a => a -> a -> a
+ Position
ry }) 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 = forall a. a -> a
id

arrange' :: Double -> D -> [D -> D] -> [Rectangle]
arrange' :: Double
-> (Dimension, Dimension)
-> [(Dimension, Dimension) -> (Dimension, Dimension)]
-> [Rectangle]
arrange' Double
aspectRatio (Dimension
rw, Dimension
rh) [(Dimension, Dimension) -> (Dimension, Dimension)]
adjs = forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ Dimension
-> Dimension
-> Dimension
-> [[(Dimension, Dimension) -> (Dimension, Dimension)]]
-> [Rectangle]
doRect Dimension
rh Dimension
rw (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ncolumns) ([[(Dimension, Dimension) -> (Dimension, Dimension)]]
ecols forall a. [a] -> [a] -> [a]
++ [[(Dimension, Dimension) -> (Dimension, Dimension)]]
cols)
    where
    nwindows :: Int
nwindows = forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Dimension, Dimension) -> (Dimension, Dimension)]
adjs
    ncolumns :: Int
ncolumns = forall a. Ord a => a -> a -> a
max Int
1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
. forall a b. (RealFrac a, Integral b) => a -> b
round forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
. forall a. Floating a => a -> a
sqrt forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nwindows forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
rw forall a. Fractional a => a -> a -> a
/ (forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
rh forall a. Num a => a -> a -> a
* Double
aspectRatio)
    nrows :: Int
nrows = Int
nwindows forall a. Integral a => a -> a -> a
`div` Int
ncolumns
    nextras :: Int
nextras = Int
nwindows forall a. Num a => a -> a -> a
- Int
ncolumns forall a. Num a => a -> a -> a
* Int
nrows
    ([[(Dimension, Dimension) -> (Dimension, Dimension)]]
ecols, [(Dimension, Dimension) -> (Dimension, Dimension)]
adjs') = forall a b. Int -> (a -> (b, a)) -> a -> ([b], a)
replicateS Int
nextras (forall a. Int -> [a] -> ([a], [a])
splitAt (Int
nrows forall a. Num a => a -> a -> a
+ Int
1)) forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse [(Dimension, Dimension) -> (Dimension, Dimension)]
adjs
    ([[(Dimension, Dimension) -> (Dimension, Dimension)]]
cols, [(Dimension, Dimension) -> (Dimension, Dimension)]
_) = forall a b. Int -> (a -> (b, a)) -> a -> ([b], a)
replicateS (Int
ncolumns forall a. Num a => a -> a -> a
- Int
nextras) (forall a. Int -> [a] -> ([a], [a])
splitAt Int
nrows) [(Dimension, Dimension) -> (Dimension, Dimension)]
adjs'