{-# 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)
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 = Just 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 = Just $ max 0 $ min 1 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 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 } <- X XConf
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
                               [Window] -> X [Window]
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return [Window
myc,Window
myc,Window
myc,Window
myc]
               Maybe Double
Nothing -> (String -> X Window) -> [String] -> X [Window]
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 Window
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    = Stack Window -> Window
forall a. Stack a -> a
W.focus Stack Window
s
               r :: Rectangle
r    = case ((Window, Rectangle) -> Bool)
-> [(Window, Rectangle)] -> [(Window, Rectangle)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Window -> Window -> Bool
forall a. Eq a => a -> a -> Bool
==Window
w)(Window -> Bool)
-> ((Window, Rectangle) -> Window) -> (Window, Rectangle) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Window, Rectangle) -> Window
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 = Stack Window -> [Window]
forall a. Stack a -> [a]
W.integrate Stack Window
s
               wrs :: [(Window, Rectangle)]
wrs = ((Window, Rectangle) -> Bool)
-> [(Window, Rectangle)] -> [(Window, Rectangle)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Window -> [Window] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Window]
existing_wins) (Window -> Bool)
-> ((Window, Rectangle) -> Window) -> (Window, Rectangle) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Window, Rectangle) -> Window
forall a b. (a, b) -> a
fst) ([(Window, Rectangle)] -> [(Window, Rectangle)])
-> [(Window, Rectangle)] -> [(Window, Rectangle)]
forall a b. (a -> b) -> a -> b
$ ((Window, Rectangle) -> Bool)
-> [(Window, Rectangle)] -> [(Window, Rectangle)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Rectangle -> Rectangle -> Bool
forall a. Eq a => a -> a -> Bool
/=Rectangle
r) (Rectangle -> Bool)
-> ((Window, Rectangle) -> Rectangle)
-> (Window, Rectangle)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Window, Rectangle) -> Rectangle
forall a b. (a, b) -> b
snd) ([(Window, Rectangle)] -> [(Window, Rectangle)])
-> [(Window, Rectangle)] -> [(Window, Rectangle)]
forall a b. (a -> b) -> a -> b
$
                     ((Window, Rectangle) -> Bool)
-> [(Window, Rectangle)] -> [(Window, Rectangle)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Window -> Window -> Bool
forall a. Eq a => a -> a -> Bool
/=Window
w) (Window -> Bool)
-> ((Window, Rectangle) -> Window) -> (Window, Rectangle) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Window, Rectangle) -> Window
forall a b. (a, b) -> a
fst) [(Window, Rectangle)]
origwrs
               wnavigable :: [(Window, Rectangle)]
