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

-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Layout.WindowNavigation
-- Description :  A layout modifier to allow easy navigation of a workspace.
-- Copyright   :  (c) 2007  David Roundy <droundy@darcs.net>
-- License     :  BSD3-style (see LICENSE)
--
-- Maintainer  :  Devin Mullins <me@twifkak.com>
-- Stability   :  unstable
-- Portability :  unportable
--
-- WindowNavigation is an extension to allow easy navigation of a workspace.
--
-----------------------------------------------------------------------------

module XMonad.Layout.WindowNavigation (
                                   -- * Usage
                                   -- $usage
                                   windowNavigation, configurableNavigation,
                                   Navigate(..), Direction2D(..),
                                   MoveWindowToWindow(..), WNConfig,
                                   navigateColor, navigateBrightness,
                                   noNavigateBorders, def,
                                   WindowNavigation,
                                  ) where

import XMonad.Prelude ( nub, sortBy, (\\) )
import XMonad hiding (Point)
import qualified XMonad.StackSet as W
import XMonad.Layout.LayoutModifier
import XMonad.Util.Invisible
import XMonad.Util.Types (Direction2D(..))
import XMonad.Util.XUtils

-- $usage
-- You can use this module with the following in your @xmonad.hs@:
--
-- > import XMonad.Layout.WindowNavigation
--
-- Then edit your 'layoutHook' by adding the WindowNavigation layout modifier
-- to some layout:
--
-- > myLayout = windowNavigation (Tall 1 (3/100) (1/2)) ||| Full ||| etc..
-- > main = xmonad def { layoutHook = myLayout }
--
-- For more detailed instructions on editing the 'layoutHook' see
-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial> and
-- "XMonad.Doc.Extending#Editing_the_layout_hook".
--
-- In keybindings:
--
-- >    , ((modm,                 xK_Right), sendMessage $ Go R)
-- >    , ((modm,                 xK_Left ), sendMessage $ Go L)
-- >    , ((modm,                 xK_Up   ), sendMessage $ Go U)
-- >    , ((modm,                 xK_Down ), sendMessage $ Go D)
-- >    , ((modm .|. controlMask, xK_Right), sendMessage $ Swap R)
-- >    , ((modm .|. controlMask, xK_Left ), sendMessage $ Swap L)
-- >    , ((modm .|. controlMask, xK_Up   ), sendMessage $ Swap U)
-- >    , ((modm .|. controlMask, xK_Down ), sendMessage $ Swap D)
--
-- For detailed instruction on editing the key binding see:
--
-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.


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

data Navigate = Go Direction2D | Swap Direction2D | Move Direction2D
              | Apply (Window -> X()) Direction2D -- ^ Apply action with destination window
instance Message Navigate

-- | Used with 'configurableNavigation' to specify how to show reachable windows'
-- borders. You cannot create 'WNConfig' values directly; use 'def' or one of the following
-- three functions to create one.
--
-- 'def', and 'windowNavigation', uses the focused border color at 40% brightness, as if
-- you had specified
--
-- > configurableNavigation (navigateBrightness 0.4)
data WNConfig =
    WNC { WNConfig -> Maybe Double
brightness    :: Maybe Double -- Indicates a fraction of the focus color.
        , WNConfig -> String
upColor       :: String
        , WNConfig -> String
downColor     :: String
        , WNConfig -> String
leftColor     :: String
        , WNConfig -> String
rightColor    :: String
        } deriving (Int -> WNConfig -> ShowS
[WNConfig] -> ShowS
WNConfig -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WNConfig] -> ShowS
$cshowList :: [WNConfig] -> ShowS
show :: WNConfig -> String
$cshow :: WNConfig -> String
showsPrec :: Int -> WNConfig -> ShowS
$cshowsPrec :: Int -> WNConfig -> ShowS
Show, ReadPrec [WNConfig]
ReadPrec WNConfig
Int -> ReadS WNConfig
ReadS [WNConfig]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [WNConfig]
$creadListPrec :: ReadPrec [WNConfig]
readPrec :: ReadPrec WNConfig
$creadPrec :: ReadPrec WNConfig
readList :: ReadS [WNConfig]
$creadList :: ReadS [WNConfig]
readsPrec :: Int -> ReadS WNConfig
$creadsPrec :: Int -> ReadS WNConfig
Read)

