{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}

-- |
-- Module      :  XMonad.Layout.Cross
-- Description :  A Cross Layout with the main window in the center.
-- Copyright   :  (c) Luis Cabellos <zhen.sydow@gmail.com>
-- License     :  BSD3-style (see LICENSE)
--
-- Maintainer  :  Luis Cabellos <zhen.sydow@gmail.com>
-- Stability   :  stable
-- Portability :  portable
--
-- A Cross Layout with the main window in the center.
--
module XMonad.Layout.Cross(
                          -- * Usage
                          -- $usage
                          simpleCross
                          , Cross(..) ) where

import XMonad( Dimension, Rectangle(..), LayoutClass(..), Resize(..), fromMessage )
import XMonad.StackSet( focus, up, down )
import XMonad.Prelude( msum )

-- $usage
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Layout.Cross
--
-- Then edit your @layoutHook@ by adding one of the Cross layouts:
--
-- > myLayout =  simpleCross ||| etc..
-- > main = xmonad def { layoutHook = myLayout }
--

-- apply a factor to a Rectangle Dimension
(<%>) :: Dimension -> Rational -> Dimension
Dimension
d <%> :: Dimension -> Rational -> Dimension
<%> Rational
f = Rational -> Dimension
forall a b. (RealFrac a, Integral b) => a -> b
floor (Rational -> Dimension) -> Rational -> Dimension
forall a b. (a -> b) -> a -> b
$ Rational
f Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Dimension -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
d

-- | The Cross Layout draws the focused window in the center of the screen
--   and part of the other windows on the sides. The 'Shrink' and 'Expand'
--   messages increment the size of the main window.
--
--   The focus keybindings change the center window, while other windows
--   cycle through the side positions. With the Cross layout only four
--   windows are shown around the focused window, two ups and two downs,
--   no matter how many are in the current stack. I.e. focus down cycles the
--   window below focused into the center; focus up cycles the window above.
data Cross a = Cross {
      Cross a -> Rational
crossProp :: !Rational, -- ^ Proportion of screen occupied by the main window.
      Cross a -> Rational
crossInc  :: !Rational  -- ^ Percent of main window to increment by when resizing.
    }
    deriving( Int -> Cross a -> ShowS
[Cross a] -> ShowS
Cross a -> String
(Int -> Cross a -> ShowS)
-> (Cross a -> String) -> ([Cross a] -> ShowS) -> Show (Cross a)
forall a. Int -> Cross a -> ShowS
forall a. [Cross a] -> ShowS
forall a. Cross a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Cross a] -> ShowS
$cshowList :: forall a. [Cross a] -> ShowS
show :: Cross a -> String
$cshow :: forall a. Cross a -> String
showsPrec :: Int -> Cross a -> ShowS
$cshowsPrec :: forall a. Int -> Cross a -> ShowS
Show, ReadPrec [Cross a]
ReadPrec (Cross a)
Int -> ReadS (Cross a)
ReadS [Cross a]
(Int -> ReadS (Cross a))
-> ReadS [Cross a]
-> ReadPrec (Cross a)
-> ReadPrec [Cross a]
-> Read (Cross a)
forall a. ReadPrec [Cross a]
forall a. ReadPrec (Cross a)
forall a. Int -> ReadS (Cross a)
forall a. ReadS [Cross a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Cross a]
$creadListPrec :: forall a. ReadPrec [Cross a]
readPrec :: ReadPrec (Cross a)
$creadPrec :: forall a. ReadPrec (Cross a)
readList :: ReadS [Cross a]
$creadList :: forall a. ReadS [Cross a]
readsPrec :: Int -> ReadS (Cross a)
$creadsPrec :: forall a. Int -> ReadS (Cross a)
Read )

-- | A simple Cross Layout. It places the focused window in the center.
--   The proportion of the screen used by the main window is 4\/5.
simpleCross :: Cross a
simpleCross :: Cross a
simpleCross = Rational -> Rational -> Cross a
forall a. Rational -> Rational -> Cross a
Cross (Rational
4Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
5) (Rational
1Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
100)

instance LayoutClass Cross a where
    pureLayout :: Cross a -> Rectangle -> Stack a -> [(a, Rectangle)]
pureLayout (Cross Rational
f Rational
_) Rectangle
r Stack a
s = [(Stack a -> a
forall a. Stack a -> a
focus Stack a
s, Rectangle -> Rational -> Rectangle
mainRect Rectangle
r Rational
f)]
                              [(a, Rectangle)] -> [(a, Rectangle)] -> [(a, Rectangle)]
