{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Layout.Spiral
-- Description :  A spiral tiling layout.
-- Copyright   :  (c) Joe Thornber <joe.thornber@gmail.com>
-- License     :  BSD3-style (see LICENSE)
--
-- Maintainer  :  Joe Thornber <joe.thornber@gmail.com>
-- Stability   :  stable
-- Portability :  portable
--
-- A spiral tiling layout.
--
-----------------------------------------------------------------------------

module XMonad.Layout.Spiral (
                             -- * Usage
                             -- $usage
                             spiral
                            , spiralWithDir
                            , Rotation (..)
                            , Direction (..)

                            , SpiralWithDir
                            ) where

import Data.Ratio
import XMonad hiding ( Rotation )
import XMonad.StackSet ( integrate )

-- $usage
-- You can use this module with the following in your @xmonad.hs@:
--
-- > import XMonad.Layout.Spiral
--
-- Then edit your @layoutHook@ by adding the Spiral layout:
--
-- > myLayout =  spiral (6/7) ||| 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".

fibs :: [Integer]
fibs :: [Integer]
fibs = Integer
1 Integer -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
: Integer
1 Integer -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
: (Integer -> Integer -> Integer)
-> [Integer] -> [Integer] -> [Integer]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(+) [Integer]
fibs (Int -> [Integer] -> [Integer]
forall a. Int -> [a] -> [a]
drop Int
1 [Integer]
fibs)

mkRatios :: [Integer] -> [Rational]
mkRatios :: [Integer] -> [Rational]
mkRatios (Integer
x1:Integer
x2:[Integer]
xs) = (Integer
x1 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
x2) Rational -> [Rational] -> [Rational]
forall a. a -> [a] -> [a]
: [Integer] -> [Rational]
mkRatios (Integer
x2Integer -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
:[Integer]
xs)
mkRatios [Integer]
_ = []

data Rotation = CW | CCW deriving (ReadPrec [Rotation]
ReadPrec Rotation
Int -> ReadS Rotation
ReadS [Rotation]
(Int -> ReadS Rotation)
-> ReadS [Rotation]
-> ReadPrec Rotation
-> ReadPrec [Rotation]
-> Read Rotation
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Rotation
readsPrec :: Int -> ReadS Rotation
$creadList :: ReadS [Rotation]
readList :: ReadS [Rotation]
$creadPrec :: ReadPrec Rotation
readPrec :: ReadPrec Rotation
$creadListPrec :: ReadPrec [Rotation]
readListPrec :: ReadPrec [Rotation]
Read, Int -> Rotation -> ShowS
[Rotation] -> ShowS
Rotation -> String
(Int -> Rotation -> ShowS)
-> (Rotation -> String) -> ([Rotation] -> ShowS) -> Show Rotation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Rotation -> ShowS
showsPrec :: Int -> Rotation -> ShowS
$cshow :: Rotation -> String
show :: Rotation -> String
$cshowList :: [Rotation] -> ShowS
showList :: [Rotation] -> ShowS
Show)
data Direction = East | South | West | North deriving (Direction -> Direction -> Bool
(Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool) -> Eq Direction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Direction -> Direction -> Bool
== :: Direction -> Direction -> Bool
$c/= :: Direction -> Direction -> Bool
/= :: Direction -> Direction -> Bool
Eq, Int -> Direction
Direction -> Int
Direction -> [Direction]
Direction -> Direction
Direction -> Direction -> [Direction]
Direction -> Direction -> Direction -> [Direction]
(Direction -> Direction)
-> (Direction -> Direction)
-> (Int -> Direction)
-> (Direction -> Int)
-> (Direction -> [Direction])
-> (Direction -> Direction -> [Direction])
-> (Direction -> Direction -> [Direction])
-> (Direction -> Direction -> Direction -> [Direction])
-> Enum Direction
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Direction -> Direction
succ :: Direction -> Direction
$cpred :: Direction -> Direction
pred :: Direction -> Direction
$ctoEnum :: Int -> Direction
toEnum :: Int -> Direction
$cfromEnum :: Direction -> Int
fromEnum :: Direction -> Int
$cenumFrom :: Direction -> [Direction]
enumFrom :: Direction -> [Direction]
$cenumFromThen :: Direction -> Direction -> [Direction]
enumFromThen :: Direction -> Direction -> [Direction]
$cenumFromTo :: Direction -> Direction -> [Direction]
enumFromTo :: Direction -> Direction -> [Direction]
$cenumFromThenTo :: Direction -> Direction -> Direction -> [Direction]
enumFromThenTo :: Direction -> Direction -> Direction -> [Direction]
Enum, ReadPrec [Direction]
ReadPrec Direction
Int -> ReadS Direction
ReadS [Direction]
(Int -> ReadS Direction)
-> ReadS [Direction]
-> ReadPrec Direction
-> ReadPrec [Direction]
-> Read Direction
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Direction
readsPrec :: Int -> ReadS Direction
$creadList :: ReadS [Direction]
readList :: ReadS [Direction]
$creadPrec :: ReadPrec Direction
readPrec :: ReadPrec Direction
$creadListPrec :: ReadPrec [Direction]
readListPrec :: ReadPrec [Direction]
Read, Int -> Direction -> ShowS
[Direction] -> ShowS
Direction -> String
(Int -> Direction -> ShowS)
-> (Direction -> String)
-> ([Direction] -> ShowS)
-> Show Direction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Direction -> ShowS
showsPrec :: Int -> Direction -> ShowS
$cshow :: Direction -> String
show :: Direction -> String
$cshowList :: [Direction] -> ShowS
showList :: [Direction] -> ShowS
Show)

blend :: Rational -> [Rational] -> [Rational]
blend :: Rational -> [Rational] -> [Rational]
blend Rational
scale [Rational]
ratios = (Rational -> Rational -> Rational)
-> [Rational] -> [Rational] -> [Rational]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
(+) [Rational]
ratios [Rational]
scaleFactors
    where
      len :: Int
len = [Rational] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Rational]
ratios
      step :: Rational
