{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Layout.Dwindle
-- Description :  Various spirally layouts.
-- Copyright   :  (c) Norbert Zeh <norbert.zeh@gmail.com>
-- License     :  BSD3
--
-- Maintainer  :  Norbert Zeh <norbert.zeh@gmail.com>
-- Stability   :  experimental
-- Portability :  portable
--
-- Three layouts: The first, 'Spiral', is a reimplementation of
-- 'XMonad.Layout.Spiral.spiral' with, at least to me, more intuitive semantics.
-- The second, 'Dwindle', is inspired by a similar layout in awesome and
-- produces the same sequence of decreasing window sizes as Spiral but pushes
-- the smallest windows into a screen corner rather than the centre.  The third,
-- 'Squeeze' arranges all windows in one row or in one column, with
-- geometrically decreasing sizes.
--
-----------------------------------------------------------------------------

module XMonad.Layout.Dwindle ( -- * Usage
                               -- $usage
                               Dwindle(..)
                             , Direction2D(..)
                             , Chirality(..)
                             ) where

import XMonad.Prelude ( unfoldr )
import XMonad
import XMonad.StackSet ( integrate, Stack )
import XMonad.Util.Types ( Direction2D(..) )

-- $usage
-- This module can be used as follows:
--
-- > import XMonad.Layout.Dwindle
--
-- Then add something like this to your layouts:
--
-- > Dwindle R CW 1.5 1.1
--
-- or
--
-- > Spiral L CW 1.5 1.1
--
-- or
--
-- ^ Squeeze D 1.5 1.1
--
-- The first produces a layout that places the second window to the right of
-- the first, the third below the second, the fourth to the right of the third,
-- and so on.  The first window is 1.5 times as wide as the second one, the
-- second is 1.5 times as tall as the third one, and so on.  Thus, the further
-- down the window stack a window is, the smaller it is and the more it is
-- pushed into the bottom-right corner.
--
-- The second produces a layout with the same window sizes but places the second
-- window to the left of the first one, the third above the second one, the
-- fourth to the right of the third one, and so on.
--
-- The third produces a layout that stacks windows vertically top-down with each
-- window being 1.5 times as tall as the next.
--
-- In all three cases, the fourth (third, in the case of 'Squeeze') parameter,
-- 1.1, is the factor by which the third parameter increases or decreases in
-- response to Expand or Shrink messages.
--
-- For more detailed instructions on editing the layoutHook see:
--
-- "XMonad.Doc.Extending#Editing_the_layout_hook"

-- | Layouts with geometrically decreasing window sizes.  'Spiral' and 'Dwindle'
-- split the screen into a rectangle for the first window and a rectangle for
-- the remaining windows, which is split recursively to lay out these windows.
-- Both layouts alternate between horizontal and vertical splits.
--
-- In each recursive step, the split 'Direction2D' determines the placement of the
-- remaining windows relative to the current window: to the left, to the right,
-- above or below.  The split direction of the first split is determined by the
-- first layout parameter.  The split direction of the second step is rotated 90
-- degrees relative to the first split direction according to the second layout
-- parameter of type 'Chirality'.  So, if the first split is 'R' and the second
-- layout parameter is 'CW', then the second split is 'D'.
--
-- For the 'Spiral' layout, the same 'Chirality' is used for computing the split
-- direction of each step from the split direction of the previous step.  For
-- example, parameters 'R' and 'CW' produces the direction sequence 'R', 'D',
-- 'L', 'U', 'R', 'D', 'L', 'U', ...
--
-- For the 'Dwindle' layout, the 'Chirality' alternates between 'CW' and 'CCW' in
-- each step.  For example, parameters 'U' and 'CCW' produce the direction
-- sequence 'U', 'L', 'U', 'L', ... because 'L' is the 'CCW' rotation of 'U' and
-- 'U' is the 'CW' rotation of 'L'.
--
-- In each split, the current rectangle is split so that the ratio between the
-- size of the rectangle allocated to the current window and the size of the
-- rectangle allocated to the remaining windows is the third layout parameter.
-- This ratio can be altered using 'Expand' and 'Shrink' messages.  The former
-- multiplies the ratio by the fourth layout parameter.  The latter divides the
-- ratio by this parameter.
--
-- 'Squeeze' does not alternate between horizontal and vertical splits and
-- simply splits in the direction given as its first argument.
--
-- Parameters for both 'Dwindle' and 'Spiral':
--
-- * First split direction
--
-- * First split chirality
--
-- * Size ratio between rectangle allocated to current window and rectangle
-- allocated to remaining windows
--
-- * Factor by which the size ratio is changed in response to 'Expand' or 'Shrink'
-- messages
--
-- The parameters for 'Squeeze' are the same, except that there is no 'Chirality'
-- parameter.
data Dwindle a = Dwindle !Direction2D !Chirality !Rational !Rational
               | Spiral  !Direction2D !Chirality !Rational !Rational
               | Squeeze !Direction2D !Rational !Rational
               deriving (ReadPrec [Dwindle a]
ReadPrec (Dwindle a)
Int -> ReadS (Dwindle a)
ReadS [Dwindle a]
(Int -> ReadS (Dwindle a))
-> ReadS [Dwindle a]
-> ReadPrec (Dwindle a)
-> ReadPrec [Dwindle a]
-> Read (Dwindle a)
forall a. ReadPrec [Dwindle a]
forall a. ReadPrec (Dwindle a)
forall a. Int -> ReadS (Dwindle a)
forall a. ReadS [Dwindle a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Dwindle a]
$creadListPrec :: forall a. ReadPrec [Dwindle a]
readPrec :: ReadPrec (Dwindle a)
$creadPrec :: forall a. ReadPrec (Dwindle a)
readList :: ReadS [Dwindle a]
$creadList :: forall a. ReadS [Dwindle a]
readsPrec :: Int -> ReadS (Dwindle a)
$creadsPrec :: forall a. Int -> ReadS (Dwindle a)
Read, Int -> Dwindle a -> ShowS
[Dwindle a] -> ShowS
Dwindle a -> String
(Int -> Dwindle a -> ShowS)
-> (Dwindle a -> String)
-> ([Dwindle a] -> ShowS)
-> Show (Dwindle a)
forall a. Int -> Dwindle a -> ShowS
forall a. [Dwindle a] -> ShowS
forall a. Dwindle a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Dwindle a] -> ShowS
$cshowList :: forall a. [Dwindle a] -> ShowS
show :: Dwindle a -> String
$cshow :: forall a. Dwindle a -> String
showsPrec :: Int -> Dwindle a -> ShowS
$cshowsPrec :: forall a. Int -> Dwindle a -> ShowS
Show)

