{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}

----------------------------------------------------------------------
-- |
-- Module      : XMonad.Layout.GridVariants
-- Description : Two grid layouts.
-- Copyright   : (c) Norbert Zeh
-- License     : BSD-style (see LICENSE)
--
-- Maintainer  : nzeh@cs.dal.ca
-- Stability   : unstable
-- Portability : unportable
--
-- Two layouts: one is a variant of the Grid layout that allows the
-- desired aspect ratio of windows to be specified.  The other is like
-- Tall but places a grid with fixed number of rows and columns in the
-- master area and uses an aspect-ratio-specified layout for the
-- slaves.
----------------------------------------------------------------------

module XMonad.Layout.GridVariants ( -- * Usage
                                    -- $usage
                                    ChangeMasterGridGeom(..)
                                  , ChangeGridGeom(..)
                                  , Grid(..)
                                  , TallGrid(..)
                                  , SplitGrid(..)
                                  , Orientation(..)
                                  ) where

import XMonad.Prelude
import XMonad
import qualified XMonad.StackSet as W

-- $usage
-- This module can be used as follows:
--
-- > import XMonad.Layout.GridVariants
--
-- Then add something like this to your layouts:
--
-- > Grid (16/10)
--
-- for a 16:10 aspect ratio grid, or
--
-- > SplitGrid L 2 3 (2/3) (16/10) (5/100)
--
-- for a layout with a 2x3 master grid that uses 2/3 of the screen,
-- and a 16:10 aspect ratio slave grid to its right.  The last
-- parameter is again the percentage by which the split between master
-- and slave area changes in response to Expand/Shrink messages.
--
-- To be able to change the geometry of the master grid, add something
-- like this to your keybindings:
--
-- > ((modm .|. shiftMask, xK_equal), sendMessage $ IncMasterCols 1),
-- > ((modm .|. shiftMask, xK_minus), sendMessage $ IncMasterCols (-1)),
-- > ((modm .|. controlMask,  xK_equal), sendMessage $ IncMasterRows 1),
-- > ((modm .|. controlMask,  xK_minus), sendMessage $ IncMasterRows (-1))

-- | Grid layout.  The parameter is the desired x:y aspect ratio of windows
newtype Grid a = Grid Rational
              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)

instance LayoutClass Grid a where

    pureLayout :: Grid a -> Rectangle -> Stack a -> [(a, Rectangle)]
pureLayout (Grid Rational
aspect) Rectangle
rect Stack a
st = forall a b. [a] -> [b] -> [(a, b)]
zip [a]
wins [Rectangle]
rects
        where
          wins :: [a]
wins  = forall a. Stack a -> [a]
W.integrate Stack a
st
          nwins :: Int
nwins = forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
wins
          rects :: [Rectangle]
rects = Rectangle -> Int -> Rational -> [Rectangle]
arrangeAspectGrid Rectangle
rect Int
nwins Rational
aspect

    pureMessage :: Grid a -> SomeMessage -> Maybe (Grid a)
pureMessage Grid a
layout SomeMessage
msg = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Grid a -> ChangeGridGeom -> Grid a
changeGridAspect Grid a
layout) (forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
msg)

    description :: Grid a -> String
description Grid a
_ = String
"Grid"

changeGridAspect :: Grid a -> ChangeGridGeom -> Grid a
changeGridAspect :: forall a. Grid a -> ChangeGridGeom -> Grid a
changeGridAspect (Grid Rational
_) (SetGridAspect Rational
aspect) = forall a. Rational -> Grid a
Grid Rational
aspect
changeGridAspect (Grid Rational
aspect) (ChangeGridAspect Rational
delta) =
    forall a. Rational -> Grid a
Grid (forall a. Ord a => a -> a -> a
max Rational
0.00001 (Rational
aspect forall a. Num a => a -> a -> a
+ Rational
delta))

-- |Geometry change messages understood by Grid and SplitGrid
data ChangeGridGeom
    = SetGridAspect !Rational
    | ChangeGridAspect !Rational

instance Message ChangeGridGeom

