{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards #-}
module XMonad.Layout.WindowNavigation (
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
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
instance Message Navigate
data WNConfig =
WNC { WNConfig -> Maybe Double
brightness :: Maybe Double
, 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)
noNavigateBorders :: WNConfig
noNavigateBorders :: WNConfig
noNavigateBorders =
forall a. Default a => a
def {brightness :: Maybe Double
brightness = forall a. a -> Maybe a
Just Double
0}
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
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