{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Layout.CenterMainFluid
-- Description :  Three column layout with master in center and unoccupied spaces reserved.
-- Copyright   :  (c) 2023 Mahdi Seyedan
-- License     :  BSD-style (see xmonad/LICENSE)
--
-- Maintainer  :  Mahdi Seyedan. <mahdisn78@gmail.com>
-- Stability   :  unstable
-- Portability :  unportable
--
-- A three column layout with main column in the center and
-- two stack columns surrounding it. There will be always
-- a pane in the center column and unoccupied spaces on the
-- sides are reserved.
-- It's best suited for ultrawide montiors, where a single
-- stretched window might be annoying.
-----------------------------------------------------------------------------

module XMonad.Layout.CenterMainFluid
  ( -- * Usage
    -- $usage
    CenterMainFluid (..)
  ) where

import XMonad
import qualified XMonad.StackSet as W
import Control.Monad (msum)

-- $usage
-- You can use this module by adding following in your @xmonad.hs@:
--
-- > import XMonad.Layout.CenterMainFluid
--
-- Then edit your @layoutHook@ by adding the CenterMainFluid layout:
--
-- > myLayoutHook = CenterMainFluid 1 (3/100) (70/100) ||| ...
-- > main = xmonad def { layoutHook = myLayout }
--
-- The first argument specifies how many windows initially appear in the center
-- column. The second argument specifies the amount to resize while resizing
-- and the third argument specifies the initial size of the center column.
--
-- 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. Supports 'Shrink', 'Expand' and
-- 'IncMasterN'
data CenterMainFluid a = CenterMainFluid
  { forall a. CenterMainFluid a -> Int
cmfNMaster :: !Int             -- ^ The default number of windows in the center pane (default: 1)
  , forall a. CenterMainFluid a -> Rational
cmfRatioIncrement :: !Rational -- ^ Percent of screen to increment by when resizing panes (default: 3/100)
  , forall a. CenterMainFluid a -> Rational
cmfRatio :: !Rational          -- ^ Default proportion of screen occupied by the center pane (default: 70/100)
  }
  deriving (Int -> CenterMainFluid a -> ShowS
forall a. Int -> CenterMainFluid a -> ShowS
forall a. [CenterMainFluid a] -> ShowS
forall a. CenterMainFluid a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CenterMainFluid a] -> ShowS
$cshowList :: forall a. [CenterMainFluid a] -> ShowS
show :: CenterMainFluid a -> String
$cshow :: forall a. CenterMainFluid a -> String
showsPrec :: Int -> CenterMainFluid a -> ShowS
$cshowsPrec :: forall a. Int -> CenterMainFluid a -> ShowS
Show,ReadPrec [CenterMainFluid a]
ReadPrec (CenterMainFluid a)
ReadS [CenterMainFluid a]
forall a. ReadPrec [CenterMainFluid a]
forall a. ReadPrec (CenterMainFluid a)
forall a. Int -> ReadS (CenterMainFluid a)
forall a. ReadS [CenterMainFluid a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CenterMainFluid a]
$creadListPrec :: forall a. ReadPrec [CenterMainFluid a]
readPrec :: ReadPrec (CenterMainFluid a)
$creadPrec :: forall a. ReadPrec (CenterMainFluid a)
readList :: ReadS [CenterMainFluid a]
$creadList :: forall a. ReadS [CenterMainFluid a]
readsPrec :: Int -> ReadS (CenterMainFluid a)
$creadsPrec :: forall a. Int -> ReadS (CenterMainFluid a)
Read)

instance LayoutClass CenterMainFluid a where

    pureLayout :: CenterMainFluid a -> Rectangle -> Stack a -> [(a, Rectangle)]
pureLayout (CenterMainFluid Int
nmaster Rational
_ Rational
frac) Rectangle
r Stack a
s
        | Rational
frac forall a. Eq a => a -> a -> Bool
== Rational
0 = forall a. Int -> [a] -> [a]
drop Int
nmaster [(a, Rectangle)]
layout
        | Rational
frac forall a. Eq a => a -> a -> Bool
== Rational
1 = forall a. Int -> [a] -> [a]
take Int
nmaster [(a, Rectangle)]
layout
        | Bool
otherwise = [(a, Rectangle)]
layout
      where layout :: [(a, Rectangle)]
