{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Layout.Roledex
-- Description :  A completely pointless layout which acts like Microsoft's Flip 3D.
-- Copyright   :  (c) tim.thelion@gmail.com
-- License     :  BSD
--
-- Maintainer  :  tim.thelion@gmail.com
-- Stability   :  unstable
-- Portability :  unportable
--
-- This is a completely pointless layout which acts like Microsoft's Flip 3D
-----------------------------------------------------------------------------

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

    -- * Screenshots
    -- $screenshot
    Roledex(Roledex)) where

import XMonad
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.Roledex
--
-- Then edit your @layoutHook@ by adding the Roledex layout:
--
-- > myLayout =  Roledex ||| etc..
-- > main = xmonad def { layoutHook = myLayout }
--
-- 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
-- <<http://www.timthelion.com/rolodex.png>>

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

instance LayoutClass Roledex Window where
    doLayout :: Roledex Window
-> Rectangle
-> Stack Window
-> X ([(Window, Rectangle)], Maybe (Roledex Window))
doLayout Roledex Window
_ = forall a.
Eq a =>
Rectangle -> Stack a -> X ([(a, Rectangle)], Maybe (Roledex a))
roledexLayout

roledexLayout :: Eq a => Rectangle -> W.Stack a -> X ([(a, Rectangle)], Maybe (Roledex a))
roledexLayout :: forall a.
Eq a =>
Rectangle -> Stack a -> X ([(a, Rectangle)], Maybe (Roledex a))
roledexLayout Rectangle
sc Stack a
ws = forall (m :: * -> *) a. Monad m => a -> m a
return ([(forall a. Stack a -> a
W.focus Stack a
ws, Rectangle
mainPane)] forall a. [a] -> [a] -> [a]
++
                              forall a b. [a] -> [b] -> [(a, b)]
zip [a]
ups [Rectangle]
tops forall a. [a] -> [a] -> [a]
++
                              forall a. [a] -> [a]
reverse (forall a b. [a] -> [b] -> [(a, b)]
zip [a]
dns [Rectangle]
bottoms)
                               ,forall a. Maybe a
Nothing)
 where ups :: [a]
ups    = forall a. Stack a -> [a]
W.up Stack a
ws
       dns :: [a]
dns    = forall a. Stack a -> [a]
W.down Stack a
ws
       c :: Int
c = forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
ups forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
dns
       rect :: Rectangle
rect = forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall r. RealFrac r => r -> Rectangle -> (Rectangle, Rectangle)
splitHorizontallyBy (Int
2forall a. Integral a => a -> a -> Ratio a
%Int
3 :: Ratio Int) forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst (forall r. RealFrac r => r -> Rectangle -> (Rectangle, Rectangle)
splitVerticallyBy (Int
2forall a. Integral a => a -> a -> Ratio a
%Int
3 :: Ratio Int) Rectangle
sc)
       gw :: Dimension
gw = forall a. Integral a => a -> a -> a
div' (Dimension
w forall a. Num a => a -> a -> a
- Dimension
rw) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
c)
            where
            (Rectangle Position
_ Position
_ Dimension
w Dimension
_) = Rectangle
sc
            (Rectangle Position
_ Position
_ Dimension
rw Dimension
_) = Rectangle
rect
       gh :: Dimension
gh = forall a. Integral a => a -> a -> a
div' (Dimension
h forall a. Num a => a -> a -> a
- Dimension
rh) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
c)
            where
            (Rectangle Position
_ Position
_ Dimension
_ Dimension
h) = Rectangle
sc
            (Rectangle Position
_ Position
_ Dimension
_ Dimension
rh) = Rectangle
rect
       mainPane :: Rectangle
mainPane = forall {a} {a}.
(Integral a, Integral a) =>
a -> a -> Rectangle -> Rectangle
mrect (Dimension
gw forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
c) (Dimension
gh forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
c) Rectangle
rect
       mrect :: a -> a -> Rectangle -> Rectangle
mrect  a
mx a
my (Rectangle Position
x Position
y Dimension
w Dimension
h) = Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle (Position
x forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral a
mx) (Position
y forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral a
my) Dimension
w Dimension
h
       tops :: [Rectangle]
tops    = forall a b. (a -> b) -> [a] -> [b]
map forall {a}. Integral a => a -> Rectangle
f forall a b. (a -> b) -> a -> b
$ forall {t}. (Ord t, Num t) => t -> t -> [t]
cd Int
c (forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
dns)
       bottoms :: [Rectangle]
bottoms = forall a b. (a -> b) -> [a] -> [b]
map forall {a}. Integral a => a -> Rectangle
f [Int
0..(forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
dns)]
       f :: a -> Rectangle
f a
n = forall {a} {a}.
(Integral a, Integral a) =>
a -> a -> Rectangle -> Rectangle
mrect (Dimension
gw forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n) (Dimension
gh forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n) Rectangle
rect
       cd :: t -> t -> [t]
cd t
n t
m = if t
n forall a. Ord a => a -> a -> Bool
> t
m
                then (t
n forall a. Num a => a -> a -> a
- t
1) forall a. a -> [a] -> [a]
: t -> t -> [t]
cd (t
nforall a. Num a => a -> a -> a
-t
1) t
m
                else []

div' :: Integral a => a -> a -> a
div' :: forall a. Integral a => a -> a -> a
div' a
_ a
0 = a
0
div' a
n a
o = forall a. Integral a => a -> a -> a
div a
n a
o