{-# 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)
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
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
(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)
noNavigateBorders :: WNConfig
noNavigateBorders :: WNConfig
noNavigateBorders =
WNConfig
forall a. Default a => a
def {brightness = Just 0}
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
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 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 = 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 -> [(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