-- |SplitGrid layout.  Parameters are
--
--   - side where the master is
--   - number of master rows
--   - number of master columns
--   - portion of screen used for master grid
--   - x:y aspect ratio of slave windows
--   - increment for resize messages
data SplitGrid a = SplitGrid Orientation !Int !Int !Rational !Rational !Rational
                   deriving (ReadPrec [SplitGrid a]
ReadPrec (SplitGrid a)
ReadS [SplitGrid a]
forall a. ReadPrec [SplitGrid a]
forall a. ReadPrec (SplitGrid a)
forall a. Int -> ReadS (SplitGrid a)
forall a. ReadS [SplitGrid a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SplitGrid a]
$creadListPrec :: forall a. ReadPrec [SplitGrid a]
readPrec :: ReadPrec (SplitGrid a)
$creadPrec :: forall a. ReadPrec (SplitGrid a)
readList :: ReadS [SplitGrid a]
$creadList :: forall a. ReadS [SplitGrid a]
readsPrec :: Int -> ReadS (SplitGrid a)
$creadsPrec :: forall a. Int -> ReadS (SplitGrid a)
Read, Int -> SplitGrid a -> ShowS
forall a. Int -> SplitGrid a -> ShowS
forall a. [SplitGrid a] -> ShowS
forall a. SplitGrid a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SplitGrid a] -> ShowS
$cshowList :: forall a. [SplitGrid a] -> ShowS
show :: SplitGrid a -> String
$cshow :: forall a. SplitGrid a -> String
showsPrec :: Int -> SplitGrid a -> ShowS
$cshowsPrec :: forall a. Int -> SplitGrid a -> ShowS
Show)

-- |Type to specify the side of the screen that holds
--  the master area of a SplitGrid.
data Orientation = T | B | L | R
                   deriving (Orientation -> Orientation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Orientation -> Orientation -> Bool
$c/= :: Orientation -> Orientation -> Bool
== :: Orientation -> Orientation -> Bool
$c== :: Orientation -> Orientation -> Bool
Eq, ReadPrec [Orientation]
ReadPrec Orientation
Int -> ReadS Orientation
ReadS [Orientation]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Orientation]
$creadListPrec :: ReadPrec [Orientation]
readPrec :: ReadPrec Orientation
$creadPrec :: ReadPrec Orientation
readList :: ReadS [Orientation]
$creadList :: ReadS [Orientation]
readsPrec :: Int -> ReadS Orientation
$creadsPrec :: Int -> ReadS Orientation
Read, Int -> Orientation -> ShowS
[Orientation] -> ShowS
Orientation -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Orientation] -> ShowS
$cshowList :: [Orientation] -> ShowS
show :: Orientation -> String
$cshow :: Orientation -> String
showsPrec :: Int -> Orientation -> ShowS
$cshowsPrec :: Int -> Orientation -> ShowS
Show)

instance LayoutClass SplitGrid a where

    pureLayout :: SplitGrid a -> Rectangle -> Stack a -> [(a, Rectangle)]
pureLayout (SplitGrid Orientation
o Int
mrows Int
mcols Rational
mfrac Rational
saspect Rational
_) Rectangle
rect Stack a
st = forall a b. [a] -> [b] -> [(a, b)]
zip [a]
wins [Rectangle]
rects
        where
          wins :: [a]
wins  = forall a. Stack a -> [a]
W.integrate Stack a
st
          nwins :: Int
nwins = forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
wins
          rects :: [Rectangle]
rects = Rectangle
-> Orientation
-> Int
-> Int
-> Int
-> Rational
-> Rational
-> [Rectangle]
arrangeSplitGrid Rectangle
rect Orientation
o Int
nwins Int
mrows Int
mcols Rational
mfrac Rational
saspect

    pureMessage :: SplitGrid a -> SomeMessage -> Maybe (SplitGrid a)
pureMessage SplitGrid a
layout SomeMessage
msg =
        forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. SplitGrid a -> Resize -> SplitGrid a
