aboutsummaryrefslogblamecommitdiffstats
path: root/XMonad/Actions/Navigation2D.hs
blob: 27d772b037f6d54fbe57d825b43ab65f5cf86199 (plain) (tree)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757

















                                                                                                           
 

                                                      
 

                                                                                    
 

                                                           
 




                                                                       
 

































































































































































































                                                                                                         
 























                                                                                                    
                             

















































                                                                                                                  
 



































































































































































































































































































































































































































































                                                                                                                    
 



















                                                                   
{-# LANGUAGE DeriveDataTypeable, MultiParamTypeClasses, PatternGuards, RankNTypes, TypeSynonymInstances #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Layout.Navigation2D
-- Copyright   :  (c) 2011  Norbert Zeh <nzeh@cs.dal.ca>
-- License     :  BSD3-style (see LICENSE)
--
-- Maintainer  :  Norbert Zeh <nzeh@cs.dal.ca>
-- Stability   :  unstable
-- Portability :  unportable
--
-- Navigation2D is an xmonad extension that allows easy directional
-- navigation of windows and screens (in a multi-monitor setup).
-----------------------------------------------------------------------------

module XMonad.Actions.Navigation2D ( -- * Usage
                                     -- $usage

                                     -- * Finer points
                                     -- $finer_points

                                     -- * Alternative directional navigation modules
                                     -- $alternatives

                                     -- * Incompatibilities
                                     -- $incompatibilities

                                     -- * Detailed technical discussion
                                     -- $technical

                                     -- * Exported functions and types
                                     -- #Exports#

                                     withNavigation2DConfig
                                   , Navigation2DConfig(..)
                                   , defaultNavigation2DConfig
                                   , Navigation2D
                                   , lineNavigation
                                   , centerNavigation
                                   , fullScreenRect
                                   , singleWindowRect
                                   , switchLayer
                                   , windowGo
                                   , windowSwap
                                   , windowToScreen
                                   , screenGo
                                   , screenSwap
                                   , Direction2D(..)
                                   ) where

import Control.Applicative
import qualified Data.List as L
import qualified Data.Map as M
import Data.Maybe
import XMonad hiding (Screen)
import qualified XMonad.StackSet as W
import qualified XMonad.Util.ExtensibleState as XS
import XMonad.Util.Types

-- $usage
-- #Usage#
-- Navigation2D provides directional navigation (go left, right, up, down) for
-- windows and screens.  It treats floating and tiled windows as two separate
-- layers and provides mechanisms to navigate within each layer and to switch
-- between layers.  Navigation2D provides two different navigation strategies
-- (see <#Technical_Discussion> for details): /Line navigation/ feels rather
-- natural but may make it impossible to navigate to a given window from the
-- current window, particularly in the floating layer.  /Center navigation/
-- feels less natural in certain situations but ensures that all windows can be
-- reached without the need to involve the mouse.  Navigation2D allows different
-- navigation strategies to be used in the two layers and allows customization
-- of the navigation strategy for the tiled layer based on the layout currently
-- in effect.
--
-- You can use this module with (a subset of) the following in your @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Actions.Navigation2D
--
-- Then edit your keybindings:
--
-- >    -- Switch between layers
-- >    , ((modm,                 xK_space), switchLayers)
-- >
-- >    -- Directional navigation of windows
-- >    , ((modm,                 xK_Right), windowGo R False)
-- >    , ((modm,                 xK_Left ), windowGo L False)
-- >    , ((modm,                 xK_Up   ), windowGo U False)
-- >    , ((modm,                 xK_Down ), windowGo D False)
-- >
-- >    -- Swap adjacent windows
-- >    , ((modm .|. controlMask, xK_Right), windowSwap R False)
-- >    , ((modm .|. controlMask, xK_Left ), windowSwap L False)
-- >    , ((modm .|. controlMask, xK_Up   ), windowSwap U False)
-- >    , ((modm .|. controlMask, xK_Down ), windowSwap D False)
-- >
-- >    -- Directional navigation of screens
-- >    , ((modm,                 xK_r    ), screenGo R False)
-- >    , ((modm,                 xK_l    ), screenGo L False)
-- >    , ((modm,                 xK_u    ), screenGo U False)
-- >    , ((modm,                 xK_d    ), screenGo D False)
-- >
-- >    -- Swap workspaces on adjacent screens
-- >    , ((modm .|. controlMask, xK_r    ), screenSwap R False)
-- >    , ((modm .|. controlMask, xK_l    ), screenSwap L False)
-- >    , ((modm .|. controlMask, xK_u    ), screenSwap U False)
-- >    , ((modm .|. controlMask, xK_d    ), screenSwap D False)
-- >
-- >    -- Send window to adjacent screen
-- >    , ((modm .|. mod1Mask,    xK_r    ), windowToScreen R False)
-- >    , ((modm .|. mod1Mask,    xK_l    ), windowToScreen L False)
-- >    , ((modm .|. mod1Mask,    xK_u    ), windowToScreen U False)
-- >    , ((modm .|. mod1Mask,    xK_d    ), windowToScreen D False)
--
-- and add the configuration of the module to your main function:
--
-- > main = xmonad $ withNavigation2DConfig defaultNavigation2DConfig
-- >               $ defaultConfig
--
-- For detailed instruction on editing the key binding see:
--
-- "XMonad.Doc.Extending#Editing_key_bindings".

-- $finer_points
-- #Finer_Points#
-- The above should get you started.  Here are some finer points:
--
-- Navigation2D has the ability to wrap around at screen edges.  For example, if
-- you navigated to the rightmost window on the rightmost screen and you
-- continued to go right, this would get you to the leftmost window on the
-- leftmost screen.  This feature may be useful for switching between screens
-- that are far apart but may be confusing at least to novice users.  Therefore,
-- it is disabled in the above example (e.g., navigation beyond the rightmost
-- window on the rightmost screen is not possible and trying to do so will
-- simply not do anything.)  If you want this feature, change all the 'False'
-- values in the above example to 'True'.  You could also decide you want
-- wrapping only for a subset of the operations and no wrapping for others.
--
-- By default, all layouts use the 'defaultTiledNavigation' strategy specified
-- in the 'Navigation2DConfig' (by default, line navigation is used).  To
-- override this behaviour for some layouts, add a pair (\"layout name\",
-- navigation strategy) to the 'layoutNavigation' list in the
-- 'Navigation2DConfig', where \"layout name\" is the string reported by the
-- layout's description method (normally what is shown as the layout name in
-- your status bar).  For example, all navigation strategies normally allow only
-- navigation between mapped windows.  The first step to overcome this, for
-- example, for the Full layout, is to switch to center navigation for the Full
-- layout:
--
-- > myNavigation2DConfig = defaultNavigation2DConfig { layoutNavigation = [("Full", centerNavigation)] }
-- >
-- > main = xmonad $ withNavigation2DConfig myNavigation2DConfig
-- >               $ defaultConfig
--
-- The navigation between windows is based on their screen rectangles, which are
-- available /and meaningful/ only for mapped windows.  Thus, as already said,
-- the default is to allow navigation only between mapped windows.  However,
-- there are layouts that do not keep all windows mapped.  One example is the
-- Full layout, which unmaps all windows except the one that has the focus,
-- thereby preventing navigation to any other window in the layout.  To make
-- navigation to unmapped windows possible, unmapped windows need to be assigned
-- rectangles to pretend they are mapped, and a natural way to do this for the
-- Full layout is to pretend all windows occupy the full screen and are stacked
-- on top of each other so that only the frontmost one is visible.  This can be
-- done as follows:
--
-- > myNavigation2DConfig = defaultNavigation2DConfig { layoutNavigation   = [("Full", centerNavigation)]
-- >                                                  , unmappedWindowRect = [("Full", singleWindowRect)]
-- >                                                  }
-- >
-- > main = xmonad $ withNavigation2DConfig myNavigation2DConfig
-- >               $ defaultConfig
--
-- With this setup, Left/Up navigation behaves like standard
-- 'XMonad.StackSet.focusUp' and Right/Down navigation behaves like
-- 'XMonad.StackSet.focusDown', thus allowing navigation between windows in the
-- layout.
--
-- In general, each entry in the 'unmappedWindowRect' association list is a pair
-- (\"layout description\", function), where the function computes a rectangle
-- for each unmapped window from the screen it is on and the window ID.
-- Currently, Navigation2D provides only two functions of this type:
-- 'singleWindowRect' and 'fullScreenRect'.
--
-- With per-layout navigation strategies, if different layouts are in effect on
-- different screens in a multi-monitor setup, and different navigation
-- strategies are defined for these active layouts, the most general of these
-- navigation strategies is used across all screens (because Navigation2D does
-- not distinguish between windows on different workspaces), where center
-- navigation is more general than line navigation, as discussed formally under
-- <#Technical_Discussion>.

-- $alternatives
-- #Alternatives#
--
-- There exist two alternatives to Navigation2D:
-- "XMonad.Actions.WindowNavigation" and "XMonad.Layout.WindowNavigation".
-- X.L.WindowNavigation has the advantage of colouring windows to indicate the
-- window that would receive the focus in each navigation direction, but it does
-- not support navigation across multiple monitors, does not support directional
-- navigation of floating windows, and has a very unintuitive definition of
-- which window receives the focus next in each direction.  X.A.WindowNavigation
-- does support navigation across multiple monitors but does not provide window
-- colouring while retaining the unintuitive navigational semantics of
-- X.L.WindowNavigation.  This makes it very difficult to predict which window
-- receives the focus next.  Neither X.A.WindowNavigation nor
-- X.L.WindowNavigation supports directional navigation of screens.

-- $technical
-- #Technical_Discussion#
-- An in-depth discussion of the navigational strategies implemented in
-- Navigation2D, including formal proofs of their properties, can be found
-- at <http://www.cs.dal.ca/~nzeh/xmonad/Navigation2D.pdf>.

-- $incompatibilities
-- #Incompatibilities#
-- Currently Navigation2D is known not to play nicely with tabbed layouts, but
-- it should work well with any other tiled layout.  My hope is to address the
-- incompatibility with tabbed layouts in a future version.  The navigation to
-- unmapped windows, for example in a Full layout, by assigning rectangles to
-- unmapped windows is more a workaround than a clean solution.  Figuring out
-- how to deal with tabbed layouts may also lead to a more general and cleaner
-- solution to query the layout for a window's rectangle that may make this
-- workaround unnecessary.  At that point, the 'unmappedWindowRect' field of the
-- 'Navigation2DConfig' will disappear.

-- | A rectangle paired with an object
type Rect a = (a, Rectangle)

-- | A shorthand for window-rectangle pairs.  Reduces typing.
type WinRect = Rect Window

-- | A shorthand for workspace-rectangle pairs.  Reduces typing.
type WSRect = Rect WorkspaceId

----------------------------------------------------------------------------------------------------
----------------------------------------------------------------------------------------------------
--                                                                                                --
--                                        PUBLIC INTERFACE                                        --
--                                                                                                --
----------------------------------------------------------------------------------------------------
----------------------------------------------------------------------------------------------------

-- | Encapsulates the navigation strategy
data Navigation2D = N Generality (forall a . Eq a => Direction2D -> Rect a -> [Rect a] -> Maybe a)

runNav :: forall a . Eq a => Navigation2D -> (Direction2D -> Rect a -> [Rect a] -> Maybe a)
runNav (N _ nav) = nav

-- | Score that indicates how general a navigation strategy is
type Generality = Int

instance Eq Navigation2D where
  (N x _) == (N y _) = x == y

instance Ord Navigation2D where
  (N x _) <= (N y _) = x <= y

-- | Line navigation.  To illustrate this navigation strategy, consider
-- navigating to the left from the current window.  In this case, we draw a
-- horizontal line through the center of the current window and consider all
-- windows that intersect this horizontal line and whose right boundaries are to
-- the left of the left boundary of the current window.  From among these
-- windows, we choose the one with the rightmost right boundary.
lineNavigation :: Navigation2D
lineNavigation = N 1 doLineNavigation

-- | Center navigation.  Again, consider navigating to the left.  Then we
-- consider the cone bounded by the two rays shot at 45-degree angles in
-- north-west and south-west direction from the center of the current window.  A
-- window is a candidate to receive the focus if its center lies in this cone.
-- We choose the window whose center has minimum L1-distance from the current
-- window center.  The tie breaking strategy for windows with the same distance
-- is a bit complicated (see <#Technical_Discussion>) but ensures that all
-- windows can be reached and that windows with the same center are traversed in
-- their order in the window stack, that is, in the order
-- 'XMonad.StackSet.focusUp' and 'XMonad.StackSet.focusDown' would traverse
-- them.
centerNavigation :: Navigation2D
centerNavigation = N 2 doCenterNavigation

-- | Stores the configuration of directional navigation
data Navigation2DConfig = Navigation2DConfig
  { defaultTiledNavigation :: Navigation2D             -- ^ default navigation strategy for the tiled layer
  , floatNavigation        :: Navigation2D             -- ^ navigation strategy for the float layer
  , screenNavigation       :: Navigation2D             -- ^ strategy for navigation between screens
  , layoutNavigation       :: [(String, Navigation2D)] -- ^ association list of customized navigation strategies
                                                       -- for different layouts in the tiled layer.  Each pair
                                                       -- is of the form (\"layout description\", navigation
                                                       -- strategy).  If there is no pair in this list whose first
                                                       -- component is the name of the current layout, the
                                                       -- 'defaultTiledNavigation' strategy is used.
  , unmappedWindowRect     :: [(String, Screen -> Window -> X (Maybe Rectangle))]
                                                       -- ^ list associating functions to calculate rectangles
                                                       -- for unmapped windows with layouts to which they are
                                                       -- to be applied.  Each pair in this list is of
                                                       -- the form (\"layout description\", function), where the
                                                       -- function calculates a rectangle for a given unmapped
                                                       -- window from the screen it is on and its window ID.
                                                       -- See <#Finer_Points> for how to use this.
  } deriving Typeable

-- | Shorthand for the tedious screen type
type Screen = W.Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail

-- So we can store the configuration in extensible state
instance ExtensionClass Navigation2DConfig where
  initialValue = defaultNavigation2DConfig

-- | Modifies the xmonad configuration to store the Navigation2D configuration
withNavigation2DConfig :: Navigation2DConfig -> XConfig a -> XConfig a
withNavigation2DConfig conf2d xconf = xconf { startupHook  = startupHook xconf
                                                          >> XS.put conf2d
                                            }

-- | Default navigation configuration.  It uses line navigation for the tiled
-- layer and for navigation between screens, and center navigation for the float
-- layer.  No custom navigation strategies or rectangles for unmapped windows are
-- defined for individual layouts.
defaultNavigation2DConfig :: Navigation2DConfig
defaultNavigation2DConfig = Navigation2DConfig { defaultTiledNavigation = lineNavigation
                                               , floatNavigation        = centerNavigation
                                               , screenNavigation       = lineNavigation
                                               , layoutNavigation       = []
                                               , unmappedWindowRect     = []
                                               }

-- | Switches focus to the closest window in the other layer (floating if the
-- current window is tiled, tiled if the current window is floating).  Closest
-- means that the L1-distance between the centers of the windows is minimized.
switchLayer :: X ()
switchLayer = actOnLayer otherLayer
                         ( \ _ cur wins -> windows
                           $ doFocusClosestWindow cur wins
                         )
                         ( \ _ cur wins -> windows
                           $ doFocusClosestWindow cur wins
                         )
                         ( \ _ _ _ -> return () )
                         False

-- | Moves the focus to the next window in the given direction and in the same
-- layer as the current window.  The second argument indicates whether
-- navigation should wrap around (e.g., from the left edge of the leftmost
-- screen to the right edge of the rightmost screen).
windowGo :: Direction2D -> Bool -> X ()
windowGo dir wrap = actOnLayer thisLayer
                               ( \ conf cur wins -> windows
                                 $ doTiledNavigation conf dir W.focusWindow cur wins
                               )
                               ( \ conf cur wins -> windows
                                 $ doFloatNavigation conf dir W.focusWindow cur wins
                               )
                               ( \ conf cur wspcs -> windows
                                 $ doScreenNavigation conf dir W.view cur wspcs
                               )
                               wrap

-- | Swaps the current window with the next window in the given direction and in
-- the same layer as the current window.  (In the floating layer, all that
-- changes for the two windows is their stacking order if they're on the same
-- screen.  If they're on different screens, each window is moved to the other
-- window's screen but retains its position and size relative to the screen.)
-- The second argument indicates wrapping (see 'windowGo').
windowSwap :: Direction2D -> Bool -> X ()
windowSwap dir wrap = actOnLayer thisLayer
                                 ( \ conf cur wins -> windows
                                   $ doTiledNavigation conf dir swap cur wins
                                 )
                                 ( \ conf cur wins -> windows
                                   $ doFloatNavigation conf dir swap cur wins
                                 )
                                 ( \ _ _ _ -> return () )
                                 wrap

-- | Moves the current window to the next screen in the given direction.  The
-- second argument indicates wrapping (see 'windowGo').
windowToScreen :: Direction2D -> Bool -> X ()
windowToScreen dir wrap = actOnScreens ( \ conf cur wspcs -> windows
                                         $ doScreenNavigation conf dir W.shift cur wspcs
                                       )
                                       wrap

-- | Moves the focus to the next screen in the given direction.  The second
-- argument indicates wrapping (see 'windowGo').
screenGo :: Direction2D -> Bool -> X ()
screenGo dir wrap = actOnScreens ( \ conf cur wspcs -> windows
                                   $ doScreenNavigation conf dir W.view cur wspcs
                                 )
                                 wrap

-- | Swaps the workspace on the current screen with the workspace on the screen
-- in the given direction.  The second argument indicates wrapping (see
-- 'windowGo').
screenSwap :: Direction2D -> Bool -> X ()
screenSwap dir wrap = actOnScreens ( \ conf cur wspcs -> windows
                                     $ doScreenNavigation conf dir W.greedyView cur wspcs
                                   )
                                   wrap

-- | Maps each window to a fullscreen rect.  This may not be the same rectangle the
-- window maps to under the Full layout or a similar layout if the layout
-- respects statusbar struts.  In such cases, it may be better to use
-- 'singleWindowRect'.
fullScreenRect :: Screen -> Window -> X (Maybe Rectangle)
fullScreenRect scr _ = return (Just . screenRect . W.screenDetail $ scr)

-- | Maps each window to the rectangle it would receive if it was the only
-- window in the layout.  Useful, for example, for determining the default
-- rectangle for unmapped windows in a Full layout that respects statusbar
-- struts.
singleWindowRect :: Screen -> Window -> X (Maybe Rectangle)
singleWindowRect scr win  =  listToMaybe
                          .  map snd
                          .  fst
                         <$> runLayout ((W.workspace scr) { W.stack = W.differentiate [win] })
                                       (screenRect . W.screenDetail $ scr)

----------------------------------------------------------------------------------------------------
----------------------------------------------------------------------------------------------------
--                                                                                                --
--                                       PRIVATE X ACTIONS                                        --
--                                                                                                --
----------------------------------------------------------------------------------------------------
----------------------------------------------------------------------------------------------------

-- | Acts on the appropriate layer using the given action functions
actOnLayer :: ([WinRect] -> [WinRect] -> [WinRect])                -- ^ Chooses which layer to operate on, relative
                                                                   -- to the current window (same or other layer)
           -> (Navigation2DConfig -> WinRect -> [WinRect] -> X ()) -- ^ The action for the tiled layer
           -> (Navigation2DConfig -> WinRect -> [WinRect] -> X ()) -- ^ The action for the float layer
           -> (Navigation2DConfig -> WSRect  -> [WSRect]  -> X ()) -- ^ The action if the current workspace is empty
           -> Bool                                                 -- ^ Should navigation wrap around screen edges?
           -> X ()
actOnLayer choice tiledact floatact wsact wrap = withWindowSet $ \winset -> do
  conf <- XS.get
  (floating, tiled) <- navigableWindows conf wrap winset
  let cur = W.peek winset
  case cur of
    Nothing                                   -> actOnScreens wsact wrap
    Just w | Just rect <- L.lookup w tiled    -> tiledact conf (w, rect) (choice tiled floating)
           | Just rect <- L.lookup w floating -> floatact conf (w, rect) (choice floating tiled)
           | otherwise                        -> return ()

-- | Returns the list of windows on the currently visible workspaces
navigableWindows :: Navigation2DConfig -> Bool -> WindowSet -> X ([WinRect], [WinRect])
navigableWindows conf wrap winset  =  L.partition (\(win, _) -> M.member win (W.floating winset))
                                   .  addWrapping winset wrap
                                   .  catMaybes
                                   .  concat
                                  <$>
                                   (  mapM ( \scr -> mapM (maybeWinRect scr)
                                                   $ W.integrate'
                                                   $ W.stack
                                                   $ W.workspace scr
                                           )
                                   .  sortedScreens
                                   )  winset
  where
    maybeWinRect scr win = do
      winrect <- windowRect win
      rect <- case winrect of
                Just _  -> return winrect
                Nothing -> maybe (return Nothing)
                                 (\f -> f scr win)
                                 (L.lookup (description . W.layout . W.workspace $ scr) (unmappedWindowRect conf))
      return ((,) win <$> rect)

-- | Returns the current rectangle of the given window, Nothing if the window isn't mapped
windowRect :: Window -> X (Maybe Rectangle)
windowRect win = withDisplay $ \dpy -> do
  mp <- isMapped win
  if mp then do (_, x, y, w, h, bw, _) <- io $ getGeometry dpy win
                return $ Just $ Rectangle x y (w + 2 * bw) (h + 2 * bw)
                `catchX` return Nothing
        else return Nothing

-- | Acts on the screens using the given action function
actOnScreens :: (Navigation2DConfig -> WSRect -> [WSRect] -> X ())
             -> Bool  -- ^ Should wrapping be used?
             -> X ()
actOnScreens act wrap = withWindowSet $ \winset -> do
  conf <- XS.get
  let wsrects = visibleWorkspaces winset wrap
      cur     = W.tag . W.workspace . W.current $ winset
      rect    = fromJust $ L.lookup cur wsrects
  act conf (cur, rect) wsrects

-- | Determines whether a given window is mapped
isMapped :: Window -> X Bool
isMapped win  =  withDisplay
              $  \dpy -> io
              $  (waIsUnmapped /=)
              .  wa_map_state
             <$> getWindowAttributes dpy win

----------------------------------------------------------------------------------------------------
----------------------------------------------------------------------------------------------------
--                                                                                                --
--                                     PRIVATE PURE FUNCTIONS                                     --
--                                                                                                --
----------------------------------------------------------------------------------------------------
----------------------------------------------------------------------------------------------------

-- | Finds the window closest to the given window and focuses it. Ties are
-- broken by choosing the first window in the window stack among the tied
-- windows.  (The stack order is the one produced by integrate'ing each visible
-- workspace's window stack and concatenating these lists for all visible
-- workspaces.)
doFocusClosestWindow :: WinRect
                     -> [WinRect]
                     -> (WindowSet -> WindowSet)
doFocusClosestWindow (cur, rect) winrects
  | null winctrs = id
  | otherwise    = W.focusWindow . fst $ L.foldl1' closer winctrs
  where
    ctr     = centerOf rect
    winctrs = filter ((cur /=) . fst)
            $ map (\(w, r) -> (w, centerOf r)) winrects
    closer wc1@(_, c1) wc2@(_, c2) | lDist ctr c1 > lDist ctr c2 = wc2
                                   | otherwise                   = wc1

-- | Implements navigation for the tiled layer
doTiledNavigation :: Navigation2DConfig
                  -> Direction2D
                  -> (Window -> WindowSet -> WindowSet)
                  -> WinRect
                  -> [WinRect]
                  -> (WindowSet -> WindowSet)
doTiledNavigation conf dir act cur winrects winset
  | Just win <- runNav nav dir cur winrects = act win winset
  | otherwise                               = winset
  where
    layouts = map (description . W.layout . W.workspace)
            $ W.screens winset
    nav     = maximum
            $ map ( fromMaybe (defaultTiledNavigation conf)
                  . flip L.lookup (layoutNavigation conf)
                  )
            $ layouts

-- | Implements navigation for the float layer
doFloatNavigation :: Navigation2DConfig
                  -> Direction2D
                  -> (Window -> WindowSet -> WindowSet)
                  -> WinRect
                  -> [WinRect]
                  -> (WindowSet -> WindowSet)
doFloatNavigation conf dir act cur winrects
  | Just win <- runNav nav dir cur winrects = act win
  | otherwise                               = id
  where
    nav = floatNavigation conf

-- | Implements navigation between screens
doScreenNavigation :: Navigation2DConfig
                   -> Direction2D
                   -> (WorkspaceId -> WindowSet -> WindowSet)
                   -> WSRect
                   -> [WSRect]
                   -> (WindowSet -> WindowSet)
doScreenNavigation conf dir act cur wsrects
  | Just ws <- runNav nav dir cur wsrects = act ws
  | otherwise                             = id
  where
    nav = screenNavigation conf

-- | Implements line navigation.  For layouts without overlapping windows, there
-- is no need to break ties between equidistant windows.  When windows do
-- overlap, even the best tie breaking rule cannot make line navigation feel
-- natural.  Thus, we fairly arbtitrarily break ties by preferring the window
-- that comes first in the window stack.  (The stack order is the one produced
-- by integrate'ing each visible workspace's window stack and concatenating
-- these lists for all visible workspaces.)
doLineNavigation :: Eq a => Direction2D -> Rect a -> [Rect a] -> Maybe a
doLineNavigation dir (cur, rect) winrects
  | null winrects' = Nothing
  | otherwise      = Just . fst $ L.foldl1' closer winrects'
  where
    -- The current window's center
    ctr@(xc, yc)  = centerOf rect

    -- The list of windows that are candidates to receive focus.
    winrects'     = filter dirFilter
                  $ filter ((cur /=) . fst)
                  $ winrects

    -- Decides whether a given window matches the criteria to be a candidate to
    -- receive the focus.
    dirFilter (_, r) =  (dir == L && leftOf r rect && intersectsY yc r)
                     || (dir == R && leftOf rect r && intersectsY yc r)
                     || (dir == U && above  r rect && intersectsX xc r)
                     || (dir == D && above  rect r && intersectsX xc r)

    -- Decide whether r1 is left of/above r2.
    leftOf r1 r2 = rect_x r1 + fi (rect_width  r1) <= rect_x r2
    above  r1 r2 = rect_y r1 + fi (rect_height r1) <= rect_y r2

    -- Check whether r's x-/y-range contains the given x-/y-coordinate.
    intersectsX x r = rect_x r <= x && rect_x r + fi (rect_width  r) >= x
    intersectsY y r = rect_y r <= y && rect_y r + fi (rect_height r) >= y

    -- Decides whether r1 is closer to the current window's center than r2
    closer wr1@(_, r1) wr2@(_, r2) | dist ctr r1 > dist ctr r2 = wr2
                                   | otherwise                 = wr1

    -- Returns the distance of r from the point (x, y)
    dist (x, y) r | dir == L  = x - rect_x r - fi (rect_width r)
                  | dir == R  = rect_x r - x
                  | dir == U  = y - rect_y r - fi (rect_height r)
                  | otherwise = rect_y r - y

-- | Implements center navigation
doCenterNavigation :: Eq a => Direction2D -> Rect a -> [Rect a] -> Maybe a
doCenterNavigation dir (cur, rect) winrects
  | ((w, _):_) <- onCtr' = Just w
  | otherwise            = closestOffCtr
  where
    -- The center of the current window
    (xc, yc) = centerOf rect

    -- All the windows with their center points relative to the current
    -- center rotated so the right cone becomes the relevant cone.
    -- The windows are ordered in the order they should be preferred
    -- when they are otherwise tied.
    winctrs = map (\(w, r) -> (w, dirTransform . centerOf $ r))
            $ stackTransform
            $ winrects

    -- Give preference to windows later in the stack for going left or up and to
    -- windows earlier in the stack for going right or down.  (The stack order
    -- is the one produced by integrate'ing each visible workspace's window
    -- stack and concatenating these lists for all visible workspaces.)
    stackTransform | dir == L || dir == U = reverse
                   | otherwise            = id

    -- Transform a point into a difference to the current window center and
    -- rotate it so that the relevant cone becomes the right cone.
    dirTransform (x, y) | dir == R  = (  x - xc ,   y - yc )
                        | dir == L  = (-(x - xc), -(y - yc))
                        | dir == D  = (  y - yc ,   x - xc )
                        | otherwise = (-(y - yc), -(x - xc))

    -- Partition the points into points that coincide with the center
    -- and points that do not.
    (onCtr, offCtr) = L.partition (\(_, (x, y)) -> x == 0 && y == 0) winctrs

    -- All the points that coincide with the current center and succeed it
    -- in the (appropriately ordered) window stack.
    onCtr' = L.tail $ L.dropWhile ((cur /=) . fst) onCtr
             -- tail should be safe here because cur should be in onCtr

    -- All the points that do not coincide with the current center and which
    -- lie in the (rotated) right cone.
    offCtr' = L.filter (\(_, (x, y)) -> x > 0 && y < x && y >= -x) offCtr

    -- The off-center point closest to the center and
    -- closest to the bottom ray of the cone.  Nothing if no off-center
    -- point is in the cone
    closestOffCtr = if null offCtr' then Nothing
                                    else Just $ fst $ L.foldl1' closest offCtr'

    closest wp@(_, p@(_, yp)) wq@(_, q@(_, yq))
      | lDist (0, 0) q < lDist (0, 0) p = wq -- q is closer than p
      | lDist (0, 0) p < lDist (0, 0) q = wp -- q is farther away than p
      | yq < yp                         = wq -- q is closer to the bottom ray than p
      | otherwise                       = wp -- q is farther away from the bottom ray than p
                                             -- or it has the same distance but comes later
                                             -- in the window stack

-- | Swaps the current window with the window given as argument
swap :: Window -> WindowSet -> WindowSet
swap win winset = W.focusWindow cur
                $ L.foldl' (flip W.focusWindow) newwinset newfocused
  where
    -- The current window
    cur      = fromJust $ W.peek winset

    -- All screens
    scrs     = W.screens winset

    -- All visible workspaces
    visws    = map W.workspace scrs

    -- The focused windows of the visible workspaces
    focused  = mapMaybe (\ws -> W.focus <$> W.stack ws) visws

    -- The window lists of the visible workspaces
    wins     = map (W.integrate' . W.stack) visws

    -- Update focused windows and window lists to reflect swap of windows.
    newfocused = map swapWins focused
    newwins    = map (map swapWins) wins

    -- Replaces the current window with the argument window and vice versa.
    swapWins x | x == cur  = win
               | x == win  = cur
               | otherwise = x

    -- Reconstruct the workspaces' window stacks to reflect the swap.
    newvisws  = zipWith (\ws wns -> ws { W.stack = W.differentiate wns }) visws newwins
    newscrs   = zipWith (\scr ws -> scr { W.workspace = ws }) scrs newvisws
    newwinset = winset { W.current = head newscrs
                       , W.visible = tail newscrs
                       }

-- | Calculates the center of a rectangle
centerOf :: Rectangle -> (Position, Position)
centerOf r = (rect_x r + fi (rect_width r) `div` 2, rect_y r + fi (rect_height r) `div` 2)

-- | Shorthand for integer conversions
fi :: (Integral a, Num b) => a -> b
fi = fromIntegral

-- | Functions to choose the subset of windows to operate on
thisLayer, otherLayer :: a -> a -> a
thisLayer  = curry fst
otherLayer = curry snd

-- | Returns the list of visible workspaces and their screen rects
visibleWorkspaces :: WindowSet -> Bool -> [WSRect]
visibleWorkspaces winset wrap = addWrapping winset wrap
                              $ map ( \scr -> ( W.tag . W.workspace         $ scr
                                              , screenRect . W.screenDetail $ scr
                                              )
                                    )
                              $ sortedScreens winset

-- | Creates five copies of each (window/workspace, rect) pair in the input: the
-- original and four offset one desktop size (desktop = collection of all
-- screens) to the left, to the right, up, and down.  Wrap-around at desktop
-- edges is implemented by navigating into these displaced copies.
addWrapping :: WindowSet -- ^ The window set, used to get the desktop size
            -> Bool      -- ^ Should wrapping be used?  Do nothing if not.
            -> [Rect a]  -- ^ Input set of (window/workspace, rect) pairs
            -> [Rect a]
addWrapping _      False wrects = wrects
addWrapping winset True  wrects = [ (w, r { rect_x = rect_x r + fi x
                                          , rect_y = rect_y r + fi y
                                          }
                                    )
                                  | (w, r) <- wrects
                                  , (x, y)  <- [(0, 0), (-xoff, 0), (xoff, 0), (0, -yoff), (0, yoff)]
                                  ]
  where
    (xoff, yoff) = wrapOffsets winset

-- | Calculates the offsets for window/screen coordinates for the duplication
-- of windows/workspaces that implements wrap-around.
wrapOffsets :: WindowSet -> (Integer, Integer)
wrapOffsets winset = (max_x - min_x, max_y - min_y)
  where
    min_x = fi $ minimum $ map rect_x rects
    min_y = fi $ minimum $ map rect_y rects
    max_x = fi $ maximum $ map (\r -> rect_x r + (fi $ rect_width  r)) rects
    max_y = fi $ maximum $ map (\r -> rect_y r + (fi $ rect_height r)) rects
    rects = map snd $ visibleWorkspaces winset False


-- | Returns the list of screens sorted primarily by their centers'
-- x-coordinates and secondarily by their y-coordinates.
sortedScreens :: WindowSet -> [Screen]
sortedScreens winset = L.sortBy cmp
                     $ W.screens winset
  where
    cmp s1 s2 | x1 < x2   = LT
              | x1 > x2   = GT
              | y1 < x2   = LT
              | y1 > y2   = GT
              | otherwise = EQ
      where
        (x1, y1) = centerOf (screenRect . W.screenDetail $ s1)
        (x2, y2) = centerOf (screenRect . W.screenDetail $ s2)


-- | Calculates the L1-distance between two points.
lDist :: (Position, Position) -> (Position, Position) -> Int
lDist (x1, y1) (x2, y2) = abs (fi $ x1 - x2) + abs (fi $ y1 - y2)