{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Layout.BinaryColumn
-- Description :  A layout that places all windows in one column.
-- Copyright   :  (c) 2009 Ilya Portnov, (c) 2018 Campbell Barton
-- License     :  BSD3-style (see LICENSE)
--
-- Maintainer  :  Campbell Barton <ideasman42@gmail.com>
-- Stability   :  unstable
-- Portability :  unportable
--
-- Provides Column layout that places all windows in one column.
-- Each window is half the height of the previous,
-- except for the last pair of windows.
--
-- Note: Originally based on 'XMonad.Layout.Column' with changes:
--
-- * Adding/removing windows doesn't resize all other windows.
-- (last window pair exception).
-- * Minimum window height option.
--
-----------------------------------------------------------------------------

module XMonad.Layout.BinaryColumn (
                             -- * Usage
                             -- $usage
                             BinaryColumn (..)
                            ) where
import XMonad
import qualified XMonad.StackSet
import qualified Data.List

-- $usage
-- This module defines layout named BinaryColumn.
-- It places all windows in one column.
-- Windows heights are calculated to prevent window resizing whenever
-- a window is added or removed.
-- This is done by keeping the last two windows in the stack the same height.
--
-- You can use this module by adding following in your @xmonad.hs@:
--
-- > import XMonad.Layout.BinaryColumn
--
-- Then add layouts to your layoutHook:
--
-- > myLayoutHook = BinaryColumn 1.0 32 ||| ...
--
-- The first value causes the master window to take exactly half of the screen,
-- the second ensures that windows are no less than 32 pixels tall.
--
-- Shrink/Expand can be used to adjust the first value by increments of 0.1.
--
-- * 2.0 uses all space for the master window
-- (minus the space for windows which get their fixed height).
-- * 0.0 gives an evenly spaced grid.
-- Negative values reverse the sizes so the last
-- window in the stack becomes larger.
--

data BinaryColumn a = BinaryColumn Float Int
  deriving (ReadPrec [BinaryColumn a]
ReadPrec (BinaryColumn a)
Int -> ReadS (BinaryColumn a)
ReadS [BinaryColumn a]
(Int -> ReadS (BinaryColumn a))
-> ReadS [BinaryColumn a]
-> ReadPrec (BinaryColumn a)
-> ReadPrec [BinaryColumn a]
-> Read (BinaryColumn a)
forall a. ReadPrec [BinaryColumn a]
forall a. ReadPrec (BinaryColumn a)
forall a. Int -> ReadS (BinaryColumn a)
forall a. ReadS [BinaryColumn a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BinaryColumn a]
$creadListPrec :: forall a. ReadPrec [BinaryColumn a]
readPrec :: ReadPrec (BinaryColumn a)
$creadPrec :: forall a. ReadPrec (BinaryColumn a)
readList :: ReadS [BinaryColumn a]
$creadList :: forall a. ReadS [BinaryColumn a]
readsPrec :: Int -> ReadS (BinaryColumn a)
$creadsPrec :: forall a. Int -> ReadS (BinaryColumn a)
Read, Int -> BinaryColumn a -> ShowS
[BinaryColumn a] -> ShowS
BinaryColumn a -> String
(Int -> BinaryColumn a -> ShowS)
-> (BinaryColumn a -> String)
-> ([BinaryColumn a] -> ShowS)
-> Show (BinaryColumn a)
forall a. Int -> BinaryColumn a -> ShowS
forall a. [BinaryColumn a] -> ShowS
forall a. BinaryColumn a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BinaryColumn a] -> ShowS
$cshowList :: forall a. [BinaryColumn a] -> ShowS
show :: BinaryColumn a -> String
$cshow :: forall a. BinaryColumn a -> String
showsPrec :: Int -> BinaryColumn a -> ShowS
$cshowsPrec :: forall a. Int -> BinaryColumn a -> ShowS
Show)

instance XMonad.LayoutClass BinaryColumn a where
  pureLayout :: BinaryColumn a -> Rectangle -> Stack a -> [(a, Rectangle)]
pureLayout = BinaryColumn a -> Rectangle -> Stack a -> [(a, Rectangle)]
forall a.
BinaryColumn a -> Rectangle -> Stack a -> [(a, Rectangle)]
columnLayout
  pureMessage :: BinaryColumn a -> SomeMessage -> Maybe (BinaryColumn a)
pureMessage = BinaryColumn a -> SomeMessage -> Maybe (BinaryColumn a)
forall a. BinaryColumn a -> SomeMessage -> Maybe (BinaryColumn a)
columnMessage