resizeMaster SplitGrid a
layout)          (forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
msg)
             , forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. SplitGrid a -> ChangeMasterGridGeom -> SplitGrid a
changeMasterGrid SplitGrid a
layout)      (forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
msg)
             , forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. SplitGrid a -> ChangeGridGeom -> SplitGrid a
changeSlaveGridAspect SplitGrid a
layout) (forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
msg)
             ]

    description :: SplitGrid a -> String
description SplitGrid a
_ = String
"SplitGrid"

-- |The geometry change message understood by the master grid
data ChangeMasterGridGeom
    = IncMasterRows     !Int      -- ^Change the number of master rows
    | IncMasterCols     !Int      -- ^Change the number of master columns
    | SetMasterRows     !Int      -- ^Set the number of master rows to absolute value
    | SetMasterCols     !Int      -- ^Set the number of master columns to absolute value
    | SetMasterFraction !Rational -- ^Set the fraction of the screen used by the master grid

instance Message ChangeMasterGridGeom

arrangeSplitGrid :: Rectangle -> Orientation -> Int -> Int -> Int -> Rational -> Rational -> [Rectangle]
arrangeSplitGrid :: Rectangle
-> Orientation
-> Int
-> Int
-> Int
-> Rational
-> Rational
-> [Rectangle]
arrangeSplitGrid rect :: Rectangle
rect@(Rectangle Position
rx Position
ry Dimension
rw Dimension
rh) Orientation
o Int
nwins Int
mrows Int
mcols Rational
mfrac Rational
saspect
    | Int
nwins forall a. Ord a => a -> a -> Bool
<= Int
mwins = Rectangle -> Int -> Int -> [Rectangle]
arrangeMasterGrid Rectangle
rect Int
nwins Int
mcols
    | Int
mwins forall a. Eq a => a -> a -> Bool
== Int
0     = Rectangle -> Int -> Rational -> [Rectangle]
arrangeAspectGrid Rectangle
rect Int
nwins Rational
saspect
    | Bool
otherwise      = Rectangle -> Int -> Int -> [Rectangle]
arrangeMasterGrid Rectangle
mrect Int
mwins Int
mcols forall a. [a] -> [a] -> [a]
++
                       Rectangle -> Int -> Rational -> [Rectangle]
arrangeAspectGrid Rectangle
srect Int
swins Rational
saspect
    where
      mwins :: Int
mwins            = Int
mrows forall a. Num a => a -> a -> a
* Int
mcols
      swins :: Int
swins            = Int
nwins forall a. Num a => a -> a -> a
- Int
mwins
      mrect :: Rectangle
mrect            = Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
mx Position
my Dimension
mw Dimension
mh
      srect :: Rectangle
srect            = Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
sx Position
sy Dimension
sw Dimension
sh
      (Dimension
mh, Dimension
sh, Dimension
mw, Dimension
sw) = if Orientation
o forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Orientation
T, Orientation
B] then
                             (forall a b. (RealFrac a, Integral b) => a -> b
ceiling (forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
rh forall a. Num a => a -> a -> a
* Rational
mfrac), Dimension
rh forall a. Num a => a -> a -> a
- Dimension
mh, Dimension
rw, Dimension
rw)
                         else
                             (Dimension
rh, Dimension
rh, forall a b. (RealFrac a, Integral b) => a -> b
ceiling (forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
rw forall a. Num a => a -> a -> a
* Rational
mfrac), Dimension
rw forall a. Num a => a -> a -> a
- Dimension
mw)
      mx :: Position
mx               = forall a b. (Integral a, Num b) => a -> b
fromIntegral Position
rx forall a. Num a => a -> a -> a
+ if Orientation
o forall a. Eq a => a -> a -> Bool
== Orientation
R then forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
sw else Position
0
      my :: Position
my               = forall a b. (Integral a, Num b) => a -> b
fromIntegral Position
ry forall a. Num a => a -> a -> a
+ if Orientation
o forall a. Eq a => a -> a -> Bool
== Orientation
B then forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
sh else Position
0
      sx :: Position
