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

-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Layout.ResizableThreeColumns
-- Description :  Like "XMonad.Layout.ThreeColumns", but allows resizing.
-- Copyright   :  (c) Sam Tay <sam.chong.tay@gmail.com>
-- License     :  BSD3-style (see LICENSE)
--
-- Maintainer  :  ?
-- Stability   :  unstable
-- Portability :  unportable
--
-- A layout similar to tall but with three columns. With 2560x1600 pixels this
-- layout can be used for a huge main window and up to six reasonable sized
-- resizable stack windows.
-----------------------------------------------------------------------------

module XMonad.Layout.ResizableThreeColumns (
                              -- * Usage
                              -- $usage
                              ResizableThreeCol(..), MirrorResize(..)
                             ) where

import XMonad hiding (splitVertically)
import XMonad.Prelude
import XMonad.Layout.ResizableTile(MirrorResize(..))
import qualified XMonad.StackSet as W

import qualified Data.Map as M
import Data.Ratio

-- $usage
-- You can use this module with the following in your @xmonad.hs@:
--
-- > import XMonad.Layout.ResizableThreeColumns
--
-- Then edit your @layoutHook@ by adding the ResizableThreeCol layout:
--
-- > myLayout = ResizableThreeCol 1 (3/100) (1/2) [] ||| ResizableThreeColMid 1 (3/100) (1/2) [] ||| etc..
-- > main = xmonad def { layoutHook = myLayout }
--
-- The first argument specifies how many windows initially appear in the main
-- window. The second argument argument specifies the amount to resize while
-- resizing and the third argument specifies the initial size of the columns.
-- A positive size designates the fraction of the screen that the main window
-- should occupy, but if the size is negative the absolute value designates the
-- fraction a stack column should occupy. If both stack columns are visible,
-- they always occupy the same amount of space.
--
-- You may also want to add the following key bindings:
--
-- > , ((modm,               xK_a), sendMessage MirrorShrink)
-- > , ((modm,               xK_z), sendMessage MirrorExpand)
--
-- The ResizableThreeColMid variant places the main window between the stack columns.
--
-- 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".


-- | Arguments are nmaster, delta, fraction
data ResizableThreeCol a
  = ResizableThreeColMid
    { forall a. ResizableThreeCol a -> Int
threeColNMaster :: !Int
    , forall a. ResizableThreeCol a -> Rational
threeColDelta :: !Rational
    , forall a. ResizableThreeCol a -> Rational
threeColFrac :: !Rational
    , forall a. ResizableThreeCol a -> [Rational]
threeColSlaves :: [Rational]
    }
  | ResizableThreeCol
    { threeColNMaster :: !Int
    , threeColDelta :: !Rational
    , threeColFrac :: !Rational
    , threeColSlaves :: [Rational]
    } deriving (Int -> ResizableThreeCol a -> ShowS
forall a. Int -> ResizableThreeCol a -> ShowS
forall a. [ResizableThreeCol a] -> ShowS
forall a. ResizableThreeCol a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResizableThreeCol a] -> ShowS
$cshowList :: forall a. [ResizableThreeCol a] -> ShowS
show :: ResizableThreeCol a -> String
$cshow :: forall a. ResizableThreeCol a -> String
showsPrec :: Int -> ResizableThreeCol a -> ShowS
$cshowsPrec :: forall a. Int -> ResizableThreeCol a -> ShowS
Show,ReadPrec [ResizableThreeCol a]
ReadPrec (ResizableThreeCol a)
ReadS [ResizableThreeCol a]
forall a. ReadPrec [ResizableThreeCol a]
forall a. ReadPrec (ResizableThreeCol a)
forall a. Int -> ReadS (ResizableThreeCol a)
forall a. ReadS [ResizableThreeCol a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ResizableThreeCol a]
$creadListPrec :: forall a. ReadPrec [ResizableThreeCol a]
readPrec :: ReadPrec (ResizableThreeCol a)
$creadPrec :: forall a. ReadPrec (ResizableThreeCol a)
readList :: ReadS [ResizableThreeCol a]
$creadList :: forall a. ReadS [ResizableThreeCol a]
readsPrec :: Int -> ReadS (ResizableThreeCol a)
$creadsPrec :: forall a. Int -> ReadS (ResizableThreeCol a)
Read)

instance LayoutClass ResizableThreeCol a where
  doLayout :: ResizableThreeCol a