wnavigable = [(Window, Rectangle)] -> [(Window, Rectangle)]
forall a. Eq a => [a] -> [a]
nub ([(Window, Rectangle)] -> [(Window, Rectangle)])
-> [(Window, Rectangle)] -> [(Window, Rectangle)]
forall a b. (a -> b) -> a -> b
$ (Direction2D -> [(Window, Rectangle)])
-> [Direction2D] -> [(Window, Rectangle)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
                            (\Direction2D
d -> Int -> [(Window, Rectangle)] -> [(Window, Rectangle)]
forall a. Int -> [a] -> [a]
take Int
1 ([(Window, Rectangle)] -> [(Window, Rectangle)])
-> [(Window, Rectangle)] -> [(Window, Rectangle)]
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 = [(Window, Window)] -> [(Window, Window)]
forall a. Eq a => [a] -> [a]
nub ([(Window, Window)] -> [(Window, Window)])
-> [(Window, Window)] -> [(Window, Window)]
forall a b. (a -> b) -> a -> b
$ (Direction2D -> [(Window, Window)])
-> [Direction2D] -> [(Window, Window)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
                            (\Direction2D
d -> ((Window, Rectangle) -> (Window, Window))
-> [(Window, Rectangle)] -> [(Window, Window)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Window
win,Rectangle
_) -> (Window
win,Direction2D -> Window
dirc Direction2D
d)) ([(Window, Rectangle)] -> [(Window, Window)])
-> [(Window, Rectangle)] -> [(Window, Window)]
forall a b. (a -> b) -> a -> b
$
                                   Int -> [(Window, Rectangle)] -> [(Window, Rectangle)]
forall a. Int -> [a] -> [a]
take Int
1 ([(Window, Rectangle)] -> [(Window, Rectangle)])
-> [(Window, Rectangle)] -> [(Window, Rectangle)]
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) -> ((Window, Rectangle) -> Window)
-> [(Window, Rectangle)] -> [Window]
forall a b. (a -> b) -> [a] -> [b]
map (Window, Rectangle) -> Window
forall a b. (a, b) -> a
fst [(Window, Rectangle)]
wo
                                    Maybe (NavigationState Window)
_              -> []
           (Window -> X ()) -> [Window] -> X ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Window -> Window -> X ()
sc Window
nbc) ([Window]
wothers [Window] -> [Window] -> [Window]
forall a. Eq a => [a] -> [a] -> [a]
\\ ((Window, Rectangle) -> Window)
-> [(Window, Rectangle)] -> [Window]
forall a b. (a -> b) -> [a] -> [b]
map (Window, Rectangle) -> Window
forall a b. (a, b) -> a
fst [(Window, Rectangle)]
wnavigable)
           ((Window, Window) -> X ()) -> [(Window, Window)] -> X ()
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
           ([(Window, Rectangle)], Maybe (WindowNavigation Window))
-> X ([(Window, Rectangle)], Maybe (WindowNavigation Window))
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Window, Rectangle)]
origwrs, WindowNavigation Window -> Maybe (WindowNavigation Window)
forall a. a -> Maybe a
Just (WindowNavigation Window -> Maybe (WindowNavigation Window))
-> WindowNavigation Window -> Maybe (WindowNavigation Window)
forall a b. (a -> b) -> a -> b
$ WNConfig
-> Invisible Maybe (NavigationState Window)
-> WindowNavigation Window
forall a.
WNConfig
-> Invisible Maybe (NavigationState a) -> WindowNavigation a
WindowNavigation WNConfig
conf (Invisible Maybe (NavigationState Window)
 -> WindowNavigation Window)
-> Invisible Maybe (NavigationState Window)
-> WindowNavigation Window
forall a b. (a -> b) -> a -> b
$ Maybe (NavigationState Window)
-> Invisible Maybe (NavigationState Window)
forall (m :: * -> *) a. m a -> Invisible m a
I (Maybe (NavigationState Window)
 -> Invisible Maybe (NavigationState Window))
-> Maybe (NavigationState Window)
-> Invisible Maybe (NavigationState Window)
forall a b. (a -> b) -> a -> b
$ NavigationState Window -> Maybe (NavigationState Window)
forall a. a -> Maybe a
Just (NavigationState Window -> Maybe (NavigationState Window))
-> NavigationState Window -> Maybe (NavigationState Window)
forall a b. (a -> b) -> a -> b
$ Point -> [(Window, Rectangle)] -> NavigationState Window
forall a. Point -> [(a, Rectangle)] -> NavigationState a
NS Point
pt [(Window, Rectangle)]
wnavigable)
    redoLayout WindowNavigation Window
_ Rectangle
_ Maybe (Stack Window)
_ [(Window, Rectangle)]
origwrs = ([(Window, Rectangle)], Maybe (WindowNavigation Window))
-> X ([(Window, Rectangle)], Maybe (WindowNavigation Window))
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Window, Rectangle)]
origwrs, Maybe (WindowNavigation Window)
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) <- SomeMessage -> Maybe Navigate
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
                         []        -> Maybe (Either (WindowNavigation Window) SomeMessage)