sx               = forall a b. (Integral a, Num b) => a -> b
fromIntegral Position
rx forall a. Num a => a -> a -> a
+ if Orientation
o forall a. Eq a => a -> a -> Bool
== Orientation
L then forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
mw else Position
0
      sy :: Position
sy               = forall a b. (Integral a, Num b) => a -> b
fromIntegral Position
ry forall a. Num a => a -> a -> a
+ if Orientation
o forall a. Eq a => a -> a -> Bool
== Orientation
T then forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
mh else Position
0

arrangeMasterGrid :: Rectangle -> Int -> Int -> [Rectangle]
arrangeMasterGrid :: Rectangle -> Int -> Int -> [Rectangle]
arrangeMasterGrid Rectangle
rect Int
nwins Int
mcols = Rectangle -> Int -> Int -> [Rectangle]
arrangeGrid Rectangle
rect Int
nwins (forall a. Ord a => a -> a -> a
min Int
nwins Int
mcols)

arrangeAspectGrid :: Rectangle -> Int -> Rational -> [Rectangle]
arrangeAspectGrid :: Rectangle -> Int -> Rational -> [Rectangle]
arrangeAspectGrid rect :: Rectangle
rect@(Rectangle Position
_ Position
_ Dimension
rw Dimension
rh) Int
nwins Rational
aspect =
    Rectangle -> Int -> Int -> [Rectangle]
arrangeGrid Rectangle
rect Int
nwins (forall a. Ord a => a -> a -> a
min Int
nwins Int
ncols)
    where
      scr_a :: Rational
scr_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
      fcols :: Double
fcols = forall a. Floating a => a -> a
sqrt ( forall a. Fractional a => Rational -> a
fromRational forall a b. (a -> b) -> a -> b
$ Rational
scr_a forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nwins forall a. Fractional a => a -> a -> a
/ Rational
aspect ) :: Double
      cols1 :: Int
cols1 = forall a b. (RealFrac a, Integral b) => a -> b
floor Double
fcols :: Int
      cols2 :: Int
cols2 = forall a b. (RealFrac a, Integral b) => a -> b
ceiling Double
fcols :: Int
      rows1 :: Int
rows1 = forall a b. (RealFrac a, Integral b) => a -> b
ceiling ( forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nwins forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
cols1 :: Rational ) :: Int
      rows2 :: Int
rows2 = forall a b. (RealFrac a, Integral b) => a -> b
floor ( forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nwins forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
cols2 :: Rational ) :: Int
      a1 :: Rational
a1    = Rational
scr_a forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
rows1 forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
cols1
      a2 :: Rational
a2    = Rational
scr_a forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
rows2 forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
cols2
      ncols :: Int
ncols | Int
cols1 forall a. Eq a => a -> a -> Bool
== Int
0                = Int
cols2
            | Int
rows2 forall a. Eq a => a -> a -> Bool
== Int
0                = Int
cols1
            | Rational
a1 forall a. Fractional a => a -> a -> a
/ Rational
aspect forall a. Ord a => a -> a -> Bool
< Rational
aspect forall a. Fractional a => a -> a -> a
/ Rational
a2 = Int
cols1
            | Bool
otherwise                 = Int
cols2

arrangeGrid :: Rectangle -> Int -> Int -> [Rectangle]
arrangeGrid :: Rectangle -> Int -> Int -> [Rectangle]
arrangeGrid (Rectangle Position
rx Position
ry Dimension
rw Dimension
rh) Int
nwins Int
ncols =
    [Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x forall a. Num a => a -> a -> a
+ Position
rx) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y forall a. Num a => a -> a -> a
+ Position
ry) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h)
     | (Int
x, Int
y, Int
w, Int
h) <- [(Int, Int, Int, Int)]
rects]
    where
      nrows_in_cols :: [Int]
nrows_in_cols = [Int] -> [Int]
listDifference forall a b. (a -> b) -> a -> b
$ Int -> Int -> [Int]
splitEvenly Int
nwins Int
ncols
      x_slabs :: [(Int, Int)]