-> Rectangle
-> Stack a
-> X ([(a, Rectangle)], Maybe (ResizableThreeCol a))
doLayout (ResizableThreeCol Int
n Rational
_ Rational
f [Rational]
mf) Rectangle
r    = forall a (layout :: * -> *).
Bool
-> Int
-> Rational
-> [Rational]
-> Rectangle
-> Stack a
-> X ([(a, Rectangle)], Maybe (layout a))
doL Bool
False Int
n Rational
f [Rational]
mf Rectangle
r
  doLayout (ResizableThreeColMid Int
n Rational
_ Rational
f [Rational]
mf) Rectangle
r = forall a (layout :: * -> *).
Bool
-> Int
-> Rational
-> [Rational]
-> Rectangle
-> Stack a
-> X ([(a, Rectangle)], Maybe (layout a))
doL Bool
True  Int
n Rational
f [Rational]
mf Rectangle
r
  handleMessage :: ResizableThreeCol a
-> SomeMessage -> X (Maybe (ResizableThreeCol a))
handleMessage ResizableThreeCol a
l SomeMessage
m = do
    Maybe (Stack Window)
ms <- forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
windowset
    [Window]
fs <- forall k a. Map k a -> [k]
M.keys forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. StackSet i l a sid sd -> Map a RationalRect
W.floating forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
windowset
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ do
      Stack Window
s <- Maybe (Stack Window)
ms
      -- make sure current stack isn't floating
      forall (f :: * -> *). Alternative f => Bool -> f ()
guard (forall a. Stack a -> a
W.focus Stack Window
s forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Window]
fs)
      -- remove floating windows from stack
      let s' :: Stack Window
s' = Stack Window
s { up :: [Window]
W.up = forall a. Stack a -> [a]
W.up Stack Window
s forall a. Eq a => [a] -> [a] -> [a]
\\ [Window]
fs, down :: [Window]
W.down = forall a. Stack a -> [a]
W.down Stack Window
s forall a. Eq a => [a] -> [a] -> [a]
\\ [Window]
fs }
      -- handle messages
      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}. Resize -> ResizableThreeCol a
resize       (forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m)
           , forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall {a} {a}. Stack a -> MirrorResize -> ResizableThreeCol a
mresize Stack Window
s') (forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m)
           , forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {a}. IncMasterN -> ResizableThreeCol a
incmastern   (forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m)
           ]
    where
      resize :: Resize -> ResizableThreeCol a
resize Resize
Shrink = ResizableThreeCol a
l { threeColFrac :: Rational
threeColFrac = forall a. Ord a => a -> a -> a
max (-Rational
0.5) forall a b. (a -> b) -> a -> b
$ Rational
fracforall a. Num a => a -> a -> a
-Rational
delta }
      resize Resize
Expand = ResizableThreeCol a
l { threeColFrac :: Rational
threeColFrac = forall a. Ord a => a -> a -> a
min Rational
1 forall a b. (a -> b) -> a -> b
$ Rational
fracforall a. Num a => a -> a -> a
+Rational
delta }
      mresize :: Stack a -> MirrorResize -> ResizableThreeCol a
mresize Stack a
s MirrorResize
MirrorShrink = forall {a} {a}. Stack a -> Rational -> ResizableThreeCol a
mresize' Stack a
s Rational
delta
      mresize Stack a
s MirrorResize
MirrorExpand = forall {a} {a}. Stack a -> Rational -> ResizableThreeCol a
mresize' Stack a
s (forall a. Num a => a -> a
negate Rational
delta)
      mresize' :: Stack a -> Rational -> ResizableThreeCol a
mresize' Stack a
s Rational
delt =
        let up :: Int
up = forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ forall a. Stack a -> [a]
W.up Stack a
s
            down :: Int
down = forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ forall a. Stack a -> [a]
W.down Stack a
s
            total :: Int
total = Int
up forall a. Num a => a -> a -> a
+ Int
down forall a. Num a => a -> a -> a
+ Int
1
            pos :: Int
pos = if Int
up forall a. Eq a => a -> a -> Bool
== Int
nmaster forall a. Num a => a -> a -> a
- Int
1           -- upper right
                  Bool -> Bool -> Bool
|| Int
up forall a. Eq a => a -> a -> Bool
== Int
total forall a. Num a => a -> a -> a
- Int
1             -- upper left
                  Bool -> Bool -> Bool
|| Int
up forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int
down, Int
down forall a. Num a => a -> a -> a
+ Int
1]  -- lower right
                  then Int
up forall a. Num a => a -> a -> a
- Int
1
                  else Int
up
            mfrac' :: [Rational]
mfrac' = forall {t} {t}. (Eq t, Num t, Num t) => [t] -> t -> t -> [t]
modifymfrac ([Rational]
mfrac forall a. [a] -> [a] -> [a]
++ forall a. a -> [a]
repeat Rational
1) Rational
delt Int
pos
        in ResizableThreeCol a