-> X (Maybe (Either (WindowNavigation Window) SomeMessage))
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Either (WindowNavigation Window) SomeMessage)
forall a. Maybe a
Nothing
                         ((Window
w,Rectangle
r):[(Window, Rectangle)]
_) -> do (XState -> XState) -> X ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify XState -> XState
focusWindowHere
                                         Maybe (Either (WindowNavigation Window) SomeMessage)
-> X (Maybe (Either (WindowNavigation Window) SomeMessage))
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Either (WindowNavigation Window) SomeMessage)
 -> X (Maybe (Either (WindowNavigation Window) SomeMessage)))
-> Maybe (Either (WindowNavigation Window) SomeMessage)
-> X (Maybe (Either (WindowNavigation Window) SomeMessage))
forall a b. (a -> b) -> a -> b
$ Either (WindowNavigation Window) SomeMessage
-> Maybe (Either (WindowNavigation Window) SomeMessage)
forall a. a -> Maybe a
Just (Either (WindowNavigation Window) SomeMessage
 -> Maybe (Either (WindowNavigation Window) SomeMessage))
-> Either (WindowNavigation Window) SomeMessage
-> Maybe (Either (WindowNavigation Window) SomeMessage)
forall a b. (a -> b) -> a -> b
$ WindowNavigation Window
-> Either (WindowNavigation Window) SomeMessage
forall a b. a -> Either a b
Left (WindowNavigation Window
 -> Either (WindowNavigation Window) SomeMessage)
-> WindowNavigation Window
-> Either (WindowNavigation Window) SomeMessage
forall a b. (a -> b) -> a -> b
$ WNConfig
-> Invisible Maybe (NavigationState Window)
-> WindowNavigation Window
forall a.
WNConfig
-> Invisible Maybe (NavigationState a) -> WindowNavigation a
WindowNavigation WNConfig
conf (Invisible Maybe (NavigationState Window)
 -> WindowNavigation Window)
-> Invisible Maybe (NavigationState Window)
-> WindowNavigation Window
forall a b. (a -> b) -> a -> b
$ Maybe (NavigationState Window)
-> Invisible Maybe (NavigationState Window)
forall (m :: * -> *) a. m a -> Invisible m a
I (Maybe (NavigationState Window)
 -> Invisible Maybe (NavigationState Window))
-> Maybe (NavigationState Window)
-> Invisible Maybe (NavigationState Window)
forall a b. (a -> b) -> a -> b
$ NavigationState Window -> Maybe (NavigationState Window)
forall a. a -> Maybe a
Just (NavigationState Window -> Maybe (NavigationState Window))
-> NavigationState Window -> Maybe (NavigationState Window)
forall a b. (a -> b) -> a -> b
$
                                                Point -> [(Window, Rectangle)] -> NavigationState Window
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
                                       | Window -> Maybe Window
forall a. a -> Maybe a
Just Window
w Maybe Window -> Maybe Window -> Bool
forall a. Eq a => a -> a -> Bool
== StackSet String (Layout Window) Window ScreenId ScreenDetail
-> Maybe Window
forall i l a s sd. StackSet i l a s sd -> Maybe a
W.peek (XState
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
windowset XState
s) = XState
s
                                       | Window -> Maybe (Stack Window) -> Bool
forall {a}. Eq a => a -> Maybe (Stack a) -> Bool
has Window
w (Maybe (Stack Window) -> Bool) -> Maybe (Stack Window) -> Bool
forall a b. (a -> b) -> a -> b
$ Workspace String (Layout Window) Window -> Maybe (Stack Window)
forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack (Workspace String (Layout Window) Window -> Maybe (Stack Window))
-> Workspace String (Layout Window) Window -> Maybe (Stack Window)
forall a b. (a -> b) -> a -> b
$ Screen String (Layout Window) Window ScreenId ScreenDetail
-> Workspace String (Layout Window) Window
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace (Screen String (Layout Window) Window ScreenId ScreenDetail
 -> Workspace String (Layout Window) Window)