forall a. [a] -> [a] -> [a]
++ [a] -> [Rectangle] -> [(a, Rectangle)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
winCycle (Rectangle -> Rational -> [Rectangle]
upRects Rectangle
r Rational
f)
                              [(a, Rectangle)] -> [(a, Rectangle)] -> [(a, Rectangle)]
forall a. [a] -> [a] -> [a]
++ [a] -> [Rectangle] -> [(a, Rectangle)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
winCycle) (Rectangle -> Rational -> [Rectangle]
downRects Rectangle
r Rational
f)
        where winCycle :: [a]
winCycle = Stack a -> [a]
forall a. Stack a -> [a]
up Stack a
s [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a] -> [a]
forall a. [a] -> [a]
reverse (Stack a -> [a]
forall a. Stack a -> [a]
down Stack a
s)

    pureMessage :: Cross a -> SomeMessage -> Maybe (Cross a)
pureMessage (Cross Rational
f Rational
d) SomeMessage
m = [Maybe (Cross a)] -> Maybe (Cross a)
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [(Resize -> Cross a) -> Maybe Resize -> Maybe (Cross a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Resize -> Cross a
forall a. Resize -> Cross a
resize (SomeMessage -> Maybe Resize
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m)]
        where resize :: Resize -> Cross a
resize Resize
Shrink = Rational -> Rational -> Cross a
forall a. Rational -> Rational -> Cross a
Cross (Rational -> Rational -> Rational
forall a. Ord a => a -> a -> a
max (Rational
1Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
100) (Rational -> Rational) -> Rational -> Rational
forall a b. (a -> b) -> a -> b
$ Rational
f Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational
d) Rational
d
              resize Resize
Expand = Rational -> Rational -> Cross a
forall a. Rational -> Rational -> Cross a
Cross (Rational -> Rational -> Rational
forall a. Ord a => a -> a -> a
min Rational
1 (Rational -> Rational) -> Rational -> Rational
forall a b. (a -> b) -> a -> b
$ Rational
f Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
d) Rational
d

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

-- get the Rectangle for the focused window
mainRect :: Rectangle -> Rational -> Rectangle
mainRect :: Rectangle -> Rational -> Rectangle
mainRect (Rectangle Position
rx Position
ry Dimension
rw Dimension
rh) Rational
f = Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle
                                     (Position
rx Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Dimension
rw Dimension -> Rational -> Dimension
<%> Rational
invf))
                                     (Position
ry Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Dimension
rh Dimension -> Rational -> Dimension
<%> Rational
invf))
                                     (Dimension
rw Dimension -> Rational -> Dimension
<%> Rational
f) (Dimension
rh Dimension -> Rational -> Dimension
<%> Rational
f)
    where invf :: Rational
invf = (Rational
1Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
2) Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* (Rational
1Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
-Rational
f)

-- get the rectangles for the up windows
upRects :: Rectangle -> Rational -> [Rectangle]
upRects :: Rectangle -> Rational -> [Rectangle]
upRects Rectangle
r Rational
f = [Rectangle -> Rational -> Rectangle
topRectangle Rectangle
r Rational
nf, Rectangle -> Rational -> Rectangle
rightRectangle Rectangle
r Rational
nf]
    where nf :: Rational
nf = Rational
f Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* (Rational
8Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
10)

-- get the rectangles for the down windows
downRects :: Rectangle -> Rational -> [Rectangle]
downRects :: Rectangle -> Rational -> [Rectangle]
downRects Rectangle
r Rational
f = [Rectangle -> Rational -> Rectangle
bottomRectangle Rectangle
r Rational
nf, Rectangle -> Rational -> Rectangle
leftRectangle Rectangle
r Rational
nf]
    where nf :: Rational
nf = Rational
f Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* (Rational
8Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
10)

topRectangle :: Rectangle -> Rational -> Rectangle
topRectangle :: Rectangle -> Rational -> Rectangle
topRectangle (Rectangle Position
rx Position
ry Dimension
rw Dimension
rh) Rational
f = Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle
                                         (Position
rx Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Dimension
rw Dimension -> Rational -> Dimension
<%> ((Rational
1Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
-Rational
f)Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
*(Rational
1Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
2))))
                                         Position
ry
                                         (Dimension
rw Dimension -> Rational -> Dimension
<%> Rational
f) (Dimension
rh Dimension -> Rational -> Dimension
<%> ((Rational
1Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
-Rational
f)Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
*(Rational
1Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
2)))

rightRectangle :: Rectangle -> Rational -> Rectangle
rightRectangle :: Rectangle -> Rational -> Rectangle
rightRectangle (Rectangle Position
rx Position
ry Dimension
rw Dimension
rh) Rational
f = Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle
                                           (Position
rx Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Dimension
rw Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
- (Dimension
rw Dimension -> Rational -> Dimension
<%> (Rational
1Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
2))))
                                           (Position
ry Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Dimension
rh Dimension -> Rational -> Dimension
<%> ((Rational
1Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
-Rational
f)Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
*(Rational
1Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
2))))
                                           (Dimension
rw Dimension -> Rational -> Dimension
<%> (Rational
1Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
2)) (Dimension
rh Dimension -> Rational -> Dimension
<%> Rational
f)

bottomRectangle :: Rectangle -> Rational -> Rectangle
bottomRectangle :: Rectangle -> Rational -> Rectangle
bottomRectangle (Rectangle Position
rx Position
ry Dimension
rw Dimension
rh) Rational
f = Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle
                                            (Position
rx Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Dimension
rw Dimension -> Rational -> Dimension
<%> ((Rational
1Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
-Rational
f)Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
*(Rational
1Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
2))))
                                            (Position
ry Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Dimension
rh Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
- (Dimension
rh Dimension -> Rational -> Dimension
<%> ((Rational
1Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
-Rational
f)Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
*(Rational
1Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
2)))))
                                            (Dimension
rw Dimension -> Rational -> Dimension
<%> Rational
f) (Dimension
rh Dimension -> Rational -> Dimension
<%> ((Rational
1Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
-Rational
f)Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
*(Rational
1Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
2)))

leftRectangle :: Rectangle -> Rational -> Rectangle
leftRectangle :: Rectangle -> Rational -> Rectangle
leftRectangle (Rectangle Position
rx Position
ry Dimension
rw Dimension
rh) Rational
f = Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle
                                          Position
rx
                                           (Position
ry Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Dimension
rh Dimension -> Rational -> Dimension
<%> ((Rational
1Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
-Rational
f)Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
*(Rational
1Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
2))))
                                           (Dimension
rw Dimension -> Rational -> Dimension
<%> (Rational
1Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
2)) (Dimension
rh Dimension -> Rational -> Dimension
<%> Rational
f)