l { threeColSlaves :: [Rational]
threeColSlaves = forall a. Int -> [a] -> [a]
take Int
total [Rational]
mfrac'}
      modifymfrac :: [t] -> t -> t -> [t]
modifymfrac [] t
_ t
_ = []
      modifymfrac (t
f:[t]
fx) t
d t
n
        | t
n forall a. Eq a => a -> a -> Bool
== t
0    = t
fforall a. Num a => a -> a -> a
+t
d forall a. a -> [a] -> [a]
: [t]
fx
        | Bool
otherwise = t
f forall a. a -> [a] -> [a]
: [t] -> t -> t -> [t]
modifymfrac [t]
fx t
d (t
nforall a. Num a => a -> a -> a
-t
1)
      incmastern :: IncMasterN -> ResizableThreeCol a
incmastern (IncMasterN Int
x) = ResizableThreeCol a
l { threeColNMaster :: Int
threeColNMaster = forall a. Ord a => a -> a -> a
max Int
0 (Int
nmasterforall a. Num a => a -> a -> a
+Int
x) }
      nmaster :: Int
nmaster = forall a. ResizableThreeCol a -> Int
threeColNMaster ResizableThreeCol a
l
      delta :: Rational
delta = forall a. ResizableThreeCol a -> Rational
threeColDelta ResizableThreeCol a
l
      frac :: Rational
frac = forall a. ResizableThreeCol a -> Rational
threeColFrac ResizableThreeCol a
l
      mfrac :: [Rational]
mfrac = forall a. ResizableThreeCol a -> [Rational]
threeColSlaves ResizableThreeCol a
l
  description :: ResizableThreeCol a -> String
description ResizableThreeCol a
_ = String
"ResizableThreeCol"

doL :: Bool -> Int -> Rational -> [Rational] -> Rectangle
    -> W.Stack a -> X ([(a, Rectangle)], Maybe (layout a))
doL :: forall a (layout :: * -> *).
Bool
-> Int
-> Rational
-> [Rational]
-> Rectangle
-> Stack a
-> X ([(a, Rectangle)], Maybe (layout a))
doL Bool
middle Int
nmaster Rational
f [Rational]
mf Rectangle
r =
  forall (m :: * -> *) a. Monad m => a -> m a
return
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. (, forall a. Maybe a
Nothing)
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap forall a b. [a] -> [b] -> [(a, b)]
zip (Bool
-> Rational -> [Rational] -> Rectangle -> Int -> Int -> [Rectangle]
tile3 Bool
middle Rational
f ([Rational]
mf forall a. [a] -> [a] -> [a]
++ forall a. a -> [a]
repeat Rational
1) Rectangle
r Int
nmaster forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Int
length) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Stack a -> [a]
W.integrate

-- | tile3.  Compute window positions using 3 panes
tile3 :: Bool -> Rational -> [Rational] -> Rectangle -> Int -> Int -> [Rectangle]
tile3 :: Bool
-> Rational -> [Rational] -> Rectangle -> Int -> Int -> [Rectangle]
tile3 Bool
middle Rational
f [Rational]
mf Rectangle
r Int
nmaster Int
n
  | Int
n forall a. Ord a => a -> a -> Bool
<= Int
nmaster Bool -> Bool -> Bool
|| Int
nmaster forall a. Eq a => a -> a -> Bool
== Int
0 = forall r. RealFrac r => [r] -> Int -> Rectangle -> [Rectangle]
splitVertically [Rational]
mf Int
n Rectangle
r
  | Int
n forall a. Ord a => a -> a -> Bool
<= Int
nmasterforall a. Num a => a -> a -> a
+Int
1 = forall r. RealFrac r => [r] -> Int -> Rectangle -> [Rectangle]
splitVertically [Rational]
mf Int
nmaster Rectangle
s1
                  forall a. [a] -> [a] -> [a]
++ forall r. RealFrac r => [r] -> Int -> Rectangle -> [Rectangle]
splitVertically (forall a. Int -> [a] -> [a]
drop Int
nmaster [Rational]
mf) (Int
nforall a. Num a => a -> a -> a
-Int
nmaster) Rectangle
s2
  | Bool
otherwise = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ forall r. RealFrac r => [r] -> Int -> Rectangle -> [Rectangle]
splitVertically [Rational]
mf Int
nmaster Rectangle
r1
                       , forall r. RealFrac r => [r] -> Int -> Rectangle -> [Rectangle]
splitVertically (forall a. Int -> [a] -> [a]
drop Int
nmaster [Rational]
mf) Int
nstack1 Rectangle
r2
                       , forall r. RealFrac r => [r] -> Int -> Rectangle -> [Rectangle]
splitVertically (forall a. Int -> [a] -> [a]
drop (Int
nmaster forall a. Num a => a -> a -> a
+ Int
nstack1) [Rational]
mf) Int
nstack2 Rectangle
r3
                       ]
  where
    (Rectangle
r1, Rectangle
r2, Rectangle
r3) = Bool -> Rational -> Rectangle -> (Rectangle, Rectangle, Rectangle)
split3HorizontallyBy Bool
middle (if Rational
fforall a. Ord a => a -> a -> Bool
<Rational
0 then Rational
1forall a. Num a => a -> a -> a
+Rational
2forall a. Num a => a -> a -> a
*Rational
f else Rational
f) Rectangle
r
    (Rectangle
s1, Rectangle
s2)     = forall r. RealFrac r => r -> Rectangle -> (Rectangle, Rectangle)
splitHorizontallyBy (if Rational
fforall a. Ord a => a -> a -> Bool
<Rational
0 then Rational
1forall a. Num a => a -> a -> a
+Rational
f else Rational
f) Rectangle
r
    nstack :: Int
