{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
module XMonad.Layout.Spiral (
spiral
, spiralWithDir
, Rotation (..)
, Direction (..)
, SpiralWithDir
) where
import Data.Ratio
import XMonad hiding ( Rotation )
import XMonad.StackSet ( integrate )
fibs :: [Integer]
fibs :: [Integer]
fibs = Integer
1 forall a. a -> [a] -> [a]
: Integer
1 forall a. a -> [a] -> [a]
: forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a. Num a => a -> a -> a
(+) [Integer]
fibs (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 forall a. Integral a => a -> a -> Ratio a
% Integer
x2) forall a. a -> [a] -> [a]
: [Integer] -> [Rational]
mkRatios (Integer
x2forall a. a -> [a] -> [a]
:[Integer]
xs)
mkRatios [Integer]
_ = []
data Rotation = CW | CCW deriving (ReadPrec [Rotation]
ReadPrec Rotation
Int -> ReadS Rotation
ReadS [Rotation]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Rotation]
$creadListPrec :: ReadPrec [Rotation]
readPrec :: ReadPrec Rotation
$creadPrec :: ReadPrec Rotation
readList :: ReadS [Rotation]
$creadList :: ReadS [Rotation]
readsPrec :: Int -> ReadS Rotation
$creadsPrec :: Int -> ReadS Rotation
Read, Int -> Rotation -> ShowS
[Rotation] -> ShowS
Rotation -> String
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
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]
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]
fromEnum :: Direction -> Int
$cfromEnum :: Direction -> Int
toEnum :: Int -> Direction
$ctoEnum :: Int -> Direction
pred :: Direction -> Direction
$cpred :: Direction -> Direction
succ :: Direction -> Direction
$csucc :: Direction -> Direction
Enum, ReadPrec [Direction]
ReadPrec Direction
Int -> ReadS Direction
ReadS [Direction]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Direction]
$creadListPrec :: ReadPrec [Direction]
readPrec :: ReadPrec Direction
$creadPrec :: ReadPrec Direction
readList :: ReadS [Direction]
$creadList :: ReadS [Direction]
readsPrec :: Int -> ReadS Direction
$creadsPrec :: Int -> ReadS Direction
Read, Int -> Direction -> ShowS
[Direction] -> ShowS
Direction -> String
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 = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a. Num a => a -> a -> a
(+) [Rational]
ratios [Rational]
scaleFactors
where
len :: Int
len = forall (t :: * -> *) a. Foldable t => t a -> Int
length [Rational]
ratios
step :: Rational
step = (Rational
scale forall a. Num a => a -> a -> a
- (Integer
1 forall a. Integral a => a -> a -> Ratio a
% Integer
1)) forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len
scaleFactors :: [Rational]
scaleFactors = forall a b. (a -> b) -> [a] -> [b]
map (forall a. Num a => a -> a -> a
* Rational
step) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
len forall a b. (a -> b) -> a -> b
$ [Rational
0..]
spiral :: Rational -> SpiralWithDir a
spiral :: forall a. Rational -> SpiralWithDir a
spiral = forall a. Direction -> Rotation -> Rational -> SpiralWithDir a
spiralWithDir Direction
East Rotation
CW
spiralWithDir :: Direction -> Rotation -> Rational -> SpiralWithDir a
spiralWithDir :: forall a. Direction -> Rotation -> Rational -> SpiralWithDir a
spiralWithDir = forall a. Direction -> Rotation -> Rational -> SpiralWithDir a
SpiralWithDir
data SpiralWithDir a = SpiralWithDir Direction Rotation Rational
deriving ( ReadPrec [SpiralWithDir a]
ReadPrec (SpiralWithDir a)
ReadS [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
readListPrec :: ReadPrec [SpiralWithDir a]
$creadListPrec :: forall a. ReadPrec [SpiralWithDir a]
readPrec :: ReadPrec (SpiralWithDir a)
$creadPrec :: forall a. ReadPrec (SpiralWithDir a)
readList :: ReadS [SpiralWithDir a]
$creadList :: forall a. ReadS [SpiralWithDir a]
readsPrec :: Int -> ReadS (SpiralWithDir a)
$creadsPrec :: forall a. Int -> ReadS (SpiralWithDir a)
Read, Int -> SpiralWithDir a -> ShowS
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 = forall a b. [a] -> [b] -> [(a, b)]
zip [a]
ws [Rectangle]
rects
where ws :: [a]
ws = forall a. Stack a -> [a]
integrate Stack a
stack
ratios :: [Rational]
ratios = Rational -> [Rational] -> [Rational]
blend Rational
scale forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take (forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
ws forall a. Num a => a -> a -> a
- Int
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Integer] -> [Rational]
mkRatios forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
drop Int
1 [Integer]
fibs
rects :: [Rectangle]
rects = [(Rational, Direction)] -> Rectangle -> [Rectangle]
divideRects (forall a b. [a] -> [b] -> [(a, b)]
zip [Rational]
ratios [Direction]
dirs) Rectangle
sc
dirs :: [Direction]
dirs = forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
/= Direction
dir) forall a b. (a -> b) -> a -> b
$ case Rotation
rot of
Rotation
CW -> forall a. [a] -> [a]
cycle [Direction
East .. Direction
North]
Rotation
CCW -> 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) = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {a}. Resize -> SpiralWithDir a
resize forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Message m => SomeMessage -> Maybe m
fromMessage
where resize :: Resize -> SpiralWithDir a
resize Resize
Expand = forall a. Direction -> Rotation -> Rational -> SpiralWithDir a
spiralWithDir Direction
dir Rotation
rot forall a b. (a -> b) -> a -> b
$ (Integer
21 forall a. Integral a => a -> a -> Ratio a
% Integer
20) forall a. Num a => a -> a -> a
* Rational
scale
resize Resize
Shrink = forall a. Direction -> Rotation -> Rational -> SpiralWithDir a
spiralWithDir Direction
dir Rotation
rot forall a b. (a -> b) -> a -> b
$ (Integer
20 forall a. Integral a => a -> a -> Ratio a
% Integer
21) forall a. Num a => a -> a -> a
* Rational
scale
description :: SpiralWithDir a -> String
description SpiralWithDir a
_ = String
"Spiral"
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 forall a. a -> [a] -> [a]
: [(Rational, Direction)] -> Rectangle -> [Rectangle]
divideRects [(Rational, Direction)]
xs Rectangle
r2
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 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
y) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
w) (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 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Position
x) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Position
y) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
w) (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 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 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 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 forall a. Num a => a -> a -> a
- Rational
ratio) Integer
w in (Integer -> Integer -> Integer -> Integer -> Rect
Rect (Integer
x 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 forall a. Num a => a -> a -> a
- Rational
ratio) Integer
h in (Integer -> Integer -> Integer -> Integer -> Rect
Rect Integer
x (Integer
y 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 = (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n forall a. Num a => a -> a -> a
* forall a. Ratio a -> a
numerator Rational
rat) forall a. Integral a => a -> a -> a
`div` forall a. Ratio a -> a
denominator Rational
rat in
(Integer
f, Integer
n forall a. Num a => a -> a -> a
- Integer
f)