-> Screen String (Layout Window) Window ScreenId ScreenDetail
-> Workspace String (Layout Window) Window
forall a b. (a -> b) -> a -> b
$ StackSet String (Layout Window) Window ScreenId ScreenDetail
-> Screen String (Layout Window) Window ScreenId ScreenDetail
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current (StackSet String (Layout Window) Window ScreenId ScreenDetail
 -> Screen String (Layout Window) Window ScreenId ScreenDetail)
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
-> Screen String (Layout Window) Window ScreenId ScreenDetail
forall a b. (a -> b) -> a -> b
$ XState
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
windowset XState
s =
                                           XState
s { windowset = until ((Just w ==) . W.peek)
                                                           W.focusUp $ windowset 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 -> [(Window, Rectangle)] -> [(Window, Rectangle)]
navigable Direction2D
d Point
pt [(Window, Rectangle)]
wrs of
             []        -> Maybe (Either (WindowNavigation Window) SomeMessage)
-> X (Maybe (Either (WindowNavigation Window) SomeMessage))
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Either (WindowNavigation Window) SomeMessage)
forall a. Maybe a
Nothing
             ((Window
w,Rectangle
_):[(Window, Rectangle)]
_) -> do let swap :: Stack Window -> Stack Window
swap Stack Window
st = Window -> [Window] -> Stack Window
forall {a}. Eq a => a -> [a] -> Stack a
unint (Stack Window -> Window
forall a. Stack a -> a
W.focus Stack Window
st) ([Window] -> Stack Window) -> [Window] -> Stack Window
forall a b. (a -> b) -> a -> b
$ (Window -> Window) -> [Window] -> [Window]
forall a b. (a -> b) -> [a] -> [b]
map (Window -> Window -> Window
swapw (Stack Window -> Window
forall a. Stack a -> a
W.focus Stack Window
st)) ([Window] -> [Window]) -> [Window] -> [Window]
forall a b. (a -> b) -> a -> b
$ Stack Window -> [Window]
forall a. Stack a -> [a]
W.integrate Stack Window
st
                                 swapw :: Window -> Window -> Window
swapw Window
y Window
x | Window
x Window -> Window -> Bool
forall a. Eq a => a -> a -> Bool
== Window
w = Window
y
                                           | Window
x Window -> Window -> Bool
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 (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 Window) Window ScreenId ScreenDetail
 -> StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> X ()
windows ((StackSet String (Layout Window) Window ScreenId ScreenDetail
  -> StackSet String (Layout Window) Window ScreenId ScreenDetail)
 -> X ())
-> (StackSet String (Layout Window) Window ScreenId ScreenDetail
    -> StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> X ()
forall a b. (a -> b) -> a -> b
$ (Stack Window -> Stack Window)
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
-> StackSet String (Layout Window) Window 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 Window -> Stack Window
swap
                             Maybe (Either (WindowNavigation Window) SomeMessage)
-> X (Maybe (Either (WindowNavigation Window) SomeMessage))
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Either (WindowNavigation Window) 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 -> [(Window, Rectangle)] -> [(Window, Rectangle)]
navigable Direction2D
d Point
pt [(Window, Rectangle)]
wrs of
             []        -> Maybe (Either (WindowNavigation Window) SomeMessage)
-> X (Maybe (Either (WindowNavigation Window) SomeMessage))
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Either (WindowNavigation Window) SomeMessage)
forall a. Maybe a
Nothing
             ((Window
w,Rectangle
_):[(Window, Rectangle)]
_) -> do Maybe (Stack Window)
mst <- (XState -> Maybe (Stack Window)) -> X (Maybe (Stack Window))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Workspace String (Layout Window) Window -> Maybe (Stack Window)
forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack (Workspace String (Layout Window) Window -> Maybe (Stack Window))
-> (XState -> Workspace String (Layout Window) Window)
-> XState
-> Maybe (Stack Window)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Screen String (Layout Window) Window ScreenId ScreenDetail
-> Workspace String (Layout Window) Window
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace (Screen String (Layout Window) Window ScreenId ScreenDetail
 -> Workspace String (Layout Window) Window)
