{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Layout.OneBig
-- Description :  Place one window at top left corner, and other windows at the top.
-- Copyright   :  (c) 2009 Ilya Portnov
-- License     :  BSD3-style (see LICENSE)
--
-- Maintainer  :  Ilya Portnov <portnov84@rambler.ru>
-- Stability   :  unstable
-- Portability :  unportable
--
-- Provides layout named OneBig. It places one (master) window at top left corner of screen, and other (slave) windows at top
--
-----------------------------------------------------------------------------

module XMonad.Layout.OneBig (
                             -- * Usage
                             -- $usage
                             OneBig (..)
                            ) where
import XMonad
import qualified XMonad.StackSet as W

-- $usage
-- This module defines layout named OneBig. It places one (master)
-- window at top left, and other (slave) windows at right and at
-- bottom of master. It tries to give equal space for each slave
-- window.
--
-- You can use this module by adding following in your @xmonad.hs@:
--
-- > import XMonad.Layout.OneBig
--
-- Then add layouts to your layoutHook:
--
-- > myLayoutHook = OneBig (3/4) (3/4) ||| ...
--
-- In this example, master window will occupy 3/4 of screen width and
-- 3/4 of screen height.

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

instance LayoutClass OneBig a where
  pureLayout :: OneBig a -> Rectangle -> Stack a -> [(a, Rectangle)]
pureLayout = forall a. OneBig a -> Rectangle -> Stack a -> [(a, Rectangle)]
oneBigLayout
  pureMessage :: OneBig a -> SomeMessage -> Maybe (OneBig a)
pureMessage = forall a. OneBig a -> SomeMessage -> Maybe (OneBig a)
oneBigMessage

-- | Processes Shrink/Expand messages
oneBigMessage :: OneBig a -> SomeMessage -> Maybe (OneBig a)
oneBigMessage :: forall a. OneBig a -> SomeMessage -> Maybe (OneBig a)
oneBigMessage (OneBig Float
cx Float
cy) SomeMessage
m = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {a}. Resize -> OneBig a
resize (forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m)
    where resize :: Resize -> OneBig a
resize Resize
Shrink = forall a. Float -> Float -> OneBig a
OneBig (Float
cxforall a. Num a => a -> a -> a
-Float
delta) (Float
cyforall a. Num a => a -> a -> a
-Float
delta)
          resize Resize
Expand = forall a. Float -> Float -> OneBig a
OneBig (Float
cxforall a. Num a => a -> a -> a
+Float
delta) (Float
cyforall a. Num a => a -> a -> a
+Float
delta)
          delta :: Float
delta = Float
3forall a. Fractional a => a -> a -> a
/Float
100

-- | Main layout function
oneBigLayout :: OneBig a -> Rectangle -> W.Stack a -> [(a, Rectangle)]
oneBigLayout :: forall a. OneBig a -> Rectangle -> Stack a -> [(a, Rectangle)]
oneBigLayout (OneBig Float
cx Float
cy) Rectangle
rect Stack a
stack =
  let ws :: [a]
ws = forall a. Stack a -> [a]
W.integrate Stack a
stack
      n :: Int
n  = forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
ws
   in case [a]
ws of
    []               -> []
    (a
master : [a]
other) -> [(a
master,Rectangle
masterRect)]
                     forall a. [a] -> [a] -> [a]
++ forall a. Rectangle -> [a] -> [(a, Rectangle)]
divideBottom Rectangle
bottomRect [a]
bottomWs
                     forall a. [a] -> [a] -> [a]
++ forall a. Rectangle -> [a] -> [(a, Rectangle)]
divideRight Rectangle
rightRect [a]
rightWs
     where
      ht :: Rectangle -> Dimension
ht (Rectangle Position
_ Position
_ Dimension
_ Dimension
hh) = Dimension
hh
      wd :: Rectangle -> Dimension
wd (Rectangle Position
_ Position
_ Dimension
ww Dimension
_) = Dimension
ww
      h' :: Dimension
h' = forall a b. (RealFrac a, Integral b) => a -> b
round (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Rectangle -> Dimension
ht Rectangle
rect)forall a. Num a => a -> a -> a
*Float
cy)
      w :: Dimension
w = Rectangle -> Dimension
wd Rectangle
rect
      m :: Int
m = Int -> Dimension -> Dimension -> Int
calcBottomWs Int
n Dimension
w Dimension
h'
      bottomWs :: [a]
bottomWs = forall a. Int -> [a] -> [a]
take Int
m [a]
other
      rightWs :: [a]
rightWs = forall a. Int -> [a] -> [a]
drop Int
m [a]
other
      masterRect :: Rectangle
masterRect = Int -> Int -> Float -> Float -> Rectangle -> Rectangle
cmaster Int
n Int
m Float
cx Float
cy Rectangle
rect
      bottomRect :: Rectangle
bottomRect = Float -> Rectangle -> Rectangle
cbottom Float
cy Rectangle
rect
      rightRect :: Rectangle
rightRect  = Float -> Float -> Rectangle -> Rectangle
cright Float
cx Float
cy Rectangle
rect

-- | Calculate how many windows must be placed at bottom
calcBottomWs :: Int -> Dimension -> Dimension -> Int
calcBottomWs :: Int -> Dimension -> Dimension -> Int
calcBottomWs Int
n Dimension
w Dimension
h' = case Int
n of
                        Int
1 -> Int
0
                        Int
2 -> Int
1
                        Int
3 -> Int
2
                        Int
4 -> Int
2
                        Int