step = (Rational
scale Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- (Integer
1 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
1)) Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Int -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len
      scaleFactors :: [Rational]
scaleFactors = (Rational -> Rational) -> [Rational] -> [Rational]
forall a b. (a -> b) -> [a] -> [b]
map (Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
step) ([Rational] -> [Rational])
-> ([Rational] -> [Rational]) -> [Rational] -> [Rational]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Rational] -> [Rational]
forall a. [a] -> [a]
reverse ([Rational] -> [Rational])
-> ([Rational] -> [Rational]) -> [Rational] -> [Rational]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Rational] -> [Rational]
forall a. Int -> [a] -> [a]
take Int
len ([Rational] -> [Rational]) -> [Rational] -> [Rational]
forall a b. (a -> b) -> a -> b
$ [Rational
0..]

-- | A spiral layout.  The parameter controls the size ratio between
--   successive windows in the spiral.  Sensible values range from 0
--   up to the aspect ratio of your monitor (often 4\/3).
--
--   By default, the spiral is counterclockwise, starting to the east.
--   See also 'spiralWithDir'.
spiral :: Rational -> SpiralWithDir a
spiral :: forall a. Rational -> SpiralWithDir a
spiral = Direction -> Rotation -> Rational -> SpiralWithDir a
forall a. Direction -> Rotation -> Rational -> SpiralWithDir a
spiralWithDir Direction
East Rotation
CW

-- | Create a spiral layout, specifying the starting cardinal direction,
--   the spiral direction (clockwise or counterclockwise), and the
--   size ratio.
spiralWithDir :: Direction -> Rotation -> Rational -> SpiralWithDir a
spiralWithDir :: forall a. Direction -> Rotation -> Rational -> SpiralWithDir a
spiralWithDir = Direction -> Rotation -> Rational -> SpiralWithDir a
forall a. Direction -> Rotation -> Rational -> SpiralWithDir a
SpiralWithDir

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

instance LayoutClass SpiralWithDir a where
    pureLayout :: SpiralWithDir a -> Rectangle -> Stack a -> [(a, Rectangle)]