x_slabs       = Int -> Int -> [(Int, Int)]
splitIntoSlabs (forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
rw) Int
ncols
      y_slabs :: [[(Int, Int)]]
y_slabs       = [Int -> Int -> [(Int, Int)]
splitIntoSlabs (forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
rh) Int
nrows | Int
nrows <- [Int]
nrows_in_cols]
      rects_in_cols :: [[(Int, Int, Int, Int)]]
rects_in_cols = [[(Int
x, Int
y, Int
w, Int
h) | (Int
y, Int
h) <- [(Int, Int)]
lst]
                       | ((Int
x, Int
w), [(Int, Int)]
lst) <- forall a b. [a] -> [b] -> [(a, b)]
zip [(Int, Int)]
x_slabs [[(Int, Int)]]
y_slabs]
      rects :: [(Int, Int, Int, Int)]
rects         = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(Int, Int, Int, Int)]]
rects_in_cols

splitIntoSlabs :: Int -> Int -> [(Int, Int)]
splitIntoSlabs :: Int -> Int -> [(Int, Int)]
splitIntoSlabs Int
width Int
nslabs = forall a b. [a] -> [b] -> [(a, b)]
zip (Int
0forall a. a -> [a] -> [a]
:[Int]
xs) [Int]
widths
    where
      xs :: [Int]
xs = Int -> Int -> [Int]
splitEvenly Int
width Int
nslabs
      widths :: [Int]
widths = [Int] -> [Int]
listDifference [Int]
xs

listDifference :: [Int] -> [Int]
listDifference :: [Int] -> [Int]
listDifference [Int]
lst = [Int
curforall a. Num a => a -> a -> a
-Int
pre | (Int
cur,Int
pre) <- forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
lst (Int
0forall a. a -> [a] -> [a]
:[Int]
lst)]

splitEvenly :: Int -> Int -> [Int]
splitEvenly :: Int -> Int -> [Int]
splitEvenly Int
n Int
parts = [ Int
szforall a. Num a => a -> a -> a
-Int
off | (Int
sz,Int
off) <- forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
sizes [Int]
offsets]
    where
      size :: Int
size    = forall a b. (RealFrac a, Integral b) => a -> b
ceiling ( (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
parts) :: Double )
      extra :: Int
extra   = Int
sizeforall a. Num a => a -> a -> a
*Int
parts forall a. Num a => a -> a -> a
- Int
n
      sizes :: [Int]
sizes   = [Int
iforall a. Num a => a -> a -> a
*Int
size | Int
i <- [Int
1..Int
parts]]
      offsets :: [Int]
offsets = forall a. Int -> [a] -> [a]
take (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
extra) [Int
1..] forall a. [a] -> [a] -> [a]
++ [Int
extra,Int
extra..]

resizeMaster :: SplitGrid a -> Resize -> SplitGrid a
resizeMaster :: forall a. SplitGrid a -> Resize -> SplitGrid a
resizeMaster (SplitGrid Orientation
o Int
mrows Int
mcols Rational
mfrac Rational
saspect Rational
delta) Resize
Shrink =
    forall a.
Orientation
-> Int -> Int -> Rational -> Rational -> Rational -> SplitGrid a
SplitGrid Orientation
o Int
mrows Int
mcols (forall a. Ord a => a -> a -> a
max Rational
0 (Rational
mfrac forall a. Num a => a -> a -> a
- Rational
delta)) Rational
saspect Rational
delta
resizeMaster (SplitGrid Orientation
o Int
mrows Int
mcols Rational
mfrac Rational
saspect Rational
delta) Resize
Expand =
    forall a.
Orientation
-> Int -> Int -> Rational -> Rational -> Rational -> SplitGrid a
SplitGrid Orientation
o Int
mrows Int
mcols (forall a. Ord a => a -> a -> a
min Rational
1 (Rational
mfrac forall a. Num a => a -> a -> a
+ Rational
delta)) Rational
saspect Rational
delta