_ -> forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
wforall a. Num a => a -> a -> a
*(Int
nforall a. Num a => a -> a -> a
-Int
1) forall a. Integral a => a -> a -> a
`div` forall a b. (Integral a, Num b) => a -> b
fromIntegral (Dimension
h'forall a. Num a => a -> a -> a
+forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
w)

-- | Calculate rectangle for master window
cmaster:: Int -> Int -> Float -> Float -> Rectangle -> Rectangle
cmaster :: Int -> Int -> Float -> Float -> Rectangle -> Rectangle
cmaster Int
n Int
m Float
cx Float
cy (Rectangle Position
x Position
y Dimension
sw Dimension
sh) = Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
x Position
y Dimension
w Dimension
h
    where w :: Dimension
w = if Int
n forall a. Ord a => a -> a -> Bool
> Int
mforall a. Num a => a -> a -> a
+Int
1 then
                forall a b. (RealFrac a, Integral b) => a -> b
round (forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
swforall a. Num a => a -> a -> a
*Float
cx)
              else
                Dimension
sw
          h :: Dimension
h = if Int
n forall a. Ord a => a -> a -> Bool
> Int
1 then
                forall a b. (RealFrac a, Integral b) => a -> b
round (forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
shforall a. Num a => a -> a -> a
*Float
cy)
              else
                Dimension
sh

-- | Calculate rectangle for bottom windows
cbottom:: Float -> Rectangle -> Rectangle
cbottom :: Float -> Rectangle -> Rectangle
cbottom Float
cy (Rectangle Position
sx Position
sy Dimension
sw Dimension
sh) = Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
sx Position
y Dimension
sw Dimension
h
    where h :: Dimension
h = forall a b. (RealFrac a, Integral b) => a -> b
round (forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
shforall a. Num a => a -> a -> a
*(Float
1forall a. Num a => a -> a -> a
-Float
cy))
          y :: Position
y = forall a b. (RealFrac a, Integral b) => a -> b
round (forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
shforall a. Num a => a -> a -> a
*Float
cyforall a. Num a => a -> a -> a
+forall a b. (Integral a, Num b) => a -> b
fromIntegral Position
sy)

-- | Calculate rectangle for right windows
cright:: Float -> Float -> Rectangle -> Rectangle
cright :: Float -> Float -> Rectangle -> Rectangle
cright Float
cx Float
cy (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 = forall a b. (RealFrac a, Integral b) => a -> b
round (forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
swforall a. Num a => a -> a -> a
*(Float
1forall a. Num a => a -> a -> a
-Float
cx))
          x :: Position
x = forall a b. (RealFrac a, Integral b) => a -> b
round (forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
swforall a. Num a => a -> a -> a
*Float
cxforall a. Num a => a -> a -> a
+forall a b. (Integral a, Num b) => a -> b
fromIntegral Position
sx)
          h :: Dimension
h = forall a b. (RealFrac a, Integral b) => a -> b
round (forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
shforall a. Num a => a -> a -> a
*Float
cy)

-- | Divide bottom rectangle between windows
divideBottom :: Rectangle -> [a] -> [(a, Rectangle)]
divideBottom :: forall a. Rectangle -> [a] -> [(a, Rectangle)]
divideBottom (Rectangle Position
x Position
y Dimension
w Dimension
h) [a]
ws = forall a b. [a] -> [b] -> [(a, b)]
zip [a]
ws [Rectangle]
rects
    where n :: Int
n = forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
ws
          oneW :: Int
oneW = forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
w forall a. Integral a => a -> a -> a
`div` Int
n
          oneRect :: Rectangle
oneRect = Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
x Position
y (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
oneW) Dimension
h
          rects :: [Rectangle]
rects = forall a. Int -> [a] -> [a]
take Int
n forall a b. (a -> b) -> a -> b
$ forall a. (a -> a) -> a -> [a]
iterate (Position -> Rectangle -> Rectangle
shiftR (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
oneW)) Rectangle
oneRect

-- | Divide right rectangle between windows
divideRight :: Rectangle -> [a] -> [(a, Rectangle)]
divideRight :: forall a. Rectangle -> [a] -> [(a, Rectangle)]
divideRight (Rectangle Position
x Position
y Dimension
w Dimension
h) [a]
ws = if Int
nforall a. Eq a => a -> a -> Bool
==Int
0 then [] else forall a b. [a] -> [b] -> [(a, b)]
zip [a]
ws [Rectangle]
rects
    where n :: Int
n = forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
ws
          oneH :: Int
oneH = forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
h forall a. Integral a => a -> a -> a
`div` Int
n
          oneRect :: Rectangle
oneRect = Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
x Position
y Dimension
w (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
oneH)
          rects :: [Rectangle]
rects = forall a. Int -> [a] -> [a]
take Int
n forall a b. (a -> b) -> a -> b
$ forall a. (a -> a) -> a -> [a]
iterate (Position -> Rectangle -> Rectangle
shiftB (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
oneH)) Rectangle
oneRect

-- | Shift rectangle right
shiftR :: Position -> Rectangle -> Rectangle
shiftR :: Position -> Rectangle -> Rectangle
shiftR Position
s (Rectangle Position
x Position
y Dimension
w Dimension
h) = Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle (Position
xforall a. Num a => a -> a -> a
+Position
s) Position
y Dimension
w Dimension
h

-- | Shift rectangle bottom
shiftB :: Position -> Rectangle -> Rectangle
shiftB :: Position -> Rectangle -> Rectangle
shiftB Position
s (Rectangle Position
x Position
y Dimension
w Dimension
h) = Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
x (Position
yforall a. Num a => a -> a -> a
+Position
s) Dimension
w Dimension
h