{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Layout.Reflect
-- Description :  Reflect a layout horizontally or vertically.
-- Copyright   :  (c) Brent Yorgey
-- License     :  BSD-style (see LICENSE)
--
-- Maintainer  :  <byorgey@gmail.com>
-- Stability   :  unstable
-- Portability :  unportable
--
-- Reflect a layout horizontally or vertically.
-----------------------------------------------------------------------------

module XMonad.Layout.Reflect (
                               -- * Usage
                               -- $usage

                               reflectHoriz, reflectVert,
                               REFLECTX(..), REFLECTY(..),
                               Reflect

                             ) where

import XMonad.Prelude (fi)
import Graphics.X11 (Rectangle(..), Window)
import Control.Arrow (second)

import XMonad.Layout.LayoutModifier
import XMonad.Layout.MultiToggle

-- $usage
-- You can use this module by importing it into your @~\/.xmonad\/xmonad.hs@ file:
--
-- > import XMonad.Layout.Reflect
--
-- and modifying your layoutHook as follows (for example):
--
-- > layoutHook = reflectHoriz $ Tall 1 (3/100) (1/2)  -- put master pane on the right
--
-- 'reflectHoriz' and 'reflectVert' can be applied to any sort of
-- layout (including Mirrored layouts) and will simply flip the
-- physical layout of the windows vertically or horizontally.
--
-- "XMonad.Layout.MultiToggle" transformers are also provided for
-- toggling layouts between reflected\/non-reflected with a keybinding.
-- To use this feature, you will also need to import the MultiToggle
-- module:
--
-- > import XMonad.Layout.MultiToggle
--
-- Next, add one or more toggles to your layout.  For example, to allow
-- separate toggling of both vertical and horizontal reflection:
--
-- > layoutHook = mkToggle (single REFLECTX) $
-- >              mkToggle (single REFLECTY) $
-- >                (tiled ||| Mirror tiled ||| ...) -- whatever layouts you use
--
-- Finally, add some keybindings to do the toggling, for example:
--
-- > , ((modm .|. controlMask, xK_x), sendMessage $ Toggle REFLECTX)
-- > , ((modm .|. controlMask, xK_y), sendMessage $ Toggle REFLECTY)
--

-- | Apply a horizontal reflection (left \<--\> right) to a
--   layout.
reflectHoriz :: l a -> ModifiedLayout Reflect l a
reflectHoriz :: l a -> ModifiedLayout Reflect l a
reflectHoriz = Reflect a -> l a -> ModifiedLayout Reflect l a
forall (m :: * -> *) (l :: * -> *) a.
m a -> l a -> ModifiedLayout m l a
ModifiedLayout (ReflectDir -> Reflect a
forall a. ReflectDir -> Reflect a
Reflect ReflectDir
Horiz)

-- | Apply a vertical reflection (top \<--\> bottom) to a
--   layout.
reflectVert :: l a -> ModifiedLayout Reflect l a
reflectVert :: l a -> ModifiedLayout Reflect l a
reflectVert = Reflect a -> l a -> ModifiedLayout Reflect l a
forall (m :: * -> *) (l :: * -> *) a.
m a -> l a -> ModifiedLayout m l a
ModifiedLayout (ReflectDir -> Reflect a
forall a. ReflectDir -> Reflect a
Reflect ReflectDir
Vert)

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

-- | Given an axis of reflection and the enclosing rectangle which
--   contains all the laid out windows, transform a rectangle
--   representing a window into its flipped counterpart.
reflectRect :: ReflectDir -> Rectangle -> Rectangle -> Rectangle
reflectRect :: ReflectDir -> Rectangle -> Rectangle -> Rectangle
reflectRect ReflectDir
Horiz (Rectangle Position
sx Position
_ Dimension
sw Dimension
_) (Rectangle Position
rx Position
ry Dimension
rw Dimension
rh) =
  Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle (Position
2Position -> Position -> Position
forall a. Num a => a -> a -> a
*Position
sx Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fi Dimension
sw Position -> Position -> Position
forall a. Num a => a -> a -> a
- Position
rx Position -> Position -> Position
forall a. Num a => a -> a -> a
- Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fi Dimension
rw) Position
ry Dimension
rw Dimension
rh
reflectRect ReflectDir
Vert (Rectangle Position
_ Position
sy Dimension
_ Dimension
sh) (Rectangle Position
rx Position
ry Dimension
rw Dimension
rh) =
  Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
rx (Position
2Position -> Position -> Position
forall a. Num a => a -> a -> a
*Position
sy Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fi Dimension
sh Position -> Position -> Position
forall a. Num a => a -> a -> a
- Position
ry Position -> Position -> Position
forall a. Num a => a -> a -> a
- Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fi Dimension
rh) Dimension
rw Dimension
rh



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

instance LayoutModifier Reflect a where

    -- reflect all the generated Rectangles.
    pureModifier :: Reflect a
-> Rectangle
-> Maybe (Stack a)
-> [(a, Rectangle)]
-> ([(a, Rectangle)], Maybe (Reflect a))
pureModifier (Reflect ReflectDir
d) Rectangle
r Maybe (Stack a)
_ [(a, Rectangle)]
wrs = (((a, Rectangle) -> (a, Rectangle))
-> [(a, Rectangle)] -> [(a, Rectangle)]
forall a b. (a -> b) -> [a] -> [b]
map ((Rectangle -> Rectangle) -> (a, Rectangle) -> (a, Rectangle)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ((Rectangle -> Rectangle) -> (a, Rectangle) -> (a, Rectangle))
-> (Rectangle -> Rectangle) -> (a, Rectangle) -> (a, Rectangle)
forall a b. (a -> b) -> a -> b
$ ReflectDir -> Rectangle -> Rectangle -> Rectangle
reflectRect ReflectDir
d Rectangle
r) [(a, Rectangle)]
wrs, Reflect a -> Maybe (Reflect a)
forall a. a -> Maybe a
Just (Reflect a -> Maybe (Reflect a)) -> Reflect a -> Maybe (Reflect a)
forall a b. (a -> b) -> a -> b
$ ReflectDir -> Reflect a
forall a. ReflectDir -> Reflect a
Reflect ReflectDir
d)

    modifierDescription :: Reflect a -> String
modifierDescription (Reflect ReflectDir
d) = String
"Reflect" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
xy
      where xy :: String
xy = case ReflectDir
d of { ReflectDir
Horiz -> String
"X" ; ReflectDir
Vert -> String
"Y" }


-------- instances for MultiToggle ------------------

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

instance Transformer REFLECTX Window where
    transform :: REFLECTX
-> l Window
-> (forall (l' :: * -> *).
    LayoutClass l' Window =>
    l' Window -> (l' Window -> l Window) -> b)
-> b
transform REFLECTX
REFLECTX l Window
x forall (l' :: * -> *).
LayoutClass l' Window =>
l' Window -> (l' Window -> l Window) -> b
k = ModifiedLayout Reflect l Window
-> (ModifiedLayout Reflect l Window -> l Window) -> b
forall (l' :: * -> *).
LayoutClass l' Window =>
l' Window -> (l' Window -> l Window) -> b
k (l Window -> ModifiedLayout Reflect l Window
forall (l :: * -> *) a. l a -> ModifiedLayout Reflect l a
reflectHoriz l Window
x) (\(ModifiedLayout Reflect Window
_ l Window
x') -> l Window
x')

instance Transformer REFLECTY Window where
    transform :: REFLECTY
-> l Window
-> (forall (l' :: * -> *).
    LayoutClass l' Window =>
    l' Window -> (l' Window -> l Window) -> b)
-> b
transform REFLECTY
REFLECTY l Window
x forall (l' :: * -> *).
LayoutClass l' Window =>
l' Window -> (l' Window -> l Window) -> b
k = ModifiedLayout Reflect l Window
-> (ModifiedLayout Reflect l Window -> l Window) -> b
forall (l' :: * -> *).
LayoutClass l' Window =>
l' Window -> (l' Window -> l Window) -> b
k (l Window -> ModifiedLayout Reflect l Window
forall (l :: * -> *) a. l a -> ModifiedLayout Reflect l a
reflectVert l Window
x) (\(ModifiedLayout Reflect Window
_ l Window
x') -> l Window
x')