-- | Don't use window borders for navigation.
noNavigateBorders :: WNConfig
noNavigateBorders :: WNConfig
noNavigateBorders =
    forall a. Default a => a
def {brightness :: Maybe Double
brightness = forall a. a -> Maybe a
Just Double
0}

-- | Indicate reachable windows by drawing their borders in the specified color.
navigateColor :: String -> WNConfig
navigateColor :: String -> WNConfig
navigateColor String
c =
    Maybe Double -> String -> String -> String -> String -> WNConfig
WNC forall a. Maybe a
Nothing String
c String
c String
c String
c

-- | Indicate reachable windows by drawing their borders in the active border color, with
-- the specified brightness.
navigateBrightness :: Double -> WNConfig
navigateBrightness :: Double -> WNConfig
navigateBrightness Double
f = forall a. Default a => a
def { brightness :: Maybe Double
brightness = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> a
max Double
0 forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> a
min Double
1 Double
f }

instance Default WNConfig where def :: WNConfig
def = Maybe Double -> String -> String -> String -> String -> WNConfig
WNC (forall a. a -> Maybe a
Just Double
0.4) String
"#0000FF" String
"#00FFFF" String
"#FF0000" String
"#FF00FF"

data NavigationState a = NS Point [(a,Rectangle)]

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

windowNavigation :: LayoutClass l a => l a -> ModifiedLayout WindowNavigation l a
windowNavigation :: forall (l :: * -> *) a.
LayoutClass l a =>
l a -> ModifiedLayout WindowNavigation l a
windowNavigation = forall (m :: * -> *) (l :: * -> *) a.
m a -> l a -> ModifiedLayout m l a
ModifiedLayout (forall a.
WNConfig
-> Invisible Maybe (NavigationState a) -> WindowNavigation a
WindowNavigation forall a. Default a => a
def (forall (m :: * -> *) a. m a -> Invisible m a
I forall a. Maybe a
Nothing))

configurableNavigation :: LayoutClass l a => WNConfig -> l a -> ModifiedLayout WindowNavigation l a
configurableNavigation :: forall (l :: * -> *) a.
LayoutClass l a =>
WNConfig -> l a -> ModifiedLayout WindowNavigation l a
configurableNavigation WNConfig
conf = forall (m :: * -> *) (l :: * -> *) a.
m a -> l a -> ModifiedLayout m l a
ModifiedLayout (forall a.
WNConfig
-> Invisible Maybe (NavigationState a) -> WindowNavigation a
WindowNavigation WNConfig
conf (forall (m :: * -> *) a. m a -> Invisible m a
I forall a. Maybe a
Nothing))

instance LayoutModifier WindowNavigation Window where
    redoLayout :: WindowNavigation Window
-> Rectangle
-> Maybe (Stack Window)
-> [(Window, Rectangle)]
-> X ([(Window, Rectangle)], Maybe (WindowNavigation Window))
redoLayout (WindowNavigation WNConfig
conf (I Maybe (NavigationState Window)
st)) Rectangle
rscr (Just Stack Window
s) [(Window, Rectangle)]
origwrs =
        do XConf { normalBorder :: XConf -> Window
normalBorder = Window
nbc, focusedBorder :: XConf -> Window
focusedBorder = Window
fbc, display :: XConf -> Display
display = Display
dpy } <- forall r (m :: * -> *). MonadReader r m => m r
ask
           [Window
uc,Window
dc,Window
lc,Window
rc] <-
               case WNConfig -> Maybe Double
