{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-----------------------------------------------------------------------------
-- |
-- Module       : XMonad.Actions.PhysicalScreens
-- Description  : Manipulate screens ordered by physical location instead of ID.
-- Copyright    : (c) Nelson Elhage <nelhage@mit.edu>
-- License      : BSD
--
-- Maintainer   : Nelson Elhage <nelhage@mit.edu>
-- Stability    : unstable
-- Portability  : unportable
--
-- Manipulate screens ordered by physical location instead of ID
-----------------------------------------------------------------------------

module XMonad.Actions.PhysicalScreens (
                                        -- * Usage
                                        -- $usage
                                        PhysicalScreen(..)
                                      , getScreen
                                      , viewScreen
                                      , sendToScreen
                                      , onNextNeighbour
                                      , onPrevNeighbour
                                      , horizontalScreenOrderer
                                      , verticalScreenOrderer
                                      , ScreenComparator(ScreenComparator)
                                      , getScreenIdAndRectangle
                                      , screenComparatorById
                                      , screenComparatorByRectangle
                                      ) where

import XMonad
import XMonad.Prelude (elemIndex, fromMaybe, on, sortBy)
import qualified XMonad.StackSet as W

{- $usage

This module allows you name Xinerama screens from XMonad using their
physical location relative to each other (as reported by Xinerama),
rather than their @ScreenID@ s, which are arbitrarily determined by
your X server and graphics hardware.

You can specify how to order the screen by giving a ScreenComparator.
To create a screen comparator you can use screenComparatorByRectangle or screenComparatorByScreenId.
The default ScreenComparator orders screens by the upper-left-most corner, from top-to-bottom
and then left-to-right.

Example usage in your @~\/.xmonad\/xmonad.hs@ file:

> import XMonad.Actions.PhysicalScreens
> import Data.Default

> , ((modMask, xK_a), onPrevNeighbour def W.view)
> , ((modMask, xK_o), onNextNeighbour def W.view)
> , ((modMask .|. shiftMask, xK_a), onPrevNeighbour def W.shift)
> , ((modMask .|. shiftMask, xK_o), onNextNeighbour def W.shift)

> --
> -- mod-{w,e,r}, Switch to physical/Xinerama screens 1, 2, or 3
> -- mod-shift-{w,e,r}, Move client to screen 1, 2, or 3
> --
> [((modm .|. mask, key), f sc)
>     | (key, sc) <- zip [xK_w, xK_e, xK_r] [0..]
>     , (f, mask) <- [(viewScreen def, 0), (sendToScreen def, shiftMask)]]

For detailed instructions on editing your key bindings, see
"XMonad.Doc.Extending#Editing_key_bindings".
 -}

-- | The type of the index of a screen by location
newtype PhysicalScreen = P Int deriving (PhysicalScreen -> PhysicalScreen -> Bool
(PhysicalScreen -> PhysicalScreen -> Bool)
-> (PhysicalScreen -> PhysicalScreen -> Bool) -> Eq PhysicalScreen
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhysicalScreen -> PhysicalScreen -> Bool
$c/= :: PhysicalScreen -> PhysicalScreen -> Bool
== :: PhysicalScreen -> PhysicalScreen -> Bool
$c== :: PhysicalScreen -> PhysicalScreen -> Bool
Eq,Eq PhysicalScreen
Eq PhysicalScreen
-> (PhysicalScreen -> PhysicalScreen -> Ordering)
-> (PhysicalScreen -> PhysicalScreen -> Bool)
-> (PhysicalScreen -> PhysicalScreen -> Bool)
-> (PhysicalScreen -> PhysicalScreen -> Bool)
-> (PhysicalScreen -> PhysicalScreen -> Bool)
-> (PhysicalScreen -> PhysicalScreen -> PhysicalScreen)
-> (PhysicalScreen -> PhysicalScreen -> PhysicalScreen)
-> Ord PhysicalScreen
PhysicalScreen -> PhysicalScreen -> Bool
PhysicalScreen -> PhysicalScreen -> Ordering
PhysicalScreen -> PhysicalScreen -> PhysicalScreen
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PhysicalScreen -> PhysicalScreen -> PhysicalScreen
$cmin :: PhysicalScreen -> PhysicalScreen -> PhysicalScreen
max :: PhysicalScreen -> PhysicalScreen -> PhysicalScreen
$cmax :: PhysicalScreen -> PhysicalScreen -> PhysicalScreen
>= :: PhysicalScreen -> PhysicalScreen -> Bool
$c>= :: PhysicalScreen -> PhysicalScreen -> Bool
> :: PhysicalScreen -> PhysicalScreen -> Bool
$c> :: PhysicalScreen -> PhysicalScreen -> Bool
<= :: PhysicalScreen -> PhysicalScreen -> Bool
$c<= :: PhysicalScreen -> PhysicalScreen -> Bool
< :: PhysicalScreen -> PhysicalScreen -> Bool
$c< :: PhysicalScreen -> PhysicalScreen -> Bool
compare :: PhysicalScreen -> PhysicalScreen -> Ordering
$ccompare :: PhysicalScreen -> PhysicalScreen -> Ordering
Ord,Int -> PhysicalScreen -> ShowS
[PhysicalScreen] -> ShowS
PhysicalScreen -> WorkspaceId
(Int -> PhysicalScreen -> ShowS)
-> (PhysicalScreen -> WorkspaceId)
-> ([PhysicalScreen] -> ShowS)
-> Show PhysicalScreen
forall a.
(Int -> a -> ShowS)
-> (a -> WorkspaceId) -> ([a] -> ShowS) -> Show a
showList :: [PhysicalScreen] -> ShowS
$cshowList :: [PhysicalScreen] -> ShowS
show :: PhysicalScreen -> WorkspaceId
$cshow :: PhysicalScreen -> WorkspaceId
showsPrec :: Int -> PhysicalScreen -> ShowS
$cshowsPrec :: Int -> PhysicalScreen -> ShowS
Show,ReadPrec [PhysicalScreen]
ReadPrec PhysicalScreen
Int -> ReadS PhysicalScreen
ReadS [PhysicalScreen]
(Int -> ReadS PhysicalScreen)
-> ReadS [PhysicalScreen]
-> ReadPrec PhysicalScreen
-> ReadPrec [PhysicalScreen]
-> Read PhysicalScreen
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PhysicalScreen]
$creadListPrec :: ReadPrec [PhysicalScreen]
readPrec :: ReadPrec PhysicalScreen
$creadPrec :: ReadPrec PhysicalScreen
readList :: ReadS [PhysicalScreen]
$creadList :: ReadS [PhysicalScreen]
readsPrec :: Int -> ReadS PhysicalScreen
$creadsPrec :: Int -> ReadS PhysicalScreen
Read,Int -> PhysicalScreen
PhysicalScreen -> Int
PhysicalScreen -> [PhysicalScreen]
PhysicalScreen -> PhysicalScreen
PhysicalScreen -> PhysicalScreen -> [PhysicalScreen]
PhysicalScreen
-> PhysicalScreen -> PhysicalScreen -> [PhysicalScreen]
(PhysicalScreen -> PhysicalScreen)
-> (PhysicalScreen -> PhysicalScreen)
-> (Int -> PhysicalScreen)
-> (PhysicalScreen -> Int)
-> (PhysicalScreen -> [PhysicalScreen])
-> (PhysicalScreen -> PhysicalScreen -> [PhysicalScreen])
-> (PhysicalScreen -> PhysicalScreen -> [PhysicalScreen])
-> (PhysicalScreen
    -> PhysicalScreen -> PhysicalScreen -> [PhysicalScreen])
-> Enum PhysicalScreen
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 :: PhysicalScreen
-> PhysicalScreen -> PhysicalScreen -> [PhysicalScreen]
$cenumFromThenTo :: PhysicalScreen
-> PhysicalScreen -> PhysicalScreen -> [PhysicalScreen]
enumFromTo :: PhysicalScreen -> PhysicalScreen -> [PhysicalScreen]
$cenumFromTo :: PhysicalScreen -> PhysicalScreen -> [PhysicalScreen]
enumFromThen :: PhysicalScreen -> PhysicalScreen -> [PhysicalScreen]
$cenumFromThen :: PhysicalScreen -> PhysicalScreen -> [PhysicalScreen]
enumFrom :: PhysicalScreen -> [PhysicalScreen]
$cenumFrom :: PhysicalScreen -> [PhysicalScreen]
fromEnum :: PhysicalScreen -> Int
$cfromEnum :: PhysicalScreen -> Int
toEnum :: Int -> PhysicalScreen
$ctoEnum :: Int -> PhysicalScreen
pred :: PhysicalScreen -> PhysicalScreen
$cpred :: PhysicalScreen -> PhysicalScreen
succ :: PhysicalScreen -> PhysicalScreen
$csucc :: PhysicalScreen -> PhysicalScreen
Enum,Integer -> PhysicalScreen
PhysicalScreen -> PhysicalScreen
PhysicalScreen -> PhysicalScreen -> PhysicalScreen
(PhysicalScreen -> PhysicalScreen -> PhysicalScreen)
-> (PhysicalScreen -> PhysicalScreen -> PhysicalScreen)
-> (PhysicalScreen -> PhysicalScreen -> PhysicalScreen)
-> (PhysicalScreen -> PhysicalScreen)
-> (PhysicalScreen -> PhysicalScreen)
-> (PhysicalScreen -> PhysicalScreen)
-> (Integer -> PhysicalScreen)
-> Num PhysicalScreen
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> PhysicalScreen
$cfromInteger :: Integer -> PhysicalScreen
signum :: PhysicalScreen -> PhysicalScreen
$csignum :: PhysicalScreen -> PhysicalScreen
abs :: PhysicalScreen -> PhysicalScreen
$cabs :: PhysicalScreen -> PhysicalScreen
negate :: PhysicalScreen -> PhysicalScreen
$cnegate :: PhysicalScreen -> PhysicalScreen
* :: PhysicalScreen -> PhysicalScreen -> PhysicalScreen
$c* :: PhysicalScreen -> PhysicalScreen -> PhysicalScreen
- :: PhysicalScreen -> PhysicalScreen -> PhysicalScreen
$c- :: PhysicalScreen -> PhysicalScreen -> PhysicalScreen
+ :: PhysicalScreen -> PhysicalScreen -> PhysicalScreen
$c+ :: PhysicalScreen -> PhysicalScreen -> PhysicalScreen
Num,Enum PhysicalScreen
Real PhysicalScreen
Real PhysicalScreen
-> Enum PhysicalScreen
-> (PhysicalScreen -> PhysicalScreen -> PhysicalScreen)
-> (PhysicalScreen -> PhysicalScreen -> PhysicalScreen)
-> (PhysicalScreen -> PhysicalScreen -> PhysicalScreen)
-> (PhysicalScreen -> PhysicalScreen -> PhysicalScreen)
-> (PhysicalScreen
    -> PhysicalScreen -> (PhysicalScreen, PhysicalScreen))
-> (PhysicalScreen
    -> PhysicalScreen -> (PhysicalScreen, PhysicalScreen))
-> (PhysicalScreen -> Integer)
-> Integral PhysicalScreen
PhysicalScreen -> Integer
PhysicalScreen
-> PhysicalScreen -> (PhysicalScreen, PhysicalScreen)
PhysicalScreen -> PhysicalScreen -> PhysicalScreen
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: PhysicalScreen -> Integer
$ctoInteger :: PhysicalScreen -> Integer
divMod :: PhysicalScreen
-> PhysicalScreen -> (PhysicalScreen, PhysicalScreen)
$cdivMod :: PhysicalScreen
-> PhysicalScreen -> (PhysicalScreen, PhysicalScreen)
quotRem :: PhysicalScreen
-> PhysicalScreen -> (PhysicalScreen, PhysicalScreen)
$cquotRem :: PhysicalScreen
-> PhysicalScreen -> (PhysicalScreen, PhysicalScreen)
mod :: PhysicalScreen -> PhysicalScreen -> PhysicalScreen
$cmod :: PhysicalScreen -> PhysicalScreen -> PhysicalScreen
div :: PhysicalScreen -> PhysicalScreen -> PhysicalScreen
$cdiv :: PhysicalScreen -> PhysicalScreen -> PhysicalScreen
rem :: PhysicalScreen -> PhysicalScreen -> PhysicalScreen
$crem :: PhysicalScreen -> PhysicalScreen -> PhysicalScreen
quot :: PhysicalScreen -> PhysicalScreen -> PhysicalScreen
$cquot :: PhysicalScreen -> PhysicalScreen -> PhysicalScreen
Integral,Num PhysicalScreen
Ord PhysicalScreen
Num PhysicalScreen
-> Ord PhysicalScreen
-> (PhysicalScreen -> Rational)
-> Real PhysicalScreen
PhysicalScreen -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: PhysicalScreen -> Rational
$ctoRational :: PhysicalScreen -> Rational
Real)