pureLayout (SpiralWithDir Direction
dir Rotation
rot Rational
scale) Rectangle
sc Stack a
stack = [a] -> [Rectangle] -> [(a, Rectangle)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
ws [Rectangle]
rects
        where ws :: [a]
ws = Stack a -> [a]
forall a. Stack a -> [a]
integrate Stack a
stack
              ratios :: [Rational]
ratios = Rational -> [Rational] -> [Rational]
blend Rational
scale ([Rational] -> [Rational])
-> ([Integer] -> [Rational]) -> [Integer] -> [Rational]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Rational] -> [Rational]
forall a. [a] -> [a]
reverse ([Rational] -> [Rational])
-> ([Integer] -> [Rational]) -> [Integer] -> [Rational]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Rational] -> [Rational]
forall a. Int -> [a] -> [a]
take ([a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
ws Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) ([Rational] -> [Rational])
-> ([Integer] -> [Rational]) -> [Integer] -> [Rational]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Integer] -> [Rational]
mkRatios ([Integer] -> [Rational]) -> [Integer] -> [Rational]
forall a b. (a -> b) -> a -> b
$ Int -> [Integer] -> [Integer]
forall a. Int -> [a] -> [a]
drop Int
1 [Integer]
fibs
              rects :: [Rectangle]
rects = [(Rational, Direction)] -> Rectangle -> [Rectangle]
divideRects ([Rational] -> [Direction] -> [(Rational, Direction)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Rational]
ratios [Direction]
dirs) Rectangle
sc
              dirs :: [Direction]
dirs  = (Direction -> Bool) -> [Direction] -> [Direction]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Direction -> Direction -> Bool
forall a. Eq a => a -> a -> Bool
/= Direction
dir) ([Direction] -> [Direction]) -> [Direction] -> [Direction]
forall a b. (a -> b) -> a -> b
$ case Rotation
rot of
                                           Rotation
CW  -> [Direction] -> [Direction]
forall a. HasCallStack => [a] -> [a]
cycle [Direction
East .. Direction
North]
                                           Rotation
CCW -> [Direction] -> [Direction]
forall a. HasCallStack => [a] -> [a]
cycle [Direction
North, Direction
West, Direction
South, Direction
East]
    handleMessage :: SpiralWithDir a -> SomeMessage -> X (Maybe (SpiralWithDir a))