brightness WNConfig
conf of
               Just Double
frac -> do Window
myc <- Window -> Window -> Double -> X Window
averagePixels Window
fbc Window
nbc Double
frac
                               forall (m :: * -> *) a. Monad m => a -> m a
return [Window
myc,Window
myc,Window
myc,Window
myc]
               Maybe Double
Nothing -> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
(Functor m, MonadIO m) =>
Display -> String -> m Window
stringToPixel Display
dpy) [WNConfig -> String
upColor WNConfig
conf, WNConfig -> String
downColor WNConfig
conf,
                                                    WNConfig -> String
leftColor WNConfig
conf, WNConfig -> String
rightColor WNConfig
conf]
           let dirc :: Direction2D -> Window
dirc Direction2D
U = Window
uc
               dirc Direction2D
D = Window
dc
               dirc Direction2D
L = Window
lc
               dirc Direction2D
R = Window
rc
           let w :: Window
w    = forall a. Stack a -> a
W.focus Stack Window
s
               r :: Rectangle
r    = case forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
==Window
w)forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (a, b) -> a
fst) [(Window, Rectangle)]
origwrs of ((Window
_,Rectangle
x):[(Window, Rectangle)]
_) -> Rectangle
x
                                                         []        -> Rectangle
rscr
               pt :: Point
pt   = case Maybe (NavigationState Window)
st of Just (NS Point
ptold [(Window, Rectangle)]
_) | Point
ptold Point -> Rectangle -> Bool
`inrect` Rectangle
r -> Point
ptold
                                 Maybe (NavigationState Window)
_ -> Rectangle -> Point
center Rectangle
r
               existing_wins :: [Window]
existing_wins = forall a. Stack a -> [a]
W.integrate Stack Window
s
               wrs :: [(Window, Rectangle)]
wrs = forall a. (a -> Bool) -> [a] -> [a]
filter ((forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Window]
existing_wins) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
/=Rectangle
r) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall a b. (a -> b) -> a -> b
$
                     forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
/=Window
w) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(Window, Rectangle)]
origwrs
               wnavigable :: [(Window, Rectangle)]
wnavigable = forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
                            (\Direction2D
d -> forall a. Int -> [a] -> [a]
take Int
1 forall a b. (a -> b) -> a -> b
$ Direction2D
-> Point -> [(Window, Rectangle)] -> [(Window, Rectangle)]
navigable Direction2D
d Point
pt [(Window, Rectangle)]
wrs) [Direction2D
U,Direction2D
D,Direction2D
R,Direction2D
L]
               wnavigablec :: [(Window, Window)]
wnavigablec = forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
                            (\Direction2D
d -> forall a b. (a -> b) -> [a] -> [b]
map (\(Window
win,Rectangle
_) -> (Window
win,Direction2D -> Window
dirc Direction2D
d)) forall a b. (a -> b) -> a -> b
$
                                   forall a. Int -> [a] -> [a]
take Int
1 forall a b. (a -> b) -> a -> b
$ Direction2D
-> Point -> [(Window, Rectangle)] -> [(Window, Rectangle)]
navigable Direction2D
d Point
pt [(Window, Rectangle)]
wrs) [Direction2D
U,Direction2D
D,Direction2D
R,Direction2D
L]
               wothers :: [Window]
wothers = case Maybe (NavigationState Window)
st of Just (NS Point
_ [(Window, Rectangle)]
wo) -> forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(Window, Rectangle)]
wo
                                    Maybe (NavigationState Window)
_              -> []
           forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Window -> Window -> X ()
sc Window
nbc) ([Window]
wothers forall a. Eq a => [a] -> [a] -> [a]
\\ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(Window, Rectangle)]
wnavigable)
           forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(Window
win,Window
c) -> Window -> Window -> X ()
sc Window
c Window
win) [(Window, Window)]
wnavigablec
           forall (m :: * -> *) a. Monad m => a -> m a