getScreenIdAndRectangle :: W.Screen i l a ScreenId ScreenDetail -> (ScreenId, Rectangle)
getScreenIdAndRectangle :: forall i l a.
Screen i l a ScreenId ScreenDetail -> (ScreenId, Rectangle)
getScreenIdAndRectangle Screen i l a ScreenId ScreenDetail
screen = (Screen i l a ScreenId ScreenDetail -> ScreenId
forall i l a sid sd. Screen i l a sid sd -> sid
W.screen Screen i l a ScreenId ScreenDetail
screen, Rectangle
rect) where
  rect :: Rectangle
rect = ScreenDetail -> Rectangle
screenRect (ScreenDetail -> Rectangle) -> ScreenDetail -> Rectangle
forall a b. (a -> b) -> a -> b
$ Screen i l a ScreenId ScreenDetail -> ScreenDetail
forall i l a sid sd. Screen i l a sid sd -> sd
W.screenDetail Screen i l a ScreenId ScreenDetail
screen

-- | Translate a physical screen index to a "ScreenId"
getScreen:: ScreenComparator -> PhysicalScreen -> X (Maybe ScreenId)
getScreen :: ScreenComparator -> PhysicalScreen -> X (Maybe ScreenId)
getScreen (ScreenComparator (ScreenId, Rectangle) -> (ScreenId, Rectangle) -> Ordering
cmpScreen) (P Int
i) = do WindowSet
w <- (XState -> WindowSet) -> X WindowSet
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset
                                                  let screens :: [Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
screens = WindowSet
-> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current WindowSet
w Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
forall a. a -> [a] -> [a]
: WindowSet
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
forall i l a sid sd. StackSet i l a sid sd -> [Screen i l a sid sd]
W.visible WindowSet
w
                                                  if Int
iInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
0 Bool -> Bool -> Bool
|| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= [Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
-> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
screens
                                                    then Maybe ScreenId -> X (Maybe ScreenId)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ScreenId
forall a. Maybe a
Nothing
                                                    else let ss :: [Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
ss = (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> Ordering)
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((ScreenId, Rectangle) -> (ScreenId, Rectangle) -> Ordering
cmpScreen ((ScreenId, Rectangle) -> (ScreenId, Rectangle) -> Ordering)
-> (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
    -> (ScreenId, Rectangle))
-> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> (ScreenId, Rectangle)
forall i l a.
Screen i l a ScreenId ScreenDetail -> (ScreenId, Rectangle)
getScreenIdAndRectangle) [Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
screens
                                                    in Maybe ScreenId -> X (Maybe ScreenId)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ScreenId -> X (Maybe ScreenId))
-> Maybe ScreenId -> X (Maybe ScreenId)
forall a b. (a -> b) -> a -> b
$ ScreenId -> Maybe ScreenId
forall a. a -> Maybe a
Just (ScreenId -> Maybe ScreenId) -> ScreenId -> Maybe ScreenId
forall a b. (a -> b) -> a -> b
$ Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> ScreenId
forall i l a sid sd. Screen i l a sid sd -> sid
W.screen (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> ScreenId)
-> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> ScreenId
forall a b. (a -> b) -> a -> b
$ [Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
ss [Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
-> Int
-> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
forall a. [a] -> Int -> a
!! Int
i

-- | Switch to a given physical screen
viewScreen :: ScreenComparator -> PhysicalScreen -> X ()
viewScreen :: ScreenComparator -> PhysicalScreen -> X ()
viewScreen ScreenComparator
sc PhysicalScreen
p = do Maybe ScreenId
i <- ScreenComparator -> PhysicalScreen -> X (Maybe ScreenId)
getScreen ScreenComparator
sc PhysicalScreen
p
                     Maybe ScreenId -> (ScreenId -> X ()) -> X ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe ScreenId
i ((ScreenId -> X ()) -> X ()) -> (ScreenId -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \ScreenId
s -> do
                         Maybe WorkspaceId
w <- ScreenId -> X (Maybe WorkspaceId)
screenWorkspace ScreenId
s
                         Maybe WorkspaceId -> (WorkspaceId -> X ()) -> X ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe WorkspaceId
w ((WorkspaceId -> X ()) -> X ()) -> (WorkspaceId -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ (WindowSet -> WindowSet) -> X ()
windows ((WindowSet -> WindowSet) -> X ())
-> (WorkspaceId -> WindowSet -> WindowSet) -> WorkspaceId -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WorkspaceId -> WindowSet -> WindowSet
forall s i l a sd.
(Eq s, Eq i) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
W.view

-- | Send the active window to a given physical screen
sendToScreen :: ScreenComparator -> PhysicalScreen -> X ()
sendToScreen :: ScreenComparator -> PhysicalScreen -> X ()
sendToScreen ScreenComparator
sc PhysicalScreen
p = do Maybe ScreenId
i <- ScreenComparator -> PhysicalScreen -> X (Maybe ScreenId)
getScreen ScreenComparator
sc PhysicalScreen
p
                       Maybe ScreenId -> (ScreenId -> X ()) -> X ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe ScreenId
i ((ScreenId -> X ()) -> X ()) -> (ScreenId -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \ScreenId
s -> do
                         Maybe WorkspaceId
w <- ScreenId -> X (Maybe WorkspaceId)
screenWorkspace ScreenId
s
                         Maybe WorkspaceId -> (WorkspaceId -> X ()) -> X ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe WorkspaceId
w ((WorkspaceId -> X ()) -> X ()) -> (WorkspaceId -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ (WindowSet -> WindowSet) -> X ()
windows ((WindowSet -> WindowSet) -> X ())
-> (WorkspaceId -> WindowSet -> WindowSet) -> WorkspaceId -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WorkspaceId -> WindowSet -> WindowSet
forall a s i l sd.
(Ord a, Eq s, Eq i) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
W.shift

-- | A ScreenComparator allow to compare two screen based on their coordonate and Xinerama Id
newtype ScreenComparator = ScreenComparator ((ScreenId, Rectangle) -> (ScreenId, Rectangle) -> Ordering)

-- | The default ScreenComparator orders screens by the upper-left-most corner, from top-to-bottom
instance Default ScreenComparator where
  def :: ScreenComparator
def= ScreenComparator
verticalScreenOrderer

-- | Compare screen only by their coordonate
screenComparatorByRectangle :: (Rectangle -> Rectangle -> Ordering) -> ScreenComparator
screenComparatorByRectangle :: (Rectangle -> Rectangle -> Ordering) -> ScreenComparator
screenComparatorByRectangle Rectangle -> Rectangle -> Ordering
rectComparator = ((ScreenId, Rectangle) -> (ScreenId, Rectangle) -> Ordering)
-> ScreenComparator
ScreenComparator (ScreenId, Rectangle) -> (ScreenId, Rectangle) -> Ordering
forall {a} {a}. (a, Rectangle) -> (a, Rectangle) -> Ordering
comparator where
  comparator :: (a, Rectangle) -> (a, Rectangle) -> Ordering
comparator (a
_, Rectangle
rec1) (a
_, Rectangle
rec2) = Rectangle -> Rectangle -> Ordering
rectComparator Rectangle
rec1 Rectangle
rec2

-- | Compare screen only by their Xinerama id
screenComparatorById :: (ScreenId -> ScreenId -> Ordering) -> ScreenComparator
screenComparatorById :: (ScreenId -> ScreenId -> Ordering) -> ScreenComparator
screenComparatorById ScreenId -> ScreenId -> Ordering
idComparator = ((ScreenId, Rectangle) -> (ScreenId, Rectangle) -> Ordering)
-> ScreenComparator
ScreenComparator (ScreenId, Rectangle) -> (ScreenId, Rectangle) -> Ordering
forall {b} {b}. (ScreenId, b) -> (ScreenId, b) -> Ordering
comparator where
  comparator :: (ScreenId, b) -> (ScreenId, b) -> Ordering
comparator (ScreenId
id1, b
_) (ScreenId
id2, b
_) = ScreenId -> ScreenId -> Ordering
idComparator ScreenId
id1 ScreenId
id2

-- | orders screens by the upper-left-most corner, from top-to-bottom
verticalScreenOrderer :: ScreenComparator
verticalScreenOrderer :: ScreenComparator
verticalScreenOrderer = (Rectangle -> Rectangle -> Ordering) -> ScreenComparator
screenComparatorByRectangle Rectangle -> Rectangle -> Ordering
comparator where
    comparator :: Rectangle -> Rectangle -> Ordering
comparator (Rectangle Position
x1 Position
y1 Dimension
_ Dimension
_) (Rectangle Position
x2 Position
y2 Dimension
_ Dimension
_) = (Position, Position) -> (Position, Position) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Position
y1, Position
x1) (Position
y2, Position
x2)

-- | orders screens by the upper-left-most corner, from left-to-right
horizontalScreenOrderer :: ScreenComparator
horizontalScreenOrderer :: ScreenComparator
horizontalScreenOrderer = (Rectangle -> Rectangle -> Ordering) -> ScreenComparator
screenComparatorByRectangle Rectangle -> Rectangle -> Ordering
comparator where
    comparator :: Rectangle -> Rectangle -> Ordering
comparator (Rectangle Position
x1 Position
y1 Dimension
_ Dimension
_) (Rectangle Position
x2 Position
y2 Dimension
_ Dimension
_) = (Position, Position) -> (Position, Position) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Position
x1, Position
y1) (Position
x2, Position
y2)

-- | Get ScreenId for neighbours of the current screen based on position offset.
getNeighbour :: ScreenComparator -> Int -> X ScreenId
getNeighbour :: ScreenComparator -> Int -> X ScreenId
getNeighbour (ScreenComparator (ScreenId, Rectangle) -> (ScreenId, Rectangle) -> Ordering
cmpScreen) Int
d =
  do WindowSet
w <- (XState -> WindowSet) -> X WindowSet
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset
     let ss :: [ScreenId]
ss = (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> ScreenId)
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
-> [ScreenId]
forall a b. (a -> b) -> [a] -> [b]
map Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> ScreenId
forall i l a sid sd. Screen i l a sid sd -> sid
W.screen ([Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
 -> [ScreenId])
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
-> [ScreenId]
forall a b. (a -> b) -> a -> b
$ (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> Ordering)
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((ScreenId, Rectangle) -> (ScreenId, Rectangle) -> Ordering
cmpScreen ((ScreenId, Rectangle) -> (ScreenId, Rectangle) -> Ordering)
-> (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
    -> (ScreenId, Rectangle))
-> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> (ScreenId, Rectangle)
forall i l a.
Screen i l a ScreenId ScreenDetail -> (ScreenId, Rectangle)
getScreenIdAndRectangle) ([Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
 -> [Screen
       WorkspaceId (Layout Window) Window ScreenId ScreenDetail])
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
forall a b. (a -> b) -> a -> b
$ WindowSet
-> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current WindowSet
w Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
forall a. a -> [a] -> [a]
: WindowSet
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
forall i l a sid sd. StackSet i l a sid sd -> [Screen i l a sid sd]
W.visible WindowSet
w
         curPos :: Int
curPos = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ ScreenId -> [ScreenId] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> ScreenId
forall i l a sid sd. Screen i l a sid sd -> sid
W.screen (WindowSet
-> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current WindowSet
w)) [ScreenId]
ss
         pos :: Int
pos = (Int
curPos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
d) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` [ScreenId] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ScreenId]
ss
     ScreenId -> X ScreenId
forall (m :: * -> *) a. Monad m => a -> m a
return (ScreenId -> X ScreenId) -> ScreenId -> X ScreenId
forall a b. (a -> b) -> a -> b
$ [ScreenId]
ss [ScreenId] -> Int -> ScreenId
forall a. [a] -> Int -> a
!! Int
pos

neighbourWindows :: ScreenComparator -> Int -> (WorkspaceId -> WindowSet -> WindowSet) -> X ()
neighbourWindows :: ScreenComparator
-> Int -> (WorkspaceId -> WindowSet -> WindowSet) -> X ()
neighbourWindows ScreenComparator
sc Int
d WorkspaceId -> WindowSet -> WindowSet
f = do ScreenId
s <- ScreenComparator -> Int -> X ScreenId
getNeighbour ScreenComparator
sc Int
d
                             Maybe WorkspaceId
w <- ScreenId -> X (Maybe WorkspaceId)
screenWorkspace ScreenId
s
                             Maybe WorkspaceId -> (WorkspaceId -> X ()) -> X ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe WorkspaceId
w ((WorkspaceId -> X ()) -> X ()) -> (WorkspaceId -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ (WindowSet -> WindowSet) -> X ()
windows ((WindowSet -> WindowSet) -> X ())
-> (WorkspaceId -> WindowSet -> WindowSet) -> WorkspaceId -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WorkspaceId -> WindowSet -> WindowSet
f

-- | Apply operation on a WindowSet with the WorkspaceId of the next screen in the physical order as parameter.
onNextNeighbour :: ScreenComparator -> (WorkspaceId -> WindowSet -> WindowSet) -> X ()
onNextNeighbour :: ScreenComparator -> (WorkspaceId -> WindowSet -> WindowSet) -> X ()
onNextNeighbour ScreenComparator
sc = ScreenComparator
-> Int -> (WorkspaceId -> WindowSet -> WindowSet) -> X ()
neighbourWindows ScreenComparator
sc Int
1

-- | Apply operation on a WindowSet with the WorkspaceId of the previous screen in the physical order as parameter.
onPrevNeighbour :: ScreenComparator -> (WorkspaceId -> WindowSet -> WindowSet) -> X ()
onPrevNeighbour :: ScreenComparator -> (WorkspaceId -> WindowSet -> WindowSet) -> X ()
onPrevNeighbour ScreenComparator
sc = ScreenComparator
-> Int -> (WorkspaceId -> WindowSet -> WindowSet) -> X ()
neighbourWindows ScreenComparator
sc (-Int
1)