-- | Rotation between consecutive split directions
data Chirality = CW | CCW
               deriving (ReadPrec [Chirality]
ReadPrec Chirality
Int -> ReadS Chirality
ReadS [Chirality]
(Int -> ReadS Chirality)
-> ReadS [Chirality]
-> ReadPrec Chirality
-> ReadPrec [Chirality]
-> Read Chirality
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Chirality]
$creadListPrec :: ReadPrec [Chirality]
readPrec :: ReadPrec Chirality
$creadPrec :: ReadPrec Chirality
readList :: ReadS [Chirality]
$creadList :: ReadS [Chirality]
readsPrec :: Int -> ReadS Chirality
$creadsPrec :: Int -> ReadS Chirality
Read, Int -> Chirality -> ShowS
[Chirality] -> ShowS
Chirality -> String
(Int -> Chirality -> ShowS)
-> (Chirality -> String)
-> ([Chirality] -> ShowS)
-> Show Chirality
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Chirality] -> ShowS
$cshowList :: [Chirality] -> ShowS
show :: Chirality -> String
$cshow :: Chirality -> String
showsPrec :: Int -> Chirality -> ShowS
$cshowsPrec :: Int -> Chirality -> ShowS
Show)

instance LayoutClass Dwindle a where
    pureLayout :: Dwindle a -> Rectangle -> Stack a -> [(a, Rectangle)]
