about summary refs log tree commit diff
path: root/src/XMonad/Actions/FloatSnapSpaced.hs
diff options
context:
space:
mode:
authorAzat Bahawi <azahi@teknik.io>2020-11-20 23:13:14 +0300
committerAzat Bahawi <azahi@teknik.io>2020-11-20 23:13:14 +0300
commit4181e8c47883dc456db4310f42212262d5a8ad1a (patch)
tree5c4f279b290b2cd8a2ac14488bfa2e7b7df12c85 /src/XMonad/Actions/FloatSnapSpaced.hs
parentSync submodules (diff)
bump dependencies + brittany/cabal-fmt
Diffstat (limited to '')
-rw-r--r--src/XMonad/Actions/FloatSnapSpaced.hs221
1 files changed, 129 insertions, 92 deletions
diff --git a/src/XMonad/Actions/FloatSnapSpaced.hs b/src/XMonad/Actions/FloatSnapSpaced.hs
index f43558a..ad14016 100644
--- a/src/XMonad/Actions/FloatSnapSpaced.hs
+++ b/src/XMonad/Actions/FloatSnapSpaced.hs
@@ -8,110 +8,147 @@
 --
 
 module XMonad.Actions.FloatSnapSpaced
-    ( snapSpacedMagicMove
-    ) where
+  ( snapSpacedMagicMove
+  ) where
 
 import           Data.List
 import           Data.Maybe
-import           Data.Set                 (fromList)
+import           Data.Set                       ( fromList )
 import           XMonad
 import           XMonad.Hooks.ManageDocks
-import qualified XMonad.StackSet          as S
+import qualified XMonad.StackSet               as S
 
 snapSpacedMagicMove :: Int -> Maybe Int -> Maybe Int -> Window -> X ()
-snapSpacedMagicMove spacing collidedist snapdist w = whenX (isClient w) $ withDisplay $ \d -> do
+snapSpacedMagicMove spacing collidedist snapdist w =
+  whenX (isClient w) $ withDisplay $ \d -> do
     io $ raiseWindow d w
     wa <- io $ getWindowAttributes d w
 
-    nx <- handleAxis True  d wa
+    nx <- handleAxis True d wa
     ny <- handleAxis False d wa
 
     io $ moveWindow d w (fromIntegral nx) (fromIntegral ny)
     float w
-    where
-        handleAxis horiz d wa = do
-            ((mbl, mbr, bs), (mfl, mfr, fs)) <- getSnap horiz collidedist d w
-            return $ if bs || fs
-                     then wpos wa
-                     else let b = case (mbl, mbr) of
-                                       (Just bl, Just br) -> if wpos wa - bl           < br - wpos wa
-                                                                then bl + spacing
-                                                                else br + spacing
-                                       (Just bl, Nothing) -> bl         + spacing
-                                       (Nothing, Just br) -> br         + spacing
-                                       (Nothing, Nothing) -> wpos wa    + spacing
-
-                              f = case (mfl, mfr) of
-                                       (Just fl, Just fr) -> if wpos wa + wdim wa - fl < fr - wpos wa - wdim wa
-                                                                then fl - spacing
-                                                                else fr - spacing
-                                       (Just fl, Nothing) -> fl         - spacing
-                                       (Nothing, Just fr) -> fr         - spacing
-                                       (Nothing, Nothing) -> wpos wa    - spacing
-
-                              newpos = if abs (b - wpos wa) <= abs (f - wpos wa - wdim wa)
-                                          then b
-                                          else f - wdim wa
-
-                              in if isNothing snapdist || abs (newpos - wpos wa) <= fromJust snapdist
-                                    then newpos
-                                    else wpos wa
-            where
-                 (wpos, wdim, _, _) = constructors horiz
-
-getSnap :: Bool -> Maybe Int -> Display -> Window -> X ((Maybe Int, Maybe Int, Bool), (Maybe Int, Maybe Int, Bool))
+ where
+  handleAxis horiz d wa = do
+    ((mbl, mbr, bs), (mfl, mfr, fs)) <- getSnap horiz collidedist d w
+    return $ if bs || fs
+      then wpos wa
+      else
+        let
+          b = case (mbl, mbr) of
+            (Just bl, Just br) ->
+              if wpos wa - bl < br - wpos wa then bl + spacing else br + spacing
+            (Just bl, Nothing) -> bl + spacing
+            (Nothing, Just br) -> br + spacing
+            (Nothing, Nothing) -> wpos wa + spacing
+
+          f = case (mfl, mfr) of
+            (Just fl, Just fr) ->
+              if wpos wa + wdim wa - fl < fr - wpos wa - wdim wa
+                then fl - spacing
+                else fr - spacing
+            (Just fl, Nothing) -> fl - spacing
+            (Nothing, Just fr) -> fr - spacing
+            (Nothing, Nothing) -> wpos wa - spacing
+
+          newpos = if abs (b - wpos wa) <= abs (f - wpos wa - wdim wa)
+            then b
+            else f - wdim wa
+        in
+          if isNothing snapdist || abs (newpos - wpos wa) <= fromJust snapdist
+            then newpos
+            else wpos wa
+    where (wpos, wdim, _, _) = constructors horiz
+
+getSnap
+  :: Bool
+  -> Maybe Int
+  -> Display
+  -> Window
+  -> X ((Maybe Int, Maybe Int, Bool), (Maybe Int, Maybe Int, Bool))
 getSnap horiz collidedist d w = do