-> (XState
    -> Screen String (Layout Window) Window ScreenId ScreenDetail)
-> XState
-> Workspace String (Layout Window) Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackSet String (Layout Window) Window ScreenId ScreenDetail
-> Screen String (Layout Window) Window ScreenId ScreenDetail
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current (StackSet String (Layout Window) Window ScreenId ScreenDetail
 -> Screen String (Layout Window) Window ScreenId ScreenDetail)
-> (XState
    -> StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> XState
-> Screen String (Layout Window) Window ScreenId ScreenDetail
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
windowset)
                             Maybe (Either (WindowNavigation Window) SomeMessage)
-> X (Maybe (Either (WindowNavigation Window) SomeMessage))
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Either (WindowNavigation Window) SomeMessage)
 -> X (Maybe (Either (WindowNavigation Window) SomeMessage)))
-> Maybe (Either (WindowNavigation Window) SomeMessage)
-> X (Maybe (Either (WindowNavigation Window) SomeMessage))
forall a b. (a -> b) -> a -> b
$ do Stack Window
st <- Maybe (Stack Window)
mst
                                         Either (WindowNavigation Window) SomeMessage
-> Maybe (Either (WindowNavigation Window) SomeMessage)
forall a. a -> Maybe a
Just (Either (WindowNavigation Window) SomeMessage
 -> Maybe (Either (WindowNavigation Window) SomeMessage))
-> Either (WindowNavigation Window) SomeMessage
-> Maybe (Either (WindowNavigation Window) SomeMessage)
forall a b. (a -> b) -> a -> b
$ SomeMessage -> Either (WindowNavigation Window) SomeMessage
forall a b. b -> Either a b
Right (SomeMessage -> Either (WindowNavigation Window) SomeMessage)
-> SomeMessage -> Either (WindowNavigation Window) SomeMessage
forall a b. (a -> b) -> a -> b
$ MoveWindowToWindow Window -> SomeMessage
forall a. Message a => a -> SomeMessage
SomeMessage (MoveWindowToWindow Window -> SomeMessage)
-> MoveWindowToWindow Window -> SomeMessage
forall a b. (a -> b) -> a -> b
$ Window -> Window -> MoveWindowToWindow Window
forall a. a -> a -> MoveWindowToWindow a
MoveWindowToWindow (Stack Window -> Window
forall a. Stack a -> a
W.focus Stack Window
st) Window
w
        | Just (Apply Window -> X ()
f Direction2D
d) <- SomeMessage -> Maybe Navigate
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
             []         -> Maybe (Either (WindowNavigation Window) SomeMessage)
-> X (Maybe (Either (WindowNavigation Window) SomeMessage))
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Either (WindowNavigation Window) SomeMessage)
forall a. Maybe a
Nothing
             ((Window
w,Rectangle
_):[(Window, Rectangle)]
_)  -> Window -> X ()
f Window
w X ()
-> X (Maybe (Either (WindowNavigation Window) SomeMessage))
-> X (Maybe (Either (WindowNavigation Window) 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 Window) SomeMessage)
-> X (Maybe (Either (WindowNavigation Window) SomeMessage))
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Either (WindowNavigation Window) 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 -> Window
normalBorder = Window
nbc } <- X XConf
forall r (m :: * -> *). MonadReader r m => m r
ask
                          ((Window, Rectangle) -> X ()) -> [(Window, Rectangle)] -> X ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Window -> Window -> X ()
sc Window
nbc (Window -> X ())
-> ((Window, Rectangle) -> Window) -> (Window, Rectangle) -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Window, Rectangle) -> Window
forall a b. (a, b) -> a
fst) [(Window, Rectangle)]
wrs
                          Maybe (Either (WindowNavigation Window) SomeMessage)
-> X (Maybe (Either (WindowNavigation Window) SomeMessage))
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Either (WindowNavigation Window) SomeMessage)
 -> X (Maybe (Either (WindowNavigation Window) SomeMessage)))
