Unify Drag(UpDown)Pane

darcs-hash:20070904210312-eb3a1-32841ac45ace5c5bc512712d410d3ec4ce69866b.gz

1 files changed, 21 insertions, 47 deletions

diff --git a/DragPane.hs b/DragPane.hs
index 17884c3..6989ac4 100644
--- a/DragPane.hs
+++ b/DragPane.hs
@@ -26,7 +26,7 @@ import Control.Monad.Reader ( asks )
 import Graphics.X11.Xlib ( Rectangle( Rectangle ) )
 import XMonad
 import XMonadContrib.Decoration ( newDecoration )
-import Operations ( Resize(..), splitHorizontallyBy, splitVerticallyBy, initColor, mouseDrag, sendMessage )
+import Operations ( Resize(..), splitHorizontallyBy, initColor, mouseDrag, sendMessage, mirrorRect )
 import StackSet ( focus, up, down)
 
 -- $usage
@@ -46,54 +46,28 @@ handleColor :: String
 handleColor = "#000000"
 
 dragPane :: String -> Double -> Double -> Layout a
-dragPane ident delta split = Layout { doLayout = dolay, modifyLayout = return . message }
- where
-    dolay r s = do handlec <- withDisplay $ \dpy -> io $ initColor dpy handleColor
-                   root <- asks theRoot
-                   let (left', right') = splitHorizontallyBy split r
-                       leftmost = fromIntegral $ case r of Rectangle x _ _ _ -> x
-                       widt = fromIntegral $ case r of Rectangle _ _ w _ -> w
-                       left = case left' of Rectangle x y w h -> Rectangle x y (w-halfHandleWidth) h
-                       right = case right' of
-                               Rectangle x y w h -> Rectangle (x+halfHandleWidth) y (w-halfHandleWidth) h
-                       handr = case left' of
-                               Rectangle x y w h ->
-                                 Rectangle (x + fromIntegral w - halfHandleWidth) y (2*halfHandleWidth) h
-                       wrs = case reverse (up s) of
-                             (master:_) -> [(master,left),(focus s,right)]
-                             [] -> case down s of
-                                   (next:_) -> [(focus s,left),(next,right)]
-                                   [] -> [(focus s, r)]
-                       handle = newDecoration root handr 0 handlec handlec
-                                "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*"
-                                (const $ const $ const $ const $ return ()) (doclick)
-                       doclick = mouseDrag (\ex _ ->
-                                        sendMessage (SetFrac ident ((fromIntegral ex - leftmost)/widt)))
-                                        (return ())
-                                        
-                   ml' <- if length wrs > 1 then Just `fmap` handle (dragPane ident delta split)
-                                            else return Nothing
-                   return (wrs, ml')
-    message x | Just Shrink <- fromMessage x = Just (dragPane ident delta (split - delta))
-              | Just Expand <- fromMessage x = Just (dragPane ident delta (split + delta))
-              | Just (SetFrac ident' frac) <- fromMessage x, ident' == ident =
-                                              Just (dragPane ident delta frac)
-    message _ = Nothing
+dragPane = dragPane' id
 
 dragUpDownPane :: String -> Double -> Double -> Layout a
-dragUpDownPane ident delta split = Layout { doLayout = dolay, modifyLayout = return . message }
+dragUpDownPane = dragPane' mirrorRect
+
+dragPane' :: (Rectangle -> Rectangle) -> String -> Double -> Double -> Layout a
+dragPane' mirror ident delta split = Layout { doLayout = dolay, modifyLayout = return . message }
  where
     dolay r s = do handlec <- withDisplay $ \dpy -> io $ initColor dpy handleColor
                    root <- asks theRoot
-                   let (left', right') = splitVerticallyBy split r
-                       leftmost = fromIntegral $ case r of Rectangle _ x _ _ -> x
-                       widt = fromIntegral $ case r of Rectangle _ _ _ w -> w
-                       left = case left' of Rectangle x y w h -> Rectangle x y w (h-halfHandleWidth)
+                   let r' = mirror r
+		       (left', right') = splitHorizontallyBy split r'
+                       leftmost = fromIntegral $ case r' of Rectangle x _ _ _ -> x
+                       widt = fromIntegral $ case r' of Rectangle _ _ w _ -> w
+                       left = case left' of Rectangle x y w h ->
+		                              mirror $ Rectangle x y (w-halfHandleWidth) h
                        right = case right' of
-                               Rectangle x y w h -> Rectangle x (y+halfHandleWidth) w (h-halfHandleWidth)
+                               Rectangle x y w h ->
+			         mirror $ Rectangle (x+halfHandleWidth) y (w-halfHandleWidth) h
                        handr = case left' of
                                Rectangle x y w h ->
-                                 Rectangle x (y + fromIntegral h - halfHandleWidth) w (2*halfHandleWidth)
+                                 mirror $ Rectangle (x + fromIntegral w - halfHandleWidth) y (2*halfHandleWidth) h
                        wrs = case reverse (up s) of
                              (master:_) -> [(master,left),(focus s,right)]
                              [] -> case down s of
@@ -102,17 +76,17 @@ dragUpDownPane ident delta split = Layout { doLayout = dolay, modifyLayout = ret
                        handle = newDecoration root handr 0 handlec handlec
                                 "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*"
                                 (const $ const $ const $ const $ return ()) (doclick)
-                       doclick = mouseDrag (\_ ey ->
-                                        sendMessage (SetFrac ident ((fromIntegral ey - leftmost)/widt)))
+                       doclick = mouseDrag (\ex _ ->
+                                        sendMessage (SetFrac ident ((fromIntegral ex - leftmost)/widt)))
                                         (return ())
                                         
-                   ml' <- if length wrs > 1 then Just `fmap` handle (dragUpDownPane ident delta split)
+                   ml' <- if length wrs > 1 then Just `fmap` handle (dragPane' mirror ident delta split)
                                             else return Nothing
                    return (wrs, ml')
-    message x | Just Shrink <- fromMessage x = Just (dragUpDownPane ident delta (split - delta))
-              | Just Expand <- fromMessage x = Just (dragUpDownPane ident delta (split + delta))
+    message x | Just Shrink <- fromMessage x = Just (dragPane' mirror ident delta (split - delta))
+              | Just Expand <- fromMessage x = Just (dragPane' mirror ident delta (split + delta))
               | Just (SetFrac ident' frac) <- fromMessage x, ident' == ident =
-                                              Just (dragUpDownPane ident delta frac)
+                                              Just (dragPane' mirror ident delta frac)
     message _ = Nothing
 
 data SetFrac = SetFrac String Double deriving ( Show, Read, Eq, Typeable )