pureLayout (Dwindle Direction2D
dir Chirality
rot Rational
ratio Rational
_) = AxesGenerator
-> Direction2D
-> Chirality
-> Rational
-> Rectangle
-> Stack a
-> [(a, Rectangle)]
forall a.
AxesGenerator
-> Direction2D
-> Chirality
-> Rational
-> Rectangle
-> Stack a
-> [(a, Rectangle)]
dwindle AxesGenerator
alternate Direction2D
dir Chirality
rot Rational
ratio
    pureLayout (Spiral  Direction2D
dir Chirality
rot Rational
ratio Rational
_) = AxesGenerator
-> Direction2D
-> Chirality
-> Rational
-> Rectangle
-> Stack a
-> [(a, Rectangle)]
forall a.
AxesGenerator
-> Direction2D
-> Chirality
-> Rational
-> Rectangle
-> Stack a
-> [(a, Rectangle)]
dwindle AxesGenerator
rotate    Direction2D
dir Chirality
rot Rational
ratio
    pureLayout (Squeeze Direction2D
dir     Rational
ratio Rational
_) = Direction2D -> Rational -> Rectangle -> Stack a -> [(a, Rectangle)]
forall a.
Direction2D -> Rational -> Rectangle -> Stack a -> [(a, Rectangle)]
squeeze           Direction2D
dir     Rational
ratio
    pureMessage :: Dwindle a -> SomeMessage -> Maybe (Dwindle a)
