{-# 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\/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:
--
-- "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:
--
-- "XMonad.Doc.Extending#Editing_key_bindings".


data MoveWindowToWindow a = MoveWindowToWindow a a deriving ( ReadPrec [MoveWindowToWindow a]
ReadPrec (MoveWindowToWindow a)
Int -> ReadS (MoveWindowToWindow a)
ReadS [MoveWindowToWindow a]
(Int -> ReadS (MoveWindowToWindow a))
-> ReadS [MoveWindowToWindow a]
-> ReadPrec (MoveWindowToWindow a)
-> ReadPrec [MoveWindowToWindow a]
-> Read (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
$creadsPrec :: forall a. Read a => Int -> ReadS (MoveWindowToWindow a)
readsPrec :: Int -> ReadS (MoveWindowToWindow a)
$creadList :: forall a. Read a => ReadS [MoveWindowToWindow a]
readList :: ReadS [MoveWindowToWindow a]
$creadPrec :: forall a. Read a => ReadPrec (MoveWindowToWindow a)
readPrec :: ReadPrec (MoveWindowToWindow a)
$creadListPrec :: forall a. Read a => ReadPrec [MoveWindowToWindow a]
readListPrec :: ReadPrec [MoveWindowToWindow a]
Read, Int -> MoveWindowToWindow a -> ShowS
[MoveWindowToWindow a] -> ShowS
MoveWindowToWindow a -> String
(Int -> MoveWindowToWindow a -> ShowS)
-> (MoveWindowToWindow a -> String)
-> ([MoveWindowToWindow a] -> ShowS)
-> Show (MoveWindowToWindow a)
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
$cshowsPrec :: forall a. Show a => Int -> MoveWindowToWindow a -> ShowS
showsPrec :: Int -> MoveWindowToWindow a -> ShowS
$cshow :: forall a. Show a => MoveWindowToWindow a -> String
show :: MoveWindowToWindow a -> String
$cshowList :: forall a. Show a => [MoveWindowToWindow a] -> ShowS
showList :: [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
(Int -> WNConfig -> ShowS)
-> (WNConfig -> String) -> ([WNConfig] -> ShowS) -> Show WNConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WNConfig -> ShowS
showsPrec :: Int -> WNConfig -> ShowS
$cshow :: WNConfig -> String
show :: WNConfig -> String
$cshowList :: [WNConfig] -> ShowS
showList :: [WNConfig] -> ShowS
Show, ReadPrec [WNConfig]
ReadPrec WNConfig
Int -> ReadS WNConfig
ReadS [WNConfig]
(Int -> ReadS WNConfig)
-> ReadS [WNConfig]
-> ReadPrec WNConfig
-> ReadPrec [WNConfig]
-> Read WNConfig
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS WNConfig
readsPrec :: Int -> ReadS WNConfig
$creadList :: ReadS [WNConfig]
readList :: ReadS [WNConfig]
$creadPrec :: ReadPrec WNConfig
readPrec :: ReadPrec WNConfig
$creadListPrec :: ReadPrec [WNConfig]
readListPrec :: ReadPrec [WNConfig]
Read)

-- | Don't use window borders for navigation.
noNavigateBorders :: WNConfig
noNavigateBorders :: WNConfig
noNavigateBorders =
    WNConfig
forall a. Default a => a
def {brightness :: Maybe Double
brightness = Double -> Maybe Double
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 Maybe Double
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 = WNConfig
forall a. Default a => a
def { brightness :: Maybe Double
brightness = Double -> Maybe Double
forall a. a -> Maybe a
Just (Double -> Maybe Double) -> Double -> Maybe Double
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
0 (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Double
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 (Double -> Maybe Double
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)
Int -> ReadS (WindowNavigation a)
ReadS [WindowNavigation a]
(Int -> ReadS (WindowNavigation a))
-> ReadS [WindowNavigation a]
-> ReadPrec (WindowNavigation a)
-> ReadPrec [WindowNavigation a]
-> Read (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
$creadsPrec :: forall a. Int -> ReadS (WindowNavigation a)
readsPrec :: Int -> ReadS (WindowNavigation a)
$creadList :: forall a. ReadS [WindowNavigation a]
readList :: ReadS [WindowNavigation a]
$creadPrec :: forall a. ReadPrec (WindowNavigation a)
readPrec :: ReadPrec (WindowNavigation a)
$creadListPrec :: forall a. ReadPrec [WindowNavigation a]
readListPrec :: ReadPrec [WindowNavigation a]
Read, Int -> WindowNavigation a -> ShowS
[WindowNavigation a] -> ShowS
WindowNavigation a -> String
(Int -> WindowNavigation a -> ShowS)
-> (WindowNavigation a -> String)
-> ([WindowNavigation a] -> ShowS)
-> Show (WindowNavigation a)
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
$cshowsPrec :: forall a. Int -> WindowNavigation a -> ShowS
showsPrec :: Int -> WindowNavigation a -> ShowS
$cshow :: forall a. WindowNavigation a -> String
show :: WindowNavigation a -> String
$cshowList :: forall a. [WindowNavigation a] -> ShowS
showList :: [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 = WindowNavigation a -> l a -> ModifiedLayout WindowNavigation l a
forall (m :: * -> *) (l :: * -> *) a.
m a -> l a -> ModifiedLayout m l a
ModifiedLayout (WNConfig
-> Invisible Maybe (NavigationState a) -> WindowNavigation a
forall a.
WNConfig
-> Invisible Maybe (NavigationState a) -> WindowNavigation a
WindowNavigation WNConfig
forall a. Default a => a
def (Maybe (NavigationState a) -> Invisible Maybe (NavigationState a)
forall (m :: * -> *) a. m a -> Invisible m a
I Maybe (NavigationState a)
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 = WindowNavigation a -> l a -> ModifiedLayout WindowNavigation l a
forall (m :: * -> *) (l :: * -> *) a.
m a -> l a -> ModifiedLayout m l a
ModifiedLayout (WNConfig
-> Invisible Maybe (NavigationState a) -> WindowNavigation a
forall a.
WNConfig
-> Invisible Maybe (NavigationState a) -> WindowNavigation a
WindowNavigation WNConfig
conf (Maybe (NavigationState a) -> Invisible Maybe (NavigationState a)
forall (m :: * -> *) a. m a -> Invisible m a
I Maybe (NavigationState a)
forall a. Maybe a
Nothing))

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

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

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

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

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

center :: Rectangle -> Point
center :: Rectangle -> Point
center (Rectangle Position
x Position
y Dimension
w Dimension
h) = Double -> Double -> Point
P (Position -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Position
x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Dimension -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
wDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
2)  (Position -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Position
y Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Dimension -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
hDouble -> Double -> Double
forall 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 Direction2D -> Direction2D -> Bool
forall a. Eq a => a -> a -> Bool
== Direction2D
U Bool -> Bool -> Bool
|| Direction2D
d Direction2D -> Direction2D -> Bool
forall a. Eq a => a -> a -> Bool
== Direction2D
D = Double -> Double -> Point
P Double
xx (Position -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Position
y Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Dimension -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
hDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
2)
                                        | Bool
otherwise = Double -> Double -> Point
P (Position -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Position
x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Dimension -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
wDouble -> Double -> Double
forall 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 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Position -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Position
l Bool -> Bool -> Bool
&& Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Position -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Position
l Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Dimension -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
w Bool -> Bool -> Bool
&&
                                     Double
y Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<  Position -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Position
yr Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Dimension -> Double
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 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Position -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Position
l Bool -> Bool -> Bool
&& Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Position -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Position
l Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Dimension -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
w Bool -> Bool -> Bool
&&
                                     Double
y Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>  Position -> Double
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 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Position -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Position
l Bool -> Bool -> Bool
&& Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Position -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Position
l Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Dimension -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
w Bool -> Bool -> Bool
&&
                                     Double
a Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<  Position -> Double
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 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Position -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Position
l Bool -> Bool -> Bool
&& Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Position -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Position
l Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Dimension -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
w Bool -> Bool -> Bool
&&
                                     Double
a Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>  Position -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Position
b Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Dimension -> Double
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 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>  Position -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Position
a Bool -> Bool -> Bool
&& Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Position -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Position
a Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Dimension -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
w Bool -> Bool -> Bool
&&
                                     Double
y Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>  Position -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Position
b Bool -> Bool -> Bool
&& Double
y Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Position -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Position
b Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Dimension -> Double
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 = ((a, Rectangle) -> (a, Rectangle) -> Ordering)
-> [(a, Rectangle)] -> [(a, Rectangle)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\(a
_,Rectangle Position
_ Position
y Dimension
_ Dimension
_) (a
_,Rectangle Position
_ Position
y' Dimension
_ Dimension
_) -> Position -> Position -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Position
y' Position
y)
sortby Direction2D
D = ((a, Rectangle) -> (a, Rectangle) -> Ordering)
-> [(a, Rectangle)] -> [(a, Rectangle)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\(a
_,Rectangle Position
_ Position
y Dimension
_ Dimension
_) (a
_,Rectangle Position
_ Position
y' Dimension
_ Dimension
_) -> Position -> Position -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Position
y Position
y')
sortby Direction2D
R = ((a, Rectangle) -> (a, Rectangle) -> Ordering)
-> [(a, Rectangle)] -> [(a, Rectangle)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\(a
_,Rectangle Position
x Position
_ Dimension
_ Dimension
_) (a
_,Rectangle Position
x' Position
_ Dimension
_ Dimension
_) -> Position -> Position -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Position
x Position
x')
sortby Direction2D
L = ((a, Rectangle) -> (a, Rectangle) -> Ordering)
-> [(a, Rectangle)] -> [(a, Rectangle)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\(a
_,Rectangle Position
x Position
_ Dimension
_ Dimension
_) (a
_,Rectangle Position
x' Position
_ Dimension
_ Dimension
_) -> Position -> Position -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Position
x' Position
x)

data Point = P Double Double