-    wa <- io $ getWindowAttributes d w
-    screen <- S.current <$> gets windowset
-    let sr = screenRect $ S.screenDetail screen
-        wl = S.integrate' . S.stack $ S.workspace screen
-    gr <- fmap ($ sr) $ calcGap $ fromList [minBound .. maxBound]
-    wla <- filter (collides wa) <$> io (mapM (getWindowAttributes d) $ filter (/= w) wl)
-
-    return ( neighbours (back  wa sr gr wla) (wpos wa)
-           , neighbours (front wa sr gr wla) (wpos wa + wdim wa)
-           )
-    where
-        wborder = fromIntegral.wa_border_width
-
-        (wpos, wdim, rpos, rdim) = constructors horiz
-        (refwpos, refwdim, _, _) = constructors $ not horiz
-
-        back  wa sr gr wla = dropWhile (< rpos sr)
-                           $ takeWhile (< rpos sr + rdim sr)
-                           $ sort
-                           $ rpos sr :
-                             rpos gr :
-                             (rpos gr + rdim gr) :
-                             foldr (\a as -> wpos a : (wpos a + wdim a + wborder a + wborder wa) : as)   [] wla
-
-        front wa sr gr wla = dropWhile (<= rpos sr)
-                           $ takeWhile (<= rpos sr + rdim sr)
-                           $ sort
-                           $ (rpos gr - 2 * wborder wa) :
-                             (rpos gr + rdim gr - 2 * wborder wa) :
-                             (rpos sr + rdim sr - 2 * wborder wa) :
-                             foldr (\a as -> (wpos a - wborder a - wborder wa) : (wpos a + wdim a) : as) [] wla
-
-        neighbours l v = ( listToMaybe $ reverse $ takeWhile (< v) l
-                         , listToMaybe $ dropWhile (<= v) l
-                         , v `elem` l
-                         )
-
-        collides wa oa = case collidedist of
-                              Nothing   -> True
-                              Just dist -> refwpos oa - wborder oa        < refwpos wa + refwdim wa + wborder wa + dist
-                                        && refwpos wa - wborder wa - dist < refwpos oa + refwdim oa + wborder oa
-
-
-constructors :: Bool -> (WindowAttributes -> Int, WindowAttributes -> Int, Rectangle -> Int, Rectangle -> Int)
-constructors True  = ( fromIntegral.wa_x
-                     , fromIntegral.wa_width
-                     , fromIntegral.rect_x
-                     , fromIntegral.rect_width
-                     )
-constructors False = ( fromIntegral.wa_y
-                     , fromIntegral.wa_height
-                     , fromIntegral.rect_y
-                     , fromIntegral.rect_height
-                     )
+  wa     <- io $ getWindowAttributes d w
+  screen <- S.current <$> gets windowset
+  let sr = screenRect $ S.screenDetail screen
+      wl = S.integrate' . S.stack $ S.workspace screen
+  gr  <- fmap ($ sr) $ calcGap $ fromList [minBound .. maxBound]
+  wla <- filter (collides wa)
+    <$> io (mapM (getWindowAttributes d) $ filter (/= w) wl)
+
+  return
+    ( neighbours (back wa sr gr wla)  (wpos wa)
+    , neighbours (front wa sr gr wla) (wpos wa + wdim wa)
+    )
+ where
+  wborder                        = fromIntegral . wa_border_width
+
+  (wpos   , wdim   , rpos, rdim) = constructors horiz
+  (refwpos, refwdim, _   , _   ) = constructors $ not horiz
+
+  back wa sr gr wla =
+    dropWhile (< rpos sr)
+      $ takeWhile (< rpos sr + rdim sr)
+      $ sort
+      $ rpos sr
+      : rpos gr
+      : (rpos gr + rdim gr)
+      : foldr
+          (\a as -> wpos a : (wpos a + wdim a + wborder a + wborder wa) : as)
+          []
+          wla
+
+  front wa sr gr wla =
+    dropWhile (<= rpos sr)
+      $ takeWhile (<= rpos sr + rdim sr)
+      $ sort
+      $ (rpos gr - 2 * wborder wa)
+      : (rpos gr + rdim gr - 2 * wborder wa)
+      : (rpos sr + rdim sr - 2 * wborder wa)
+      : foldr
+          (\a as -> (wpos a - wborder a - wborder wa) : (wpos a + wdim a) : as)
+          []
+          wla
+
+  neighbours l v =
+    ( listToMaybe $ reverse $ takeWhile (< v) l
+    , listToMaybe $ dropWhile (<= v) l
+    , v `elem` l
+    )
+
+  collides wa oa = case collidedist of
+    Nothing -> True
+    Just dist ->
+      refwpos oa
+        -  wborder oa
+        <  refwpos wa
+        +  refwdim wa
+        +  wborder wa
+        +  dist
+        && refwpos wa
+        -  wborder wa
+        -  dist
+        <  refwpos oa
+        +  refwdim oa
+        +  wborder oa
+
+
+constructors
+  :: Bool
+  -> ( WindowAttributes -> Int
+     , WindowAttributes -> Int
+     , Rectangle -> Int
+     , Rectangle -> Int
+     )
+constructors True =
+  ( fromIntegral . wa_x
+  , fromIntegral . wa_width
+  , fromIntegral . rect_x
+  , fromIntegral . rect_width
+  )
+constructors False =
+  ( fromIntegral . wa_y
+  , fromIntegral . wa_height
+  , fromIntegral . rect_y
+  , fromIntegral . rect_height
+  )

Consider giving Nix/NixOS a try! <3