columnMessage :: BinaryColumn a -> SomeMessage -> Maybe (BinaryColumn a)
columnMessage :: BinaryColumn a -> SomeMessage -> Maybe (BinaryColumn a)
columnMessage (BinaryColumn Float
q Int
min_size) SomeMessage
m = (Resize -> BinaryColumn a)
-> Maybe Resize -> Maybe (BinaryColumn a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Resize -> BinaryColumn a
forall a. Resize -> BinaryColumn a
resize (SomeMessage -> Maybe Resize
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m)
  where
    resize :: Resize -> BinaryColumn a
resize Resize
Shrink = Float -> Int -> BinaryColumn a
forall a. Float -> Int -> BinaryColumn a
BinaryColumn (Float -> Float -> Float
forall a. Ord a => a -> a -> a
max (-Float
2.0) (Float
q Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
0.1)) Int
min_size
    resize Resize
Expand = Float -> Int -> BinaryColumn a
forall a. Float -> Int -> BinaryColumn a
BinaryColumn (Float -> Float -> Float
forall a. Ord a => a -> a -> a
min   Float
2.0  (Float
q Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
0.1)) Int
min_size

columnLayout :: BinaryColumn a
  -> XMonad.Rectangle
  -> XMonad.StackSet.Stack a
  -> [(a, XMonad.Rectangle)]
columnLayout :: BinaryColumn a -> Rectangle -> Stack a -> [(a, Rectangle)]
columnLayout (BinaryColumn Float
scale Int
min_size) Rectangle
rect Stack a
stack = [a] -> [Rectangle] -> [(a, Rectangle)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
ws [Rectangle]
rects
  where
    ws :: [a]
ws = Stack a -> [a]
forall a. Stack a -> [a]
XMonad.StackSet.integrate Stack a
stack
    n :: Int
n = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
ws
    scale_abs :: Float
scale_abs = Float -> Float
forall a. Num a => a -> a
abs Float
scale
    heights_noflip :: [Integer]
heights_noflip =
      let
        -- Regular case: check for min size.
        f :: Int -> Integer -> a -> Bool -> [Integer]
f Int
m Integer
size a
divide Bool
False = let
          m_fl :: a
m_fl = Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
m
          m_prev_fl :: a
m_prev_fl = Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
          div_test :: a
div_test = a -> a -> a
forall a. Ord a => a -> a -> a
min a
divide a
m_prev_fl
          value_test :: Integer
value_test = a -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
round (Integer -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
size a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
div_test) :: Integer
          value_max :: Integer
value_max = Integer
size Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int
min_size Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
m)
          (Integer
value, a
divide_next, Bool
no_room) =
            if Integer
value_test Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
value_max then
              (Integer
value_test, a
divide, Bool
False)
            else
              (Integer
value_max, a
m_fl, Bool
True)
          size_next :: Integer
size_next = Integer
size Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
value
          m_next :: Int
m_next = Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
          in Integer
value
          Integer -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
: Int -> Integer -> a -> Bool -> [Integer]
f Int
m_next Integer
size_next a
divide_next Bool
no_room
        -- Fallback case: when windows have reached min size
        -- simply create an even grid with the remaining space.
        f Int
m Integer
size a
divide Bool
True = let
          divide_next :: a
divide_next = Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
m
          value_even :: a
value_even = (Integer -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
size a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
divide)
          value :: Integer
value = a -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
round a
value_even :: Integer

          m_next :: Int
m_next = Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
          size_next :: Integer
size_next = Integer
size Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
value
          in Integer
value
          Integer -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
: Int -> Integer -> a -> Bool -> [Integer]
f Int
m_next Integer
size_next a
divide_next Bool
True
      in Int -> Integer -> Float -> Bool -> [Integer]
forall a. RealFrac a => Int -> Integer -> a -> Bool -> [Integer]
f
         Int
n_init Integer
size_init Float
divide_init Bool
False
      where
        n_init :: Int
n_init = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
        size_init :: Integer
size_init = Dimension -> Integer
forall a. Integral a => a -> Integer
toInteger (Rectangle -> Dimension
rect_height Rectangle
rect)
        divide_init :: Float
divide_init =
          if Float
scale_abs Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
0.0 then
            Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n
          else
            Float
1.0 Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ (Float
0.5 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
scale_abs)

    heights :: [Integer]
heights =
      if Float
scale Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
0.0 then
        [Integer] -> [Integer]
forall a. [a] -> [a]
Data.List.reverse (Int -> [Integer] -> [Integer]
forall a. Int -> [a] -> [a]
take Int
n [Integer]
heights_noflip)
      else
        [Integer]
heights_noflip

    ys :: [Position]
ys = [Integer -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Position) -> Integer -> Position
forall a b. (a -> b) -> a -> b
$ [Integer] -> Integer
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Integer] -> Integer) -> [Integer] -> Integer
forall a b. (a -> b) -> a -> b
$ Int -> [Integer] -> [Integer]
forall a. Int -> [a] -> [a]
take Int
k [Integer]
heights | Int
k <- [Int
0..Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]]
    rects :: [Rectangle]
rects = (Integer -> Position -> Rectangle)
-> [Integer] -> [Position] -> [Rectangle]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (((Integer, Position) -> Rectangle)
-> Integer -> Position -> Rectangle
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (Rectangle -> (Integer, Position) -> Rectangle
mkRect Rectangle
rect)) [Integer]
heights [Position]
ys

mkRect :: XMonad.Rectangle
  -> (Integer,XMonad.Position)
  -> XMonad.Rectangle
mkRect :: Rectangle -> (Integer, Position) -> Rectangle
mkRect (XMonad.Rectangle Position
xs Position
ys Dimension
ws Dimension
_) (Integer
h, Position
y) =
  Position -> Position -> Dimension -> Dimension -> Rectangle
XMonad.Rectangle Position
xs (Position
ys Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Position -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral Position
y) Dimension
ws (Integer -> Dimension
forall a. Num a => Integer -> a
fromInteger Integer
h)