handleMessage (SpiralWithDir Direction
dir Rotation
rot Rational
scale) = Maybe (SpiralWithDir a) -> X (Maybe (SpiralWithDir a))
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (SpiralWithDir a) -> X (Maybe (SpiralWithDir a)))
-> (SomeMessage -> Maybe (SpiralWithDir a))
-> SomeMessage
-> X (Maybe (SpiralWithDir a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Resize -> SpiralWithDir a)
-> Maybe Resize -> Maybe (SpiralWithDir a)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Resize -> SpiralWithDir a
forall {a}. Resize -> SpiralWithDir a
resize (Maybe Resize -> Maybe (SpiralWithDir a))
-> (SomeMessage -> Maybe Resize)
-> SomeMessage
-> Maybe (SpiralWithDir a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeMessage -> Maybe Resize
forall m. Message m => SomeMessage -> Maybe m
fromMessage
        where resize :: Resize -> SpiralWithDir a
resize Resize
Expand = Direction -> Rotation -> Rational -> SpiralWithDir a
forall a. Direction -> Rotation -> Rational -> SpiralWithDir a
spiralWithDir Direction
dir Rotation
rot (Rational -> SpiralWithDir a) -> Rational -> SpiralWithDir a
forall a b. (a -> b) -> a -> b
$ (Integer
21 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
20) Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
scale
              resize Resize
Shrink = Direction -> Rotation -> Rational -> SpiralWithDir a
forall a. Direction -> Rotation -> Rational -> SpiralWithDir a
spiralWithDir Direction
dir Rotation
rot (Rational -> SpiralWithDir a) -> Rational -> SpiralWithDir a
forall a b. (a -> b) -> a -> b
$ (Integer
20 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
21) Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
scale
    description :: SpiralWithDir a -> String
description SpiralWithDir a
_ = String
"Spiral"

-- This will produce one more rectangle than there are splits details
divideRects :: [(Rational, Direction)] -> Rectangle -> [Rectangle]
divideRects :: [(Rational, Direction)] -> Rectangle -> [Rectangle]
divideRects [] Rectangle
r = [Rectangle
r]
divideRects ((Rational
r,Direction
d):[(Rational, Direction)]
xs) Rectangle
rect = case Rational -> Direction -> Rectangle -> (Rectangle, Rectangle)
divideRect Rational
r Direction
d Rectangle
rect of
                                (Rectangle
r1, Rectangle
r2) -> Rectangle
r1 Rectangle -> [Rectangle] -> [Rectangle]
forall a. a -> [a] -> [a]
: [(Rational, Direction)] -> Rectangle -> [Rectangle]
divideRects [(Rational, Direction)]
xs Rectangle
r2

-- It's much simpler if we work with all Integers and convert to
-- Rectangle at the end.
data Rect = Rect Integer Integer Integer Integer

fromRect :: Rect -> Rectangle
fromRect :: Rect -> Rectangle
fromRect (Rect Integer
x Integer
y Integer
w Integer
h) = Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle (Integer -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x) (Integer -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
y) (Integer -> Dimension
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
w) (Integer -> Dimension
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
h)

toRect :: Rectangle -> Rect
toRect :: Rectangle -> Rect
toRect (Rectangle Position
x Position
y Dimension
w Dimension
h) = Integer -> Integer -> Integer -> Integer -> Rect
Rect (Position -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Position
x) (Position -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Position
y) (Dimension -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
w) (Dimension -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
h)

divideRect :: Rational -> Direction -> Rectangle -> (Rectangle, Rectangle)
divideRect :: Rational -> Direction -> Rectangle -> (Rectangle, Rectangle)
divideRect Rational
r Direction
d Rectangle
rect = let (Rect
r1, Rect
r2) = Rational -> Direction -> Rect -> (Rect, Rect)
divideRect' Rational
r Direction
d (Rect -> (Rect, Rect)) -> Rect -> (Rect, Rect)
forall a b. (a -> b) -> a -> b
$ Rectangle -> Rect
toRect Rectangle
rect in
                      (Rect -> Rectangle
fromRect Rect
r1, Rect -> Rectangle
fromRect Rect
r2)

divideRect' :: Rational -> Direction -> Rect -> (Rect, Rect)
divideRect' :: Rational -> Direction -> Rect -> (Rect, Rect)
divideRect' Rational
ratio Direction
dir (Rect Integer
x Integer
y Integer
w Integer
h) =
    case Direction
dir of
      Direction
East -> let (Integer
w1, Integer
w2) = Rational -> Integer -> (Integer, Integer)
chop Rational
ratio Integer
w in (Integer -> Integer -> Integer -> Integer -> Rect
Rect Integer
x Integer
y Integer
w1 Integer
h, Integer -> Integer -> Integer -> Integer -> Rect
Rect (Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
w1) Integer
y Integer
w2 Integer
h)
      Direction
South -> let (Integer
h1, Integer
h2) = Rational -> Integer -> (Integer, Integer)
chop Rational
ratio Integer
h in (Integer -> Integer -> Integer -> Integer -> Rect
Rect Integer
x Integer
y Integer
w Integer
h1, Integer -> Integer -> Integer -> Integer -> Rect
Rect Integer
x (Integer
y Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
h1) Integer
w Integer
h2)
      Direction
West -> let (Integer
w1, Integer
w2) = Rational -> Integer -> (Integer, Integer)
chop (Rational
1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational
ratio) Integer
w in (Integer -> Integer -> Integer -> Integer -> Rect
Rect (Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
w1) Integer
y Integer
w2 Integer
h, Integer -> Integer -> Integer -> Integer -> Rect
Rect Integer
x Integer
y Integer
w1 Integer
h)
      Direction
North -> let (Integer
h1, Integer
h2) = Rational -> Integer -> (Integer, Integer)
chop (Rational
1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational
ratio) Integer
h in (Integer -> Integer -> Integer -> Integer -> Rect
Rect Integer
x (Integer
y Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
h1) Integer
w Integer
h2, Integer -> Integer -> Integer -> Integer -> Rect
Rect Integer
x Integer
y Integer
w Integer
h1)

chop :: Rational -> Integer -> (Integer, Integer)
chop :: Rational -> Integer -> (Integer, Integer)
chop Rational
rat Integer
n = let f :: Integer
f = (Integer -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Rational -> Integer
forall a. Ratio a -> a
numerator Rational
rat) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Rational -> Integer
forall a. Ratio a -> a
denominator Rational
rat in
             (Integer
f, Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
f)