From cc9c3ca0a4d5ced7506389f167d7afc0194d3ab8 Mon Sep 17 00:00:00 2001 From: Karsten Schoelzel Date: Tue, 4 Sep 2007 23:03:12 +0200 Subject: Unify Drag(UpDown)Pane darcs-hash:20070904210312-eb3a1-32841ac45ace5c5bc512712d410d3ec4ce69866b.gz --- DragPane.hs | 68 +++++++++++++++++++------------------------------------------ 1 file changed, 21 insertions(+), 47 deletions(-) (limited to 'DragPane.hs') 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 ) -- cgit v1.2.3