-> Maybe (Either (WindowNavigation Window) SomeMessage)
-> X (Maybe (Either (WindowNavigation Window) SomeMessage))
forall a b. (a -> b) -> a -> b
$ Either (WindowNavigation Window) SomeMessage
-> Maybe (Either (WindowNavigation Window) SomeMessage)
forall a. a -> Maybe a
Just (Either (WindowNavigation Window) SomeMessage
 -> Maybe (Either (WindowNavigation Window) SomeMessage))
-> Either (WindowNavigation Window) SomeMessage
-> Maybe (Either (WindowNavigation Window) SomeMessage)
forall a b. (a -> b) -> a -> b
$ WindowNavigation Window
-> Either (WindowNavigation Window) SomeMessage
forall a b. a -> Either a b
Left (WindowNavigation Window
 -> Either (WindowNavigation Window) SomeMessage)
-> WindowNavigation Window
-> Either (WindowNavigation Window) SomeMessage
forall a b. (a -> b) -> a -> b
$ WNConfig
-> Invisible Maybe (NavigationState Window)
-> WindowNavigation Window
forall a.
WNConfig
-> Invisible Maybe (NavigationState a) -> WindowNavigation a
WindowNavigation WNConfig
conf (Invisible Maybe (NavigationState Window)
 -> WindowNavigation Window)
-> Invisible Maybe (NavigationState Window)
-> WindowNavigation Window
forall a b. (a -> b) -> a -> b
$ Maybe (NavigationState Window)
-> Invisible Maybe (NavigationState Window)
forall (m :: * -> *) a. m a -> Invisible m a
I (Maybe (NavigationState Window)
 -> Invisible Maybe (NavigationState Window))
-> Maybe (NavigationState Window)
-> Invisible Maybe (NavigationState Window)
forall a b. (a -> b) -> a -> b
$ NavigationState Window -> Maybe (NavigationState Window)
forall a. a -> Maybe a
Just (NavigationState Window -> Maybe (NavigationState Window))
-> NavigationState Window -> Maybe (NavigationState Window)
forall a b. (a -> b) -> a -> b
$ Point -> [(Window, Rectangle)] -> NavigationState Window
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 Window
-> SomeMessage
-> X (Maybe (Either (WindowNavigation Window) SomeMessage))
forall (m :: * -> *) a.
LayoutModifier m a =>
m a -> SomeMessage -> X (Maybe (Either (m a) SomeMessage))
handleMessOrMaybeModifyIt (WNConfig
-> Invisible Maybe (NavigationState Window)
-> WindowNavigation Window
forall a.
WNConfig
-> Invisible Maybe (NavigationState a) -> WindowNavigation a
WindowNavigation WNConfig
conf (Maybe (NavigationState Window)
-> Invisible Maybe (NavigationState Window)
forall (m :: * -> *) a. m a -> Invisible m a
I (Maybe (NavigationState Window)
 -> Invisible Maybe (NavigationState Window))
-> Maybe (NavigationState Window)
-> Invisible Maybe (NavigationState Window)
forall a b. (a -> b) -> a -> b
$ NavigationState Window -> Maybe (NavigationState Window)
forall a. a -> Maybe a
Just (Point -> [(Window, Rectangle)] -> NavigationState Window
forall a. Point -> [(a, Rectangle)] -> NavigationState a
NS Point
pt [(Window, Rectangle)]
wrs))) (LayoutMessages -> SomeMessage
forall a. Message a => a -> SomeMessage
SomeMessage LayoutMessages
Hide)
    handleMessOrMaybeModifyIt WindowNavigation Window
_ SomeMessage
_ = Maybe (Either (WindowNavigation Window) SomeMessage)
-> X (Maybe (Either (WindowNavigation Window) SomeMessage))
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Either (WindowNavigation Window) SomeMessage)
forall a. Maybe a
Nothing

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

sc :: Pixel -> Window -> X ()
sc :: Window -> Window -> X ()
sc Window
c Window
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 -> Window -> IO String
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 (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