{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Layout.CenteredMaster
-- Description :  Place the master pane on top of other windows; in the center or top right.
-- Copyright   :  (c) 2009 Ilya Portnov
-- License     :  BSD-style (see xmonad/LICENSE)
--
-- Maintainer  :  Ilya Portnov <portnov84@rambler.ru>
-- Stability   :  unstable
-- Portability :  unportable
--
-- Two layout modifiers. centerMaster places master window at center,
-- on top of all other windows, which are managed by base layout.
-- topRightMaster is similar, but places master window in top right corner
-- instead of center.
--
-----------------------------------------------------------------------------

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

         centerMaster,
         topRightMaster,
         CenteredMaster, TopRightMaster,
         ) where

import XMonad
import XMonad.Layout.LayoutModifier
import qualified XMonad.StackSet as W

import Control.Arrow (first)

-- $usage
-- This module defines two new layout modifiers: centerMaster and topRightMaster.
-- centerMaster places master window at center of screen, on top of others.
-- All other windows in background are managed by base layout.
-- topRightMaster is like centerMaster, but places master window in top right corner instead of center.
--
-- Yo can use this module by adding folowing in your @xmonad.hs@:
--
-- > import XMonad.Layout.CenteredMaster
--
-- Then add layouts to your layoutHook:
--
-- > myLayoutHook = centerMaster Grid ||| ...

-- | Function that decides where master window should be placed
type Positioner = Rectangle -> Rectangle

-- | Data type for LayoutModifier
data CenteredMaster a = CenteredMaster deriving (ReadPrec [CenteredMaster a]
ReadPrec (CenteredMaster a)
Int -> ReadS (CenteredMaster a)
ReadS [CenteredMaster a]
(Int -> ReadS (CenteredMaster a))
-> ReadS [CenteredMaster a]
-> ReadPrec (CenteredMaster a)
-> ReadPrec [CenteredMaster a]
-> Read (CenteredMaster a)
forall a. ReadPrec [CenteredMaster a]
forall a. ReadPrec (CenteredMaster a)
forall a. Int -> ReadS (CenteredMaster a)
forall a. ReadS [CenteredMaster a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CenteredMaster a]
$creadListPrec :: forall a. ReadPrec [CenteredMaster a]
readPrec :: ReadPrec (CenteredMaster a)
$creadPrec :: forall a. ReadPrec (CenteredMaster a)
readList :: ReadS [CenteredMaster a]
$creadList :: forall a. ReadS [CenteredMaster a]
readsPrec :: Int -> ReadS (CenteredMaster a)
$creadsPrec :: forall a. Int -> ReadS (CenteredMaster a)
Read,Int -> CenteredMaster a -> ShowS
[CenteredMaster a] -> ShowS
CenteredMaster a -> String
(Int -> CenteredMaster a -> ShowS)
-> (CenteredMaster a -> String)
-> ([CenteredMaster a] -> ShowS)
-> Show (CenteredMaster a)
forall a. Int -> CenteredMaster a -> ShowS
forall a. [CenteredMaster a] -> ShowS
forall a. CenteredMaster a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CenteredMaster a] -> ShowS
$cshowList :: forall a. [CenteredMaster a] -> ShowS
show :: CenteredMaster a -> String
$cshow :: forall a. CenteredMaster a -> String
showsPrec :: Int -> CenteredMaster a -> ShowS
$cshowsPrec :: forall a. Int -> CenteredMaster a -> ShowS
Show)

instance LayoutModifier CenteredMaster Window where
  modifyLayout :: CenteredMaster Window
-> Workspace String (l Window) Window
-> Rectangle
-> X ([(Window, Rectangle)], Maybe (l Window))
modifyLayout CenteredMaster Window
CenteredMaster = Positioner
-> Workspace String (l Window) Window
-> Rectangle
-> X ([(Window, Rectangle)], Maybe (l Window))
forall (l :: * -> *) a.
(LayoutClass l a, Eq a) =>
Positioner
-> Workspace String (l a) a
-> Rectangle
-> X ([(a, Rectangle)], Maybe (l a))
applyPosition (Float -> Float -> Positioner
center (Float
5Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/Float
7) (Float
5Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/Float
7))