return ([(Window, Rectangle)]
origwrs, forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a.
WNConfig
-> Invisible Maybe (NavigationState a) -> WindowNavigation a
WindowNavigation WNConfig
conf forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. m a -> Invisible m a
I forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Point -> [(a, Rectangle)] -> NavigationState a
NS Point
pt [(Window, Rectangle)]
wnavigable)
    redoLayout WindowNavigation Window
_ Rectangle
_ Maybe (Stack Window)
_ [(Window, Rectangle)]
origwrs = forall (m :: * -> *) a. Monad m => a -> m a
return ([(Window, Rectangle)]
origwrs, forall a. Maybe a
Nothing)

    handleMessOrMaybeModifyIt :: WindowNavigation Window
-> SomeMessage
-> X (Maybe (Either (WindowNavigation Window) SomeMessage))
handleMessOrMaybeModifyIt (WindowNavigation WNConfig
conf (I (Just (NS Point
pt [(Window, Rectangle)]
wrs)))) SomeMessage
m
        | Just (Go Direction2D
d) <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m =
                         case Direction2D
-> Point -> [(Window, Rectangle)] -> [(Window, Rectangle)]
navigable Direction2D
d Point
pt [(Window, Rectangle)]
wrs of
                         []        -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
                         ((Window
w,Rectangle
r):[(Window, Rectangle)]
_) -> do forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify XState -> XState
focusWindowHere
                                         forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall a.
WNConfig
-> Invisible Maybe (NavigationState a) -> WindowNavigation a
WindowNavigation WNConfig
conf forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. m a -> Invisible m a
I forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
                                                forall a. Point -> [(a, Rectangle)] -> NavigationState a
NS (Direction2D -> Point -> Rectangle -> Point
centerd Direction2D
d Point
pt Rectangle
r) [(Window, Rectangle)]
wrs
                             where focusWindowHere :: XState -> XState
                                   focusWindowHere :: XState -> XState
focusWindowHere XState
s
                                       | forall a. a -> Maybe a
Just Window
w forall a. Eq a => a -> a -> Bool
== forall i l a s sd. StackSet i l a s sd -> Maybe a
W.peek (XState -> WindowSet
windowset XState
s) = XState
s
                                       | forall {a}. Eq a => a -> Maybe (Stack a) -> Bool
has Window
w forall a b. (a -> b) -> a -> b
$ forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack forall a b. (a -> b) -> a -> b
$ forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace forall a b. (a -> b) -> a -> b
$ forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current forall a b. (a -> b) -> a -> b
$ XState -> WindowSet
windowset XState
s =
                                           XState
s { windowset :: WindowSet
windowset = forall a. (a -> Bool) -> (a -> a) -> a -> a
until ((forall a. a -> Maybe a
Just Window
w forall a. Eq a => a -> a -> Bool
==) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a s sd. StackSet i l a s sd -> Maybe a
W.peek)
                                                           forall i l a s sd. StackSet i l a s sd -> StackSet i l a s sd
W.focusUp forall a b. (a -> b) -> a -> b
$ XState -> WindowSet
windowset XState
s }
                                       | Bool
otherwise = XState
s
                                   has :: a -> Maybe (Stack a) -> Bool
has a
_ Maybe (Stack a)
Nothing         = Bool
False
                                   has a
x (Just (W.Stack a
t [a]
l [a]
rr)) = a
x forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (a
t forall a. a -> [a] -> [a]
: [a]
l forall a. [a] -> [a] -> [a]
++ [a]
rr)

        | Just (Swap Direction2D
d) <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m =
             case Direction2D