nstack       = Int
n forall a. Num a => a -> a -> a
- Int
nmaster
    nstack1 :: Int
nstack1      = forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Int
nstack forall a. Integral a => a -> a -> Ratio a
% Int
2)
    nstack2 :: Int
nstack2      = Int
nstack forall a. Num a => a -> a -> a
- Int
nstack1

splitVertically :: RealFrac r => [r] -> Int -> Rectangle -> [Rectangle]
splitVertically :: forall r. RealFrac r => [r] -> Int -> Rectangle -> [Rectangle]
splitVertically [] Int
_ Rectangle
r = [Rectangle
r]
splitVertically [r]
_ Int
n Rectangle
r | Int
n forall a. Ord a => a -> a -> Bool
< Int
2 = [Rectangle
r]
splitVertically (r
f:[r]
fx) Int
n (Rectangle Position
sx Position
sy Dimension
sw Dimension
sh) =
  let smallh :: Dimension
smallh = forall a. Ord a => a -> a -> a
min Dimension
sh (forall a b. (RealFrac a, Integral b) => a -> b
floor forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fi (Dimension
sh forall a. Integral a => a -> a -> a
`div` forall a b. (Integral a, Num b) => a -> b
fi Int
n) forall a. Num a => a -> a -> a
* r
f)
  in Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
sx Position
sy Dimension
sw Dimension
smallh forall a. a -> [a] -> [a]
:
       forall r. RealFrac r => [r] -> Int -> Rectangle -> [Rectangle]
splitVertically [r]
fx (Int
nforall a. Num a => a -> a -> a
-Int
1) (Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
sx (Position
syforall a. Num a => a -> a -> a
+forall a b. (Integral a, Num b) => a -> b
fi Dimension
smallh) Dimension
sw (Dimension
shforall a. Num a => a -> a -> a
-Dimension
smallh))

split3HorizontallyBy :: Bool -> Rational -> Rectangle -> (Rectangle, Rectangle, Rectangle)
split3HorizontallyBy :: Bool -> Rational -> Rectangle -> (Rectangle, Rectangle, Rectangle)
split3HorizontallyBy Bool
middle Rational
f (Rectangle Position
sx Position
sy Dimension
sw Dimension
sh) =
  if Bool
middle
  then ( Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle (Position
sx forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
r3w) Position
sy Dimension
r1w Dimension
sh
       , Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle (Position
sx forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
r3w forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
r1w) Position
sy Dimension
r2w Dimension
sh
       , Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
sx Position
sy Dimension
r3w Dimension
sh )
  else ( Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
sx Position
sy Dimension
r1w Dimension
sh
       , Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle (Position
sx forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
r1w) Position
sy Dimension
r2w Dimension
sh
       , Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle (Position
sx forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
r1w forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
r2w) Position
sy Dimension
r3w Dimension
sh )
  where
    r1w :: Dimension
r1w = forall a b. (RealFrac a, Integral b) => a -> b
ceiling forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
sw forall a. Num a => a -> a -> a
* Rational
f
    r2w :: Dimension
r2w = forall a b. (RealFrac a, Integral b) => a -> b
ceiling forall a b. (a -> b) -> a -> b
$ (Dimension
sw forall a. Num a => a -> a -> a
- Dimension
r1w) forall a. Integral a => a -> a -> Ratio a
% Dimension
2
    r3w :: Dimension
r3w = Dimension
sw forall a. Num a => a -> a -> a
- Dimension
r1w forall a. Num a => a -> a -> a
- Dimension
r2w