data TopRightMaster a = TopRightMaster deriving (ReadPrec [TopRightMaster a]
ReadPrec (TopRightMaster a)
Int -> ReadS (TopRightMaster a)
ReadS [TopRightMaster a]
(Int -> ReadS (TopRightMaster a))
-> ReadS [TopRightMaster a]
-> ReadPrec (TopRightMaster a)
-> ReadPrec [TopRightMaster a]
-> Read (TopRightMaster a)
forall a. ReadPrec [TopRightMaster a]
forall a. ReadPrec (TopRightMaster a)
forall a. Int -> ReadS (TopRightMaster a)
forall a. ReadS [TopRightMaster a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TopRightMaster a]
$creadListPrec :: forall a. ReadPrec [TopRightMaster a]
readPrec :: ReadPrec (TopRightMaster a)
$creadPrec :: forall a. ReadPrec (TopRightMaster a)
readList :: ReadS [TopRightMaster a]
$creadList :: forall a. ReadS [TopRightMaster a]
readsPrec :: Int -> ReadS (TopRightMaster a)
$creadsPrec :: forall a. Int -> ReadS (TopRightMaster a)
Read,Int -> TopRightMaster a -> ShowS
[TopRightMaster a] -> ShowS
TopRightMaster a -> String
(Int -> TopRightMaster a -> ShowS)
-> (TopRightMaster a -> String)
-> ([TopRightMaster a] -> ShowS)
-> Show (TopRightMaster a)
forall a. Int -> TopRightMaster a -> ShowS
forall a. [TopRightMaster a] -> ShowS
forall a. TopRightMaster a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TopRightMaster a] -> ShowS
$cshowList :: forall a. [TopRightMaster a] -> ShowS
show :: TopRightMaster a -> String
$cshow :: forall a. TopRightMaster a -> String
showsPrec :: Int -> TopRightMaster a -> ShowS
$cshowsPrec :: forall a. Int -> TopRightMaster a -> ShowS
Show)

instance LayoutModifier TopRightMaster Window where
  modifyLayout :: TopRightMaster Window
-> Workspace String (l Window) Window
-> Rectangle
-> X ([(Window, Rectangle)], Maybe (l Window))
modifyLayout TopRightMaster Window
TopRightMaster = Positioner
-> Workspace String (l Window) Window
-> Rectangle
-> X ([(Window, Rectangle)], Maybe (l Window))
forall (l :: * -> *) a.
(LayoutClass l a, Eq a) =>
Positioner
-> Workspace String (l a) a
-> Rectangle
-> X ([(a, Rectangle)], Maybe (l a))
applyPosition (Float -> Float -> Positioner
topRight (Float
3Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/Float
7) (Float
1Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/Float
2))

-- | Modifier that puts master window in center, other windows in background
-- are managed by given layout
centerMaster :: LayoutClass l a => l a -> ModifiedLayout CenteredMaster l a
centerMaster :: l a -> ModifiedLayout CenteredMaster l a
centerMaster = CenteredMaster a -> l a -> ModifiedLayout CenteredMaster l a
forall (m :: * -> *) (l :: * -> *) a.
m a -> l a -> ModifiedLayout m l a
ModifiedLayout CenteredMaster a
forall a. CenteredMaster a
CenteredMaster

-- | Modifier that puts master window in top right corner, other windows in background
-- are managed by given layout
topRightMaster :: LayoutClass l a => l a -> ModifiedLayout TopRightMaster l a
topRightMaster :: l a -> ModifiedLayout TopRightMaster l a
topRightMaster = TopRightMaster a -> l a -> ModifiedLayout TopRightMaster l a
forall (m :: * -> *) (l :: * -> *) a.
m a -> l a -> ModifiedLayout m l a
ModifiedLayout TopRightMaster a
forall a. TopRightMaster a
TopRightMaster

-- | Internal function, doing main job
applyPosition :: (LayoutClass l a, Eq a) =>
                    Positioner
                 -> W.Workspace WorkspaceId (l a) a
                 -> Rectangle
                 -> X ([(a, Rectangle)], Maybe (l a))

applyPosition :: Positioner
-> Workspace String (l a) a
-> Rectangle
-> X ([(a, Rectangle)], Maybe (l a))
applyPosition Positioner
pos Workspace String (l a) a
wksp Rectangle
rect = do
  let stack :: Maybe (Stack a)
stack = Workspace String (l a) a -> Maybe (Stack a)
forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack Workspace String (l a) a
wksp
  let ws :: [a]
