{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Layout.ThreeColumns
-- Description :  A layout similar to @Tall@, but with three columns.
-- Copyright   :  (c) Kai Grossjohann <kai@emptydomain.de>
-- 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
-- slave windows.
-----------------------------------------------------------------------------

module XMonad.Layout.ThreeColumns (
                              -- * Usage
                              -- $usage

                              -- * Screenshots
                              -- $screenshot
                              ThreeCol(..)
                             ) where

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

import Data.Ratio

-- $usage
-- You can use this module with the following in your @xmonad.hs@:
--
-- > import XMonad.Layout.ThreeColumns
--
-- Then edit your @layoutHook@ by adding the ThreeCol layout:
--
-- > myLayout = ThreeCol 1 (3/100) (1/2) ||| ThreeColMid 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.
--
-- The ThreeColMid 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".


-- $screenshot
-- <<https://user-images.githubusercontent.com/50166980/156938482-ac38fdd7-eb94-4371-801b-e191cdb9a4ba.png>>

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

instance LayoutClass ThreeCol a where
    pureLayout :: ThreeCol a -> Rectangle -> Stack a -> [(a, Rectangle)]
pureLayout (ThreeCol Int
n Rational
_ Rational
f) Rectangle
r    = forall a.
Bool -> Int -> Rational -> Rectangle -> Stack a -> [(a, Rectangle)]
doL Bool
False Int
n Rational
f Rectangle
r
    pureLayout (ThreeColMid Int
n Rational
_ Rational
f) Rectangle
r = forall a.
Bool -> Int -> Rational -> Rectangle -> Stack a -> [(a, Rectangle)]
doL Bool
True Int
n Rational
f Rectangle
r
    handleMessage :: ThreeCol a -> SomeMessage -> X (Maybe (ThreeCol a))
handleMessage ThreeCol a
l SomeMessage
m =
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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 -> ThreeCol 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}. IncMasterN -> ThreeCol a
incmastern (forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m)]
            where resize :: Resize -> ThreeCol a
resize Resize
Shrink = ThreeCol a
l { threeColFrac :: Rational
threeColFrac = forall a. Ord a => a -> a -> a
max (-Rational
0.5) forall a b. (a -> b) -> a -> b
$ Rational
fforall a. Num a => a -> a -> a
-Rational
d }
                  resize Resize
Expand = ThreeCol a
l { threeColFrac :: Rational
threeColFrac = forall a. Ord a => a -> a -> a
min Rational
1 forall a b. (a -> b) -> a -> b
$ Rational
fforall a. Num a => a -> a -> a
+Rational
d }
                  incmastern :: IncMasterN -> ThreeCol a
incmastern (IncMasterN Int
x) = ThreeCol a
l { threeColNMaster :: Int
threeColNMaster = forall a. Ord a => a -> a -> a
max Int
0 (Int
nforall a. Num a => a -> a -> a
+Int
x) }
                  n :: Int
n = forall a. ThreeCol a -> Int
threeColNMaster ThreeCol a
l
                  d :: Rational
d = forall a. ThreeCol a -> Rational
threeColDelta ThreeCol a
l
                  f :: Rational
f = forall a. ThreeCol a -> Rational
threeColFrac ThreeCol a
l
    description :: ThreeCol a -> String
description ThreeCol a
_ = String
"ThreeCol"

doL :: Bool-> Int-> Rational-> Rectangle-> W.Stack a-> [(a, Rectangle)]
doL :: forall a.
Bool -> Int -> Rational -> Rectangle -> Stack a -> [(a, Rectangle)]
doL Bool
m Int
n Rational
f Rectangle
r = forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap forall a b. [a] -> [b] -> [(a, b)]
zip (Bool -> Rational -> Rectangle -> Int -> Int -> [Rectangle]
tile3 Bool
m Rational
f Rectangle
r Int
n 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 -> Rectangle -> Int -> Int -> [Rectangle]
tile3 :: Bool -> Rational -> Rectangle -> Int -> Int -> [Rectangle]
tile3 Bool
middle Rational
f 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 = Int -> Rectangle -> [Rectangle]
splitVertically Int
n Rectangle
r
    | Int
n forall a. Ord a => a -> a -> Bool
<= Int
nmasterforall a. Num a => a -> a -> a
+Int
1 = Int -> Rectangle -> [Rectangle]
splitVertically Int
nmaster Rectangle
s1 forall a. [a] -> [a] -> [a]
++ Int -> Rectangle -> [Rectangle]
splitVertically (Int
nforall a. Num a => a -> a -> a
-Int
nmaster) Rectangle
s2
    | Bool
otherwise = Int -> Rectangle -> [Rectangle]
splitVertically Int
nmaster Rectangle
r1 forall a. [a] -> [a] -> [a]
++ Int -> Rectangle -> [Rectangle]
splitVertically Int
nslave1 Rectangle
r2 forall a. [a] -> [a] -> [a]
++ Int -> Rectangle -> [Rectangle]
splitVertically Int
nslave2 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
              nslave :: Int
nslave = Int
n forall a. Num a => a -> a -> a
- Int
nmaster
              nslave1 :: Int
nslave1 = forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Int
nslave forall a. Integral a => a -> a -> Ratio a
% Int
2)
              nslave2 :: Int
nslave2 = Int
n forall a. Num a => a -> a -> a
- Int
nmaster forall a. Num a => a -> a -> a
- Int
nslave1

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 Position
sy Dimension
r3w 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 )
    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 ( (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