```{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}

-----------------------------------------------------------------------------
-- |
-- Description :  A spiral tiling layout.
-- Copyright   :  (c) Joe Thornber <joe.thornber@gmail.com>
--
-- Maintainer  :  Joe Thornber <joe.thornber@gmail.com>
-- Stability   :  stable
-- Portability :  portable
--
-- A spiral tiling layout.
--
-----------------------------------------------------------------------------

-- * Usage
-- \$usage
spiral
, spiralWithDir
, Rotation (..)
, Direction (..)

, SpiralWithDir
) where

import Data.Ratio
import XMonad hiding ( Rotation )

-- \$usage
--
--
--
-- > myLayout =  spiral (6/7) ||| etc..
-- > main = xmonad def { layoutHook = myLayout }
--
-- For more detailed instructions on editing the layoutHook see:
--

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 ([Integer] -> [Integer]
forall a. [a] -> [a]
tail [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]
forall a.
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
showList :: [Rotation] -> ShowS
\$cshowList :: [Rotation] -> ShowS
show :: Rotation -> String
\$cshow :: Rotation -> String
showsPrec :: Int -> Rotation -> ShowS
\$cshowsPrec :: Int -> 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
/= :: Direction -> Direction -> Bool
\$c/= :: Direction -> Direction -> Bool
== :: Direction -> Direction -> Bool
\$c== :: 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
enumFromThenTo :: Direction -> Direction -> Direction -> [Direction]
\$cenumFromThenTo :: Direction -> Direction -> Direction -> [Direction]
enumFromTo :: Direction -> Direction -> [Direction]
\$cenumFromTo :: Direction -> Direction -> [Direction]
enumFromThen :: Direction -> Direction -> [Direction]
\$cenumFromThen :: Direction -> Direction -> [Direction]
enumFrom :: Direction -> [Direction]
\$cenumFrom :: Direction -> [Direction]
toEnum :: Int -> Direction
\$ctoEnum :: Int -> Direction
pred :: Direction -> Direction
\$cpred :: Direction -> Direction
succ :: Direction -> Direction
\$csucc :: Direction -> Direction
forall a.
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
showList :: [Direction] -> ShowS
\$cshowList :: [Direction] -> ShowS
show :: Direction -> String
\$cshow :: Direction -> String
showsPrec :: Int -> Direction -> ShowS
\$cshowsPrec :: Int -> 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 (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.
spiral :: Rational -> SpiralWithDir a
spiral :: 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 :: 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
forall a. Int -> ReadS (SpiralWithDir a)
forall 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
showList :: [SpiralWithDir a] -> ShowS
\$cshowList :: forall a. [SpiralWithDir a] -> ShowS
show :: SpiralWithDir a -> String
\$cshow :: forall a. SpiralWithDir a -> String
showsPrec :: Int -> SpiralWithDir a -> ShowS
\$cshowsPrec :: forall a. Int -> 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 (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
\$ [Integer] -> [Integer]
forall a. [a] -> [a]
tail [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. [a] -> [a]
cycle [Direction
East .. Direction
North]
Rotation
CCW -> [Direction] -> [Direction]
forall a. [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 (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 (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)
```