ws = Maybe (Stack a) -> [a]
forall a. Maybe (Stack a) -> [a]
W.integrate' Maybe (Stack a)
stack
  if [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
ws then
     Workspace String (l a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (l a))
forall (layout :: * -> *) a.
LayoutClass layout a =>
Workspace String (layout a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
runLayout Workspace String (l a) a
wksp Rectangle
rect
     else do
       let firstW :: a
firstW = [a] -> a
forall a. [a] -> a
head [a]
ws
       let other :: [a]
other  = [a] -> [a]
forall a. [a] -> [a]
tail [a]
ws
       let filtStack :: Maybe (Stack a)
filtStack = Maybe (Stack a)
stack Maybe (Stack a) -> (Stack a -> Maybe (Stack a)) -> Maybe (Stack a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (a -> Bool) -> Stack a -> Maybe (Stack a)
forall a. (a -> Bool) -> Stack a -> Maybe (Stack a)
W.filter (a
firstW a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/=)
       ([(a, Rectangle)], Maybe (l a))
wrs <- Workspace String (l a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (l a))
forall (layout :: * -> *) a.
LayoutClass layout a =>
Workspace String (layout a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
runLayout (Workspace String (l a) a
wksp {stack :: Maybe (Stack a)
W.stack = Maybe (Stack a)
filtStack}) Rectangle
rect
       ([(a, Rectangle)], Maybe (l a))
-> X ([(a, Rectangle)], Maybe (l a))
forall (m :: * -> *) a. Monad m => a -> m a
return (([(a, Rectangle)], Maybe (l a))
 -> X ([(a, Rectangle)], Maybe (l a)))
-> ([(a, Rectangle)], Maybe (l a))
-> X ([(a, Rectangle)], Maybe (l a))
forall a b. (a -> b) -> a -> b
$ ([(a, Rectangle)] -> [(a, Rectangle)])
-> ([(a, Rectangle)], Maybe (l a))
-> ([(a, Rectangle)], Maybe (l a))
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first ((a
firstW, Positioner -> [a] -> Positioner
forall a. Positioner -> [a] -> Positioner
place Positioner
pos [a]
other Rectangle
rect) (a, Rectangle) -> [(a, Rectangle)] -> [(a, Rectangle)]
forall a. a -> [a] -> [a]
:) ([(a, Rectangle)], Maybe (l a))
wrs

-- | Place master window (it's Rectangle is given), using the given Positioner.
-- If second argument is empty (that is, there is only one window on workspace),
-- place that window fullscreen.
place :: Positioner -> [a] -> Rectangle -> Rectangle
place :: Positioner -> [a] -> Positioner
place Positioner
_ [] Rectangle
rect = Rectangle
rect
place Positioner
pos [a]
_ Rectangle
rect = Positioner
pos Rectangle
rect

-- | Function that calculates Rectangle at top right corner of given Rectangle
topRight :: Float -> Float -> Rectangle -> Rectangle
topRight :: Float -> Float -> Positioner
topRight Float
rx Float
ry (Rectangle Position
sx Position
sy Dimension
sw Dimension
sh) = Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
x Position
sy Dimension
w Dimension
h
  where w :: Dimension
w = Float -> Dimension
forall a b. (RealFrac a, Integral b) => a -> b
round (Dimension -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
sw Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
rx)
        h :: Dimension
h = Float -> Dimension
forall a b. (RealFrac a, Integral b) => a -> b
round (Dimension -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
sh Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
ry)
        x :: Position
x = Position
sx Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Dimension
swDimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
-Dimension
w)

-- | Function that calculates Rectangle at center of given Rectangle.
center :: Float -> Float -> Rectangle -> Rectangle
center :: Float -> Float -> Positioner
center Float
rx Float
ry (Rectangle Position
sx Position
sy Dimension
sw Dimension
sh) = Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
x Position
y Dimension
w Dimension
h
  where w :: Dimension
w = Float -> Dimension
forall a b. (RealFrac a, Integral b) => a -> b
round (Dimension -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
sw Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
rx)
        h :: Dimension
h = Float -> Dimension
forall a b. (RealFrac a, Integral b) => a -> b
round (Dimension -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
sh Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
ry)
        x :: Position
x = Position
sx Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Dimension
swDimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
-Dimension
w) Position -> Position -> Position
forall a. Integral a => a -> a -> a
`div` Position
2
        y :: Position
y = Position
sy Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Dimension
shDimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
-Dimension
h) Position -> Position -> Position
forall a. Integral a => a -> a -> a
`div` Position
2