changeMasterGrid :: SplitGrid a -> ChangeMasterGridGeom -> SplitGrid a
changeMasterGrid :: forall a. SplitGrid a -> ChangeMasterGridGeom -> SplitGrid a
changeMasterGrid (SplitGrid Orientation
o Int
mrows Int
mcols Rational
mfrac Rational
saspect Rational
delta) (IncMasterRows Int
d) =
    forall a.
Orientation
-> Int -> Int -> Rational -> Rational -> Rational -> SplitGrid a
SplitGrid Orientation
o (forall a. Ord a => a -> a -> a
max Int
0 (Int
mrows forall a. Num a => a -> a -> a
+ Int
d)) Int
mcols Rational
mfrac Rational
saspect Rational
delta
changeMasterGrid (SplitGrid Orientation
o Int
mrows Int
mcols Rational
mfrac Rational
saspect Rational
delta) (IncMasterCols Int
d) =
    forall a.
Orientation
-> Int -> Int -> Rational -> Rational -> Rational -> SplitGrid a
SplitGrid Orientation
o Int
mrows (forall a. Ord a => a -> a -> a
max Int
0 (Int
mcols forall a. Num a => a -> a -> a
+ Int
d)) Rational
mfrac Rational
saspect Rational
delta
changeMasterGrid (SplitGrid Orientation
o Int
_ Int
mcols Rational
mfrac Rational
saspect Rational
delta) (SetMasterRows Int
mrows) =
    forall a.
Orientation
-> Int -> Int -> Rational -> Rational -> Rational -> SplitGrid a
SplitGrid Orientation
o (forall a. Ord a => a -> a -> a
max Int
0 Int
mrows) Int
mcols Rational
mfrac Rational
saspect Rational
delta
changeMasterGrid (SplitGrid Orientation
o Int
mrows Int
_ Rational
mfrac Rational
saspect Rational
delta) (SetMasterCols Int
mcols) =
    forall a.
Orientation
-> Int -> Int -> Rational -> Rational -> Rational -> SplitGrid a
SplitGrid Orientation
o Int
mrows (forall a. Ord a => a -> a -> a
max Int
0 Int
mcols) Rational
mfrac Rational
saspect Rational
delta
changeMasterGrid (SplitGrid Orientation
o Int
mrows Int
mcols Rational
_ Rational
saspect Rational
delta) (SetMasterFraction Rational
mfrac) =
    forall a.
Orientation
-> Int -> Int -> Rational -> Rational -> Rational -> SplitGrid a
SplitGrid Orientation
o Int
mrows Int
mcols Rational
mfrac Rational
saspect Rational
delta

changeSlaveGridAspect :: SplitGrid a -> ChangeGridGeom -> SplitGrid a
changeSlaveGridAspect :: forall a. SplitGrid a -> ChangeGridGeom -> SplitGrid a
changeSlaveGridAspect (SplitGrid Orientation
o Int
mrows Int
mcols Rational
mfrac Rational
_ Rational
delta) (SetGridAspect Rational
saspect) =
    forall a.
Orientation
-> Int -> Int -> Rational -> Rational -> Rational -> SplitGrid a
SplitGrid Orientation
o Int
mrows Int
mcols Rational
mfrac Rational
saspect Rational
delta
changeSlaveGridAspect (SplitGrid Orientation
o Int
mrows Int
mcols Rational
mfrac Rational
saspect Rational
delta) (ChangeGridAspect Rational
sdelta) =
    forall a.
Orientation
-> Int -> Int -> Rational -> Rational -> Rational -> SplitGrid a
SplitGrid Orientation
o Int
mrows Int
mcols Rational
mfrac (forall a. Ord a => a -> a -> a
max Rational
0.00001 (Rational
saspect forall a. Num a => a -> a -> a
+ Rational
sdelta)) Rational
delta

