{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Layout.Circle
-- Description :  An elliptical, overlapping layout.
-- Copyright   :  (c) Peter De Wachter
-- License     :  BSD-style (see LICENSE)
--
-- Maintainer  :  Peter De Wachter <pdewacht@gmail.com>
-- Stability   :  unstable
-- Portability :  unportable
--
-- Circle is an elliptical, overlapping layout, by Peter De Wachter
--
-----------------------------------------------------------------------------

module XMonad.Layout.Circle (
                             -- * Usage
                             -- $usage
                             Circle (..)
                            ) where -- actually it's an ellipse

import XMonad.Prelude
import XMonad
import XMonad.StackSet (integrate, peek)

-- $usage
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Layout.Circle
--
-- Then edit your @layoutHook@ by adding the Circle layout:
--
-- > myLayout = Circle ||| Full ||| etc..
-- > main = xmonad def { layoutHook = myLayout }
--
-- For more detailed instructions on editing the layoutHook see:
--
-- "XMonad.Doc.Extending#Editing_the_layout_hook"

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

instance LayoutClass Circle Window where
    doLayout :: Circle Window
-> Rectangle
-> Stack Window
-> X ([(Window, Rectangle)], Maybe (Circle Window))
doLayout Circle Window
Circle Rectangle
r Stack Window
s = do [(Window, Rectangle)]
layout <- [(Window, Rectangle)] -> X [(Window, Rectangle)]
raiseFocus ([(Window, Rectangle)] -> X [(Window, Rectangle)])
-> [(Window, Rectangle)] -> X [(Window, Rectangle)]
forall a b. (a -> b) -> a -> b
$ Rectangle -> [Window] -> [(Window, Rectangle)]
forall a. Rectangle -> [a] -> [(a, Rectangle)]
circleLayout Rectangle
r ([Window] -> [(Window, Rectangle)])
-> [Window] -> [(Window, Rectangle)]
forall a b. (a -> b) -> a -> b
$ Stack Window -> [Window]
forall a. Stack a -> [a]
integrate Stack Window
s
                             ([(Window, Rectangle)], Maybe (Circle Window))
-> X ([(Window, Rectangle)], Maybe (Circle Window))
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Window, Rectangle)]
layout, Maybe (Circle Window)
forall a. Maybe a
Nothing)

circleLayout :: Rectangle -> [a] -> [(a, Rectangle)]
circleLayout :: Rectangle -> [a] -> [(a, Rectangle)]
circleLayout Rectangle
_ []     = []
circleLayout Rectangle
r (a
w:[a]
ws) = (a, Rectangle)
master (a, Rectangle) -> [(a, Rectangle)] -> [(a, Rectangle)]
forall a. a -> [a] -> [a]
: [(a, Rectangle)]
rest
    where master :: (a, Rectangle)
master = (a
w, Rectangle -> Rectangle
center Rectangle
r)
          rest :: [(a, Rectangle)]
rest   = [a] -> [Rectangle] -> [(a, Rectangle)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
ws ([Rectangle] -> [(a, Rectangle)])
-> [Rectangle] -> [(a, Rectangle)]
forall a b. (a -> b) -> a -> b
$ (Double -> Rectangle) -> [Double] -> [Rectangle]
forall a b. (a -> b) -> [a] -> [b]
map (Rectangle -> Double -> Rectangle
satellite Rectangle
r) [Double
0, Double
forall a. Floating a => a
pi Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
2 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
ws) ..]

raiseFocus :: [(Window, Rectangle)] -> X [(Window, Rectangle)]
raiseFocus :: [(Window, Rectangle)] -> X [(Window, Rectangle)]
raiseFocus [(Window, Rectangle)]
xs = do Maybe Window
focused <- (WindowSet -> X (Maybe Window)) -> X (Maybe Window)
forall a. (WindowSet -> X a) -> X a
withWindowSet (Maybe Window -> X (Maybe Window)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Window -> X (Maybe Window))
-> (WindowSet -> Maybe Window) -> WindowSet -> X (Maybe Window)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSet -> Maybe Window
forall i l a s sd. StackSet i l a s sd -> Maybe a
peek)
                   [(Window, Rectangle)] -> X [(Window, Rectangle)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Window, Rectangle)] -> X [(Window, Rectangle)])
-> [(Window, Rectangle)] -> X [(Window, Rectangle)]
forall a b. (a -> b) -> a -> b
$ case ((Window, Rectangle) -> Bool)
-> [(Window, Rectangle)] -> Maybe (Window, Rectangle)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((Maybe Window -> Maybe Window -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Window
focused) (Maybe Window -> Bool)
-> ((Window, Rectangle) -> Maybe Window)
-> (Window, Rectangle)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window -> Maybe Window
forall a. a -> Maybe a
Just (Window -> Maybe Window)
-> ((Window, Rectangle) -> Window)
-> (Window, Rectangle)
-> Maybe Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Window, Rectangle) -> Window
forall a b. (a, b) -> a
fst) [(Window, Rectangle)]
xs of
                              Just (Window, Rectangle)
x  -> (Window, Rectangle)
x (Window, Rectangle)
-> [(Window, Rectangle)] -> [(Window, Rectangle)]
forall a. a -> [a] -> [a]
: (Window, Rectangle)
-> [(Window, Rectangle)] -> [(Window, Rectangle)]
forall a. Eq a => a -> [a] -> [a]
delete (Window, Rectangle)
x [(Window, Rectangle)]
xs
                              Maybe (Window, Rectangle)
Nothing -> [(Window, Rectangle)]
xs

center :: Rectangle -> Rectangle
center :: Rectangle -> Rectangle
center (Rectangle Position
sx Position
sy Dimension
sw Dimension
sh) = Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
x Position
y Dimension
w Dimension
h
    where s :: Double
s = Double -> Double
forall a. Floating a => a -> a
sqrt Double
2 :: Double
          w :: Dimension
w = Double -> Dimension
forall a b. (RealFrac a, Integral b) => a -> b
round (Dimension -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
sw Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
s)
          h :: Dimension
h = Double -> Dimension
forall a b. (RealFrac a, Integral b) => a -> b
round (Dimension -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
sh Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
s)
          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
sw Dimension -> 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
sh Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
- Dimension
h) Position -> Position -> Position
forall a. Integral a => a -> a -> a
`div` Position
2

satellite :: Rectangle -> Double -> Rectangle
satellite :: Rectangle -> Double -> Rectangle
satellite (Rectangle Position
sx Position
sy Dimension
sw Dimension
sh) Double
a = Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle (Position
sx Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Double -> Position
forall a b. (RealFrac a, Integral b) => a -> b
round (Double
rx Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
rx Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall a. Floating a => a -> a
cos Double
a))
                                                (Position
sy Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Double -> Position
forall a b. (RealFrac a, Integral b) => a -> b
round (Double
ry Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
ry Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall a. Floating a => a -> a
sin Double
a))
                                                Dimension
w Dimension
h
    where rx :: Double
rx = Dimension -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Dimension
sw Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
- Dimension
w) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2
          ry :: Double
ry = Dimension -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Dimension
sh Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
- Dimension
h) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2
          w :: Dimension
w = Dimension
sw Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
* Dimension
10 Dimension -> Dimension -> Dimension
forall a. Integral a => a -> a -> a
`div` Dimension
25
          h :: Dimension
h = Dimension
sh Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
* Dimension
10 Dimension -> Dimension -> Dimension
forall a. Integral a => a -> a -> a
`div` Dimension
25