pureMessage (Dwindle Direction2D
dir Chirality
rot Rational
ratio Rational
delta) =
      (Rational -> Dwindle a) -> Maybe Rational -> Maybe (Dwindle a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Rational
ratio' -> Direction2D -> Chirality -> Rational -> Rational -> Dwindle a
forall a.
Direction2D -> Chirality -> Rational -> Rational -> Dwindle a
Dwindle Direction2D
dir Chirality
rot Rational
ratio' Rational
delta) (Maybe Rational -> Maybe (Dwindle a))
-> (SomeMessage -> Maybe Rational)
-> SomeMessage
-> Maybe (Dwindle a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Rational -> SomeMessage -> Maybe Rational
changeRatio Rational
ratio Rational
delta
    pureMessage (Spiral Direction2D
dir Chirality
rot Rational
ratio Rational
delta) =
      (Rational -> Dwindle a) -> Maybe Rational -> Maybe (Dwindle a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Rational
ratio' -> Direction2D -> Chirality -> Rational -> Rational -> Dwindle a
forall a.
Direction2D -> Chirality -> Rational -> Rational -> Dwindle a
Spiral Direction2D
dir Chirality
rot Rational
ratio' Rational
delta) (Maybe Rational -> Maybe (Dwindle a))
-> (SomeMessage -> Maybe Rational)
-> SomeMessage
-> Maybe (Dwindle a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Rational -> SomeMessage -> Maybe Rational
changeRatio Rational
ratio Rational
delta
    pureMessage (Squeeze Direction2D
dir Rational
ratio Rational
delta) =
      (Rational -> Dwindle a) -> Maybe Rational -> Maybe (Dwindle a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Rational
ratio' -> Direction2D -> Rational -> Rational -> Dwindle a
forall a. Direction2D -> Rational -> Rational -> Dwindle a
Squeeze Direction2D
dir Rational
ratio' Rational
delta) (Maybe Rational -> Maybe (Dwindle a))
-> (SomeMessage -> Maybe Rational)
-> SomeMessage
-> Maybe (Dwindle a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Rational -> SomeMessage -> Maybe Rational
changeRatio Rational
ratio Rational
delta

changeRatio :: Rational -> Rational -> SomeMessage -> Maybe Rational
changeRatio :: Rational -> Rational -> SomeMessage -> Maybe Rational
changeRatio Rational
ratio Rational
delta = (Resize -> Rational) -> Maybe Resize -> Maybe Rational
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Resize -> Rational
f (Maybe Resize -> Maybe Rational)
-> (SomeMessage -> Maybe Resize) -> SomeMessage -> Maybe Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeMessage -> Maybe Resize
forall m. Message m => SomeMessage -> Maybe m
fromMessage
  where f :: Resize -> Rational
f Resize
Expand = Rational
ratio Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
delta
        f Resize
Shrink = Rational
ratio Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
delta

dwindle :: AxesGenerator -> Direction2D -> Chirality -> Rational -> Rectangle -> Stack a ->
           [(a, Rectangle)]
dwindle :: forall a.
AxesGenerator
-> Direction2D
-> Chirality
-> Rational
-> Rectangle
-> Stack a
-> [(a, Rectangle)]
dwindle AxesGenerator
trans Direction2D
dir Chirality
rot Rational
ratio Rectangle
rect Stack a
st = (([a], Rectangle, Axes, Chirality)
 -> Maybe ((a, Rectangle), ([a], Rectangle, Axes, Chirality)))
-> ([a], Rectangle, Axes, Chirality) -> [(a, Rectangle)]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr ([a], Rectangle, Axes, Chirality)
-> Maybe ((a, Rectangle), ([a], Rectangle, Axes, Chirality))
forall {a}.
([a], Rectangle, Axes, Chirality)
-> Maybe ((a, Rectangle), ([a], Rectangle, Axes, Chirality))
genRects (Stack a -> [a]
forall a. Stack a -> [a]
integrate Stack a
st, Rectangle
rect, Direction2D -> Axes
dirAxes Direction2D
dir, Chirality
rot)
  where genRects :: ([a], Rectangle, Axes, Chirality)
-> Maybe ((a, Rectangle), ([a], Rectangle, Axes, Chirality))
genRects ([],   Rectangle
_, Axes
_, Chirality
_ ) = Maybe ((a, Rectangle), ([a], Rectangle, Axes, Chirality))
forall a. Maybe a
Nothing
        genRects ([a
w],  Rectangle
r, Axes
a, Chirality
rt) = ((a, Rectangle), ([a], Rectangle, Axes, Chirality))
-> Maybe ((a, Rectangle), ([a], Rectangle, Axes, Chirality))
forall a. a -> Maybe a
Just ((a
w, Rectangle
r),  ([], Rectangle
r,   Axes
a,  Chirality
rt))
        genRects (a
w:[a]
ws, Rectangle
r, Axes
a, Chirality
rt) = ((a, Rectangle), ([a], Rectangle, Axes, Chirality))
-> Maybe ((a, Rectangle), ([a], Rectangle, Axes, Chirality))
forall a. a -> Maybe a
Just ((a
w, Rectangle
r'), ([a]
ws, Rectangle
r'', Axes
a', Chirality
rt'))
          where (Rectangle
r', Rectangle
r'') = Rectangle -> Rational -> Axes -> (Rectangle, Rectangle)
splitRect Rectangle
r Rational
ratio Axes
a
                (Axes
a', Chirality
rt') = AxesGenerator
trans Axes
a Chirality
rt

squeeze :: Direction2D -> Rational -> Rectangle -> Stack a -> [(a, Rectangle)]
squeeze :: forall a.
Direction2D -> Rational -> Rectangle -> Stack a -> [(a, Rectangle)]
squeeze Direction2D
dir Rational
ratio Rectangle
rect Stack a
st = [a] -> [Rectangle] -> [(a, Rectangle)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
wins [Rectangle]
rects
  where wins :: [a]
wins    = Stack a -> [a]
forall a. Stack a -> [a]
integrate Stack a
st
        nwins :: Int
nwins   = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
wins
        sizes :: [Rational]
sizes   = Int -> [Rational] -> [Rational]
forall a. Int -> [a] -> [a]
take Int
nwins ([Rational] -> [Rational]) -> [Rational] -> [Rational]
forall a b. (a -> b) -> a -> b
$ (Rational -> Maybe (Rational, Rational)) -> Rational -> [Rational]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr (\Rational
r -> (Rational, Rational) -> Maybe (Rational, Rational)
forall a. a -> Maybe a
Just (Rational
r Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
ratio, Rational
r Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
ratio)) Rational
1
        totals' :: [Rational]
totals' = Rational
0 Rational -> [Rational] -> [Rational]
forall a. a -> [a] -> [a]
: (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]
sizes [Rational]
totals'
        totals :: [Rational]
totals  = [Rational] -> [Rational]
forall a. [a] -> [a]
tail [Rational]
totals'
        splits :: [(Rational, Rational)]
splits  = [Rational] -> [Rational] -> [(Rational, Rational)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([Rational] -> [Rational]
forall a. [a] -> [a]
tail [Rational]
sizes) [Rational]
totals
        ratios :: [Rational]
ratios  = [Rational] -> [Rational]
forall a. [a] -> [a]
reverse ([Rational] -> [Rational]) -> [Rational] -> [Rational]
forall a b. (a -> b) -> a -> b
$ ((Rational, Rational) -> Rational)
-> [(Rational, Rational)] -> [Rational]
forall a b. (a -> b) -> [a] -> [b]
map ((Rational -> Rational -> Rational)
-> (Rational, Rational) -> Rational
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
(/)) [(Rational, Rational)]
splits
        rects :: [Rectangle]
rects   = Rectangle -> [Rational] -> [Rectangle]
genRects Rectangle
rect [Rational]
ratios
        genRects :: Rectangle -> [Rational] -> [Rectangle]
genRects Rectangle
r []     = [Rectangle
r]
        genRects Rectangle
r (Rational
x:[Rational]
xs) = Rectangle
r' Rectangle -> [Rectangle] -> [Rectangle]
forall a. a -> [a] -> [a]
: Rectangle -> [Rational] -> [Rectangle]
genRects Rectangle
r'' [Rational]
xs
          where (Rectangle
r', Rectangle
r'') = Rectangle -> Rational -> Axes -> (Rectangle, Rectangle)
splitRect Rectangle
r Rational
x (Direction2D -> Axes
dirAxes Direction2D
dir)

splitRect :: Rectangle -> Rational -> Axes -> (Rectangle, Rectangle)
splitRect :: Rectangle -> Rational -> Axes -> (Rectangle, Rectangle)
splitRect (Rectangle Position
x Position
y Dimension
w Dimension
h) Rational
ratio (Int
ax, Int
ay) = (Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
x' Position
y' Dimension
w' Dimension
h', Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
x'' Position
y'' Dimension
w'' Dimension
h'')
  where portion :: Rational
portion = Rational
ratio Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ (Rational
ratio Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
1)
        w1 :: Int
w1  = (Rational -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (Rational -> Int) -> Rational -> Int
forall a b. (a -> b) -> a -> b
$ Dimension -> Rational
forall b a. (Num b, Integral a) => a -> b
fi Dimension
w Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
portion) :: Int
        w2 :: Int
w2  = Dimension -> Int
forall b a. (Num b, Integral a) => a -> b
fi Dimension
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
w1
        h1 :: Int
h1  = (Rational -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (Rational -> Int) -> Rational -> Int
forall a b. (a -> b) -> a -> b
$ Dimension -> Rational
forall b a. (Num b, Integral a) => a -> b
fi Dimension
h Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
portion) :: Int
        h2 :: Int
h2  = Dimension -> Int
forall b a. (Num b, Integral a) => a -> b
fi Dimension
h Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
h1
        x' :: Position
x'  = Position
x Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Int -> Position
forall b a. (Num b, Integral a) => a -> b
fi (Int -> Int
forall a. Num a => a -> a
negate Int
ax Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ax) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
w2 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2)
        y' :: Position
y'  = Position
y Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Int -> Position
forall b a. (Num b, Integral a) => a -> b
fi (Int -> Int
forall a. Num a => a -> a
negate Int
ay Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ay) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
h2 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2)
        w' :: Dimension
w'  = Int -> Dimension
forall b a. (Num b, Integral a) => a -> b
fi (Int -> Dimension) -> Int -> Dimension
forall a b. (a -> b) -> a -> b
$ Int
w1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int -> Int
forall a. Num a => a -> a
abs Int
ax) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
w2
        h' :: Dimension
h'  = Int -> Dimension
forall b a. (Num b, Integral a) => a -> b
fi (Int -> Dimension) -> Int -> Dimension
forall a b. (a -> b) -> a -> b
$ Int
h1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int -> Int
forall a. Num a => a -> a
abs Int
ay) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
h2
        x'' :: Position
x'' = Position
x Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Int -> Position
forall b a. (Num b, Integral a) => a -> b
fi (Int
ax Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ax) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
w1 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2)
        y'' :: Position
y'' = Position
y Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Int -> Position
forall b a. (Num b, Integral a) => a -> b
fi (Int
ay Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ay) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
h1 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2)
        w'' :: Dimension
w'' = Int -> Dimension
forall b a. (Num b, Integral a) => a -> b
fi (Int -> Dimension) -> Int -> Dimension
forall a b. (a -> b) -> a -> b
$ Int
w2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int -> Int
forall a. Num a => a -> a
abs Int
ax) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
w1
        h'' :: Dimension
h'' = Int -> Dimension
forall b a. (Num b, Integral a) => a -> b
fi (Int -> Dimension) -> Int -> Dimension
forall a b. (a -> b) -> a -> b
$ Int
h2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int -> Int
forall a. Num a => a -> a
abs Int
ay) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
h1
        fi :: (Num b, Integral a) => a -> b
        fi :: forall b a. (Num b, Integral a) => a -> b