-- | TallGrid layout.  Parameters are
--
--   - number of master rows
--   - number of master columns
--   - portion of screen used for master grid
--   - x:y aspect ratio of slave windows
--   - increment for resize messages
--
--   This exists mostly because it was introduced in an earlier version.
--   It's a fairly thin wrapper around "SplitGrid L".
data TallGrid a = TallGrid !Int !Int !Rational !Rational !Rational
                  deriving (ReadPrec [TallGrid a]
ReadPrec (TallGrid a)
ReadS [TallGrid a]
forall a. ReadPrec [TallGrid a]
forall a. ReadPrec (TallGrid a)
forall a. Int -> ReadS (TallGrid a)
forall a. ReadS [TallGrid a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TallGrid a]
$creadListPrec :: forall a. ReadPrec [TallGrid a]
readPrec :: ReadPrec (TallGrid a)
$creadPrec :: forall a. ReadPrec (TallGrid a)
readList :: ReadS [TallGrid a]
$creadList :: forall a. ReadS [TallGrid a]
readsPrec :: Int -> ReadS (TallGrid a)
$creadsPrec :: forall a. Int -> ReadS (TallGrid a)
Read, Int -> TallGrid a -> ShowS
forall a. Int -> TallGrid a -> ShowS
forall a. [TallGrid a] -> ShowS
forall a. TallGrid a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TallGrid a] -> ShowS
$cshowList :: forall a. [TallGrid a] -> ShowS
show :: TallGrid a -> String
$cshow :: forall a. TallGrid a -> String
showsPrec :: Int -> TallGrid a -> ShowS
$cshowsPrec :: forall a. Int -> TallGrid a -> ShowS
Show)

instance LayoutClass TallGrid a where

    pureLayout :: TallGrid a -> Rectangle -> Stack a -> [(a, Rectangle)]
pureLayout (TallGrid Int
mrows Int
mcols Rational
mfrac Rational
saspect Rational
_) Rectangle
rect Stack a
st = forall a b. [a] -> [b] -> [(a, b)]
zip [a]
wins [Rectangle]
rects
        where
          wins :: [a]
wins  = forall a. Stack a -> [a]
W.integrate Stack a
st
          nwins :: Int
nwins = forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
wins
          rects :: [Rectangle]
rects = Rectangle
-> Orientation
-> Int
-> Int
-> Int
-> Rational
-> Rational
-> [Rectangle]
arrangeSplitGrid Rectangle
rect Orientation
L Int
nwins Int
mrows Int
mcols Rational
mfrac Rational
saspect

    pureMessage :: TallGrid a -> SomeMessage -> Maybe (TallGrid a)
pureMessage TallGrid a
layout SomeMessage
msg =
        forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b.
(SplitGrid a -> b -> SplitGrid a) -> TallGrid a -> b -> TallGrid a
tallGridAdapter forall a. SplitGrid a -> Resize -> SplitGrid a
resizeMaster TallGrid a
layout) (forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
msg)
             , forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b.
(SplitGrid a -> b -> SplitGrid a) -> TallGrid a -> b -> TallGrid a
tallGridAdapter forall a. SplitGrid a -> ChangeMasterGridGeom -> SplitGrid a
changeMasterGrid TallGrid a
layout) (forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
msg) ]

    description :: TallGrid a -> String
description TallGrid a
_ = String
"TallGrid"

tallGridAdapter :: (SplitGrid a -> b -> SplitGrid a) -> TallGrid a -> b -> TallGrid a
tallGridAdapter :: forall a b.
(SplitGrid a -> b -> SplitGrid a) -> TallGrid a -> b -> TallGrid a
tallGridAdapter SplitGrid a -> b -> SplitGrid a
f (TallGrid Int
mrows Int
mcols Rational
mfrac Rational
saspect Rational
delta) b
msg =
    forall a.
Int -> Int -> Rational -> Rational -> Rational -> TallGrid a
TallGrid Int
mrows' Int
mcols' Rational
mfrac' Rational
saspect' Rational
delta'
    where
      SplitGrid Orientation
_ Int
mrows' Int
mcols' Rational
mfrac' Rational
saspect' Rational
delta' =
          SplitGrid a -> b -> SplitGrid a
f (forall a.
Orientation
-> Int -> Int -> Rational -> Rational -> Rational -> SplitGrid a
SplitGrid Orientation
L Int
mrows Int
mcols Rational
mfrac Rational
saspect Rational
delta) b
msg