layout = forall a b. [a] -> [b] -> [(a, b)]
zip [a]
ws [Rectangle]
rs
            ws :: [a]
ws = forall a. Stack a -> [a]
W.integrate Stack a
s
            rs :: [Rectangle]
rs = Rational -> Rectangle -> Int -> Int -> [Rectangle]
tile3 Rational
frac Rectangle
r Int
nmaster (forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
ws)

    pureMessage :: CenterMainFluid a -> SomeMessage -> Maybe (CenterMainFluid a)
pureMessage (CenterMainFluid Int
nmaster Rational
delta Rational
frac) SomeMessage
m =
            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 -> CenterMainFluid 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 -> CenterMainFluid a
incmastern (forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m)]

      where resize :: Resize -> CenterMainFluid a
resize Resize
Shrink             = forall a. Int -> Rational -> Rational -> CenterMainFluid a
CenterMainFluid Int
nmaster Rational
delta (forall a. Ord a => a -> a -> a
max Rational
0 forall a b. (a -> b) -> a -> b
$ Rational
fracforall a. Num a => a -> a -> a
-Rational
delta)
            resize Resize
Expand             = forall a. Int -> Rational -> Rational -> CenterMainFluid a
CenterMainFluid Int
nmaster Rational
delta (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)
            incmastern :: IncMasterN -> CenterMainFluid a
incmastern (IncMasterN Int
d) = forall a. Int -> Rational -> Rational -> CenterMainFluid a
CenterMainFluid (forall a. Ord a => a -> a -> a
max Int
0 (Int
nmasterforall a. Num a => a -> a -> a
+Int
d)) Rational
delta Rational
frac

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

tile3 :: Rational -> Rectangle -> Int -> Int -> [Rectangle]
tile3 :: Rational -> Rectangle -> Int -> Int -> [Rectangle]
tile3 Rational
f Rectangle
r Int
nmaster Int
n
  | Int
nmaster forall a. Ord a => a -> a -> Bool
<= Int
0 Bool -> Bool -> Bool
|| Int
n forall a. Ord a => a -> a -> Bool
<= Int
nmaster = Int -> Rectangle -> [Rectangle]
splitVertically Int
n Rectangle
middleR
  | Bool
otherwise = [Rectangle]
masters forall a. [a] -> [a] -> [a]
++ [Rectangle]
rights forall a. [a] -> [a] -> [a]
++ [Rectangle]
lefts
      where (Rectangle
leftR, Rectangle
middleR, Rectangle
rightR) = forall r.
RealFrac r =>
r -> Rectangle -> (Rectangle, Rectangle, Rectangle)
split3HorizontallyBy Rational
f Rectangle
r
            (Int
halfN, Int
remaining) = (Int
n forall a. Num a => a -> a -> a
- Int
nmaster) forall a. Integral a => a -> a -> (a, a)
`divMod` Int
2
            masters :: [Rectangle]
masters = Int -> Rectangle -> [Rectangle]
splitVertically Int
nmaster Rectangle
middleR
            lefts :: [Rectangle]
lefts = Int -> Rectangle -> [Rectangle]
splitVertically Int
halfN Rectangle
leftR
            rights :: [Rectangle]
rights = Int -> Rectangle -> [Rectangle]
splitVertically (Int
halfN forall a. Num a => a -> a -> a
+ Int
remaining) Rectangle
rightR

-- | Divide the screen into three rectangles, using a rational to specify the ratio of center one
split3HorizontallyBy :: RealFrac r => r -> Rectangle -> (Rectangle, Rectangle, Rectangle)
split3HorizontallyBy :: forall r.
RealFrac r =>
r -> Rectangle -> (Rectangle, Rectangle, Rectangle)
split3HorizontallyBy r
f (Rectangle Position
sx Position
sy Dimension
sw Dimension
sh) =
  ( Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
sx Position
sy Dimension
sidew 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
sidew) Position
sy Dimension
middlew 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
sidew forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
middlew) Position
sy Dimension
sidew Dimension
sh
  )
  where middlew :: Dimension
middlew = 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
fromIntegral Dimension
sw forall a. Num a => a -> a -> a
* r
f
        sidew :: Dimension
sidew = (Dimension
sw forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
middlew) forall a. Integral a => a -> a -> a
`div` Dimension
2