fi  = a -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral

type Axes          = (Int, Int)
type AxesGenerator = Axes -> Chirality -> (Axes, Chirality)

dirAxes :: Direction2D -> Axes
dirAxes :: Direction2D -> Axes
dirAxes Direction2D
L = (-Int
1,  Int
0)
dirAxes Direction2D
R = ( Int
1,  Int
0)
dirAxes Direction2D
U = ( Int
0, -Int
1)
dirAxes Direction2D
D = ( Int
0,  Int
1)

alternate :: AxesGenerator
alternate :: AxesGenerator
alternate = (Chirality -> Chirality) -> AxesGenerator
chDir Chirality -> Chirality
alt

rotate :: AxesGenerator
rotate :: AxesGenerator
rotate = (Chirality -> Chirality) -> AxesGenerator
chDir Chirality -> Chirality
forall a. a -> a
id

chDir :: (Chirality -> Chirality) -> AxesGenerator
chDir :: (Chirality -> Chirality) -> AxesGenerator
chDir Chirality -> Chirality
f (Int
x, Int
y) Chirality
r = (Chirality -> Axes
a' Chirality
r, Chirality
r')
  where a' :: Chirality -> Axes
a' Chirality
CW  = (-Int
y,  Int
x)
        a' Chirality
CCW = ( Int
y, -Int
x)
        r' :: Chirality
r' = Chirality -> Chirality
f Chirality
r

alt :: Chirality -> Chirality
alt :: Chirality -> Chirality
alt Chirality
CW  = Chirality
CCW
alt Chirality
CCW = Chirality
CW