{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Layout.BinaryColumn
-- 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 q :: Float
q min_size :: Int
min_size) m :: 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 Shrink = Float -> Int -> BinaryColumn a
forall a. Float -> Int -> BinaryColumn a
BinaryColumn (Float -> Float -> Float
forall a. Ord a => a -> a -> a
max (-2.0) (Float
q Float -> Float -> Float
forall a. Num a => a -> a -> a
- 0.1)) Int
min_size
    resize Expand = Float -> Int -> BinaryColumn a
forall a. Float -> Int -> BinaryColumn a
BinaryColumn (Float -> Float -> Float
forall a. Ord a => a -> a -> a
min   2.0  (Float
q Float -> Float -> Float
forall a. Num a => a -> a -> a
+ 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 scale :: Float
scale min_size :: Int
min_size) rect :: Rectangle
rect stack :: 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 n :: Int
n size :: Integer
size div :: a
div False = let
          n_fl :: a
n_fl = (Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)
          n_prev_fl :: a
n_prev_fl = (Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1))
          div_test :: a
div_test = a -> a -> a
forall a. Ord a => a -> a -> a
min (a
div) (a
n_prev_fl)
          value_test :: Integer
value_test = (Integer -> Integer
forall a. Integral a => a -> Integer
toInteger (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)))
          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
n))
          (value :: Integer
value, divide_next :: a
divide_next, no_room :: 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
div, Bool
False)
            else
              (Integer
value_max, a
n_fl, Bool
True)
          size_next :: Integer
size_next = Integer
size Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
value
          n_next :: Int
n_next = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1
          in Integer
value
          Integer -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
: Int -> Integer -> a -> Bool -> [Integer]
f Int
n_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 n :: Int
n size :: Integer
size div :: a
div True = let
          n_fl :: a
n_fl = (Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)
          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
div)
          value :: Integer
value = (Integer -> Integer
forall a. Integral a => a -> Integer
toInteger (a -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
round a
value_even))

          n_next :: Int
n_next = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1
          size_next :: Integer
size_next = Integer
size Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
value
          divide_next :: a
divide_next = a
n_fl
          in Integer
value
          Integer -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
: Int -> Integer -> a -> Bool -> [Integer]
f Int
n_next Integer
size_next a
n_fl Bool
True
        -- Last item: included twice.
        f 0 size :: Integer
size div :: a
div no_room_prev :: Bool
no_room_prev =
          [Integer
size];
      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
- 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
== 0.0 then
            (Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)
          else
            (1.0 Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ (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
< 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 <- [0..Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1]]
    rects :: [Rectangle]
rects = ((Integer, Position) -> Rectangle)
-> [(Integer, Position)] -> [Rectangle]
forall a b. (a -> b) -> [a] -> [b]
map (Rectangle -> (Integer, Position) -> Rectangle
mkRect Rectangle
rect) ([(Integer, Position)] -> [Rectangle])
-> [(Integer, Position)] -> [Rectangle]
forall a b. (a -> b) -> a -> b
$ [Integer] -> [Position] -> [(Integer, Position)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer]
heights [Position]
ys

mkRect :: XMonad.Rectangle
  -> (Integer,XMonad.Position)
  -> XMonad.Rectangle
mkRect :: Rectangle -> (Integer, Position) -> Rectangle
mkRect (XMonad.Rectangle xs :: Position
xs ys :: Position
ys ws :: Dimension
ws _) (h :: Integer
h, y :: 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)