-> Point -> [(Window, Rectangle)] -> [(Window, Rectangle)]
navigable Direction2D
d Point
pt [(Window, Rectangle)]
wrs of
             []        -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
             ((Window
w,Rectangle
_):[(Window, Rectangle)]
_) -> do let swap :: Stack Window -> Stack Window
swap Stack Window
st = forall {a}. Eq a => a -> [a] -> Stack a
unint (forall a. Stack a -> a
W.focus Stack Window
st) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Window -> Window -> Window
swapw (forall a. Stack a -> a
W.focus Stack Window
st)) forall a b. (a -> b) -> a -> b
$ forall a. Stack a -> [a]
W.integrate Stack Window
st
                                 swapw :: Window -> Window -> Window
swapw Window
y Window
x | Window
x forall a. Eq a => a -> a -> Bool
== Window
w = Window
y
                                           | Window
x forall a. Eq a => a -> a -> Bool
== Window
y = Window
w
                                           | Bool
otherwise = Window
x
                                 unint :: a -> [a] -> Stack a
unint a
f [a]
xs = case forall a. (a -> Bool) -> [a] -> ([a], [a])
span (forall a. Eq a => a -> a -> Bool
/= a
f) [a]
xs of
                                              ([a]
u,a
_:[a]
dn) -> W.Stack { focus :: a
W.focus = a
f
                                                                  , up :: [a]
W.up = forall a. [a] -> [a]
reverse [a]
u
                                                                  , down :: [a]
W.down = [a]
dn }
                                              ([a], [a])
_ -> W.Stack { focus :: a
W.focus = a
f
                                                           , down :: [a]
W.down = [a]
xs
                                                           , up :: [a]
W.up = [] }
                             (WindowSet -> WindowSet) -> X ()
windows forall a b. (a -> b) -> a -> b
$ forall a i l s sd.
(Stack a -> Stack a) -> StackSet i l a s sd -> StackSet i l a s sd
W.modify' Stack Window -> Stack Window
swap
                             forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
        | Just (Move Direction2D
d) <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m =
             case Direction2D
-> Point -> [(Window, Rectangle)] -> [(Window, Rectangle)]
navigable Direction2D
d Point
pt [(Window, Rectangle)]
wrs of
             []        -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
             ((Window
w,Rectangle
_):[(Window, Rectangle)]
_) -> do Maybe (Stack Window)
mst <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset)
                             forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ do Stack Window
st <- Maybe (Stack Window)
mst
                                         forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a. Message a => a -> SomeMessage
SomeMessage forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> MoveWindowToWindow a
MoveWindowToWindow (forall a. Stack a -> a
W.focus Stack Window
st) Window
w
        | Just (Apply Window -> X ()
f Direction2D
d) <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m =
             case Direction2D
-> Point -> [(Window, Rectangle)] -> [(Window, Rectangle)]
navigable Direction2D
d Point
pt [(Window, Rectangle)]
wrs of
             []         -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
             ((Window
w,Rectangle
_):[(Window, Rectangle)]
_)  -> Window -> X ()
f Window
w forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
        | Just LayoutMessages
Hide <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m =
                       do XConf { normalBorder :: XConf -> Window
normalBorder = Window
nbc } <- forall r (m :: * -> *). MonadReader r m => m r
ask
                          forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Window -> Window -> X ()
sc Window
nbc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(Window, Rectangle)]
wrs
                          forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall a.
WNConfig
-> Invisible Maybe (NavigationState a) -> WindowNavigation a
WindowNavigation WNConfig
conf forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. m a -> Invisible m a
I forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Point -> [(a, Rectangle)] -> NavigationState a
NS Point
pt []
        | Just LayoutMessages
ReleaseResources <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m =
               forall (m :: * -> *) a.
LayoutModifier m a =>
m a -> SomeMessage -> X (Maybe (Either (m a) SomeMessage))
handleMessOrMaybeModifyIt (forall a.
WNConfig
-> Invisible Maybe (NavigationState a) -> WindowNavigation a
WindowNavigation WNConfig
conf (forall (m :: * -> *) a. m a -> Invisible m a
I forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (forall a. Point -> [(a, Rectangle)] -> NavigationState a
NS Point
pt [(Window, Rectangle)]
wrs))) (forall a. Message a => a -> SomeMessage
SomeMessage LayoutMessages
Hide)
    handleMessOrMaybeModifyIt WindowNavigation Window
_ SomeMessage
_ = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

navigable :: Direction2D -> Point -> [(Window, Rectangle)] -> [(Window, Rectangle)]
navigable :: Direction2D
-> Point -> [(Window, Rectangle)] -> [(Window, Rectangle)]
navigable Direction2D
d Point
pt = forall a. Direction2D -> [(a, Rectangle)] -> [(a, Rectangle)]
sortby Direction2D
d forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (Direction2D -> Point -> Rectangle -> Bool
inr Direction2D
d Point
pt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)

sc :: Pixel -> Window -> X ()
sc :: Window -> Window -> X ()
sc Window
c Window
win = forall a. (Display -> X a) -> X a
withDisplay forall a b. (a -> b) -> a -> b
$ \Display
dpy -> do
    String
colorName <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (forall (m :: * -> *). MonadIO m => Display -> Window -> m String
pixelToString Display
dpy Window
c)
    Display -> Window -> String -> Window -> X ()
setWindowBorderWithFallback Display
dpy Window
win String
colorName Window
c

center :: Rectangle -> Point
center :: Rectangle -> Point
center (Rectangle Position
x Position
y Dimension
w Dimension
h) = Double -> Double -> Point
P (forall a b. (Integral a, Num b) => a -> b
fromIntegral Position
x forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
wforall a. Fractional a => a -> a -> a
/Double
2)  (forall a b. (Integral a, Num b) => a -> b
fromIntegral Position
y forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
hforall a. Fractional a => a -> a -> a
/Double
2)

centerd :: Direction2D -> Point -> Rectangle -> Point
centerd :: Direction2D -> Point -> Rectangle -> Point
centerd Direction2D
d (P Double
xx Double
yy) (Rectangle Position
x Position
y Dimension
w Dimension
h) | Direction2D
d forall a. Eq a => a -> a -> Bool
== Direction2D
U Bool -> Bool -> Bool
|| Direction2D
d forall a. Eq a => a -> a -> Bool
== Direction2D
D = Double -> Double -> Point
P Double
xx (forall a b. (Integral a, Num b) => a -> b
fromIntegral Position
y forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
hforall a. Fractional a => a -> a -> a
/Double
2)
                                        | Bool
otherwise = Double -> Double -> Point
P (forall a b. (Integral a, Num b) => a -> b
fromIntegral Position
x forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
wforall a. Fractional a => a -> a -> a
/Double
2) Double
yy

inr :: Direction2D -> Point -> Rectangle -> Bool
inr :: Direction2D -> Point -> Rectangle -> Bool
inr Direction2D
D (P Double
x Double
y) (Rectangle Position
l Position
yr Dimension
w Dimension
h) = Double
x forall a. Ord a => a -> a -> Bool
>= forall a b. (Integral a, Num b) => a -> b
fromIntegral Position
l Bool -> Bool -> Bool
&& Double
x forall a. Ord a => a -> a -> Bool
< forall a b. (Integral a, Num b) => a -> b
fromIntegral Position
l forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
w Bool -> Bool -> Bool
&&
                                     Double
y forall a. Ord a => a -> a -> Bool
<  forall a b. (Integral a, Num b) => a -> b
fromIntegral Position
yr forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
h
inr Direction2D
U (P Double
x Double
y) (Rectangle Position
l Position
yr Dimension
w Dimension
_) = Double
x forall a. Ord a => a -> a -> Bool
>= forall a b. (Integral a, Num b) => a -> b
fromIntegral Position
l Bool -> Bool -> Bool
&& Double
x forall a. Ord a => a -> a -> Bool
< forall a b. (Integral a, Num b) => a -> b
fromIntegral Position
l forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
w Bool -> Bool -> Bool
&&
                                     Double
y forall a. Ord a => a -> a -> Bool
>  forall a b. (Integral a, Num b) => a -> b
fromIntegral Position
yr
inr Direction2D
R (P Double
a Double
x) (Rectangle Position
b Position
l Dimension
_ Dimension
w)  = Double
x forall a. Ord a => a -> a -> Bool
>= forall a b. (Integral a, Num b) => a -> b
fromIntegral Position
l Bool -> Bool -> Bool
&& Double
x forall a. Ord a => a -> a -> Bool
< forall a b. (Integral a, Num b) => a -> b
fromIntegral Position
l forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
w Bool -> Bool -> Bool
&&
                                     Double
a forall a. Ord a => a -> a -> Bool
<  forall a b. (Integral a, Num b) => a -> b
fromIntegral Position
b
inr Direction2D
L (P Double
a Double
x) (Rectangle Position
b Position
l Dimension
c Dimension
w)  = Double
x forall a. Ord a => a -> a -> Bool
>= forall a b. (Integral a, Num b) => a -> b
fromIntegral Position
l Bool -> Bool -> Bool
&& Double
x forall a. Ord a => a -> a -> Bool
< forall a b. (Integral a, Num b) => a -> b
fromIntegral Position
l forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
w Bool -> Bool -> Bool
&&
                                     Double
a forall a. Ord a => a -> a -> Bool
>  forall a b. (Integral a, Num b) => a -> b
fromIntegral Position
b forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
c

inrect :: Point -> Rectangle -> Bool
inrect :: Point -> Rectangle -> Bool
inrect (P Double
x Double
y) (Rectangle Position
a Position
b Dimension
w Dimension
h) = Double
x forall a. Ord a => a -> a -> Bool
>  forall a b. (Integral a, Num b) => a -> b
fromIntegral Position
a Bool -> Bool -> Bool
&& Double
x forall a. Ord a => a -> a -> Bool
< forall a b. (Integral a, Num b) => a -> b
fromIntegral Position
a forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
w Bool -> Bool -> Bool
&&
                                     Double
y forall a. Ord a => a -> a -> Bool
>  forall a b. (Integral a, Num b) => a -> b
fromIntegral Position
b Bool -> Bool -> Bool
&& Double
y forall a. Ord a => a -> a -> Bool
< forall a b. (Integral a, Num b) => a -> b
fromIntegral Position
b forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
h

sortby :: Direction2D -> [(a,Rectangle)] -> [(a,Rectangle)]
sortby :: forall a. Direction2D -> [(a, Rectangle)] -> [(a, Rectangle)]
sortby Direction2D
U = forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\(a
_,Rectangle Position
_ Position
y Dimension
_ Dimension
_) (a
_,Rectangle Position
_ Position
y' Dimension
_ Dimension
_) -> forall a. Ord a => a -> a -> Ordering
compare Position
y' Position
y)
sortby Direction2D
D = forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\(a
_,Rectangle Position
_ Position
y Dimension
_ Dimension
_) (a
_,Rectangle Position
_ Position
y' Dimension
_ Dimension
_) -> forall a. Ord a => a -> a -> Ordering
compare Position
y Position
y')
sortby Direction2D
R = forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\(a
_,Rectangle Position
x Position
_ Dimension
_ Dimension
_) (a
_,Rectangle Position
x' Position
_ Dimension
_ Dimension
_) -> forall a. Ord a => a -> a -> Ordering
compare Position
x Position
x')
sortby Direction2D
L = forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\(a
_,Rectangle Position
x Position
_ Dimension
_ Dimension
_) (a
_,Rectangle Position
x' Position
_ Dimension
_ Dimension
_) -> forall a. Ord a => a -> a -> Ordering
compare Position
x' Position
x)

data Point = P Double Double