twin/xmonad-contrib
1
0
Fork 0
mirror of https://github.com/xmonad/xmonad-contrib.git synced 2025-08-01 12:41:52 -07:00
Code Issues Packages Projects Releases Wiki Activity

Unify Drag(UpDown)Pane

Browse Source
This commit is contained in:
Karsten Schoelzel
2007-09-04 21:03:12 +00:00
parent 3c72df8713
commit 9ab2d77798
1 changed files with 21 additions and 47 deletions
Download Patch File Download Diff File Expand all files Collapse all files

68
DragPane.hs
View File

@@ -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,19 +46,28 @@ handleColor :: String
handleColor = "#000000"
dragPane :: String -> Double -> Double -> Layout a
dragPane ident delta split = Layout { doLayout = dolay, modifyLayout = return . message }
dragPane = dragPane' id
dragUpDownPane :: String -> Double -> Double -> Layout a
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') = 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
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+halfHandleWidth) y (w-halfHandleWidth) h
Rectangle x y w h ->
mirror $ 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
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
@@ -71,48 +80,13 @@ dragPane ident delta split = Layout { doLayout = dolay, modifyLayout = return .
sendMessage (SetFrac ident ((fromIntegral ex - leftmost)/widt)))
(return ())
ml' <- if length wrs > 1 then Just `fmap` handle (dragPane 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 (dragPane ident delta (split - delta))
| Just Expand <- fromMessage x = Just (dragPane 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 (dragPane ident delta frac)
message _ = Nothing
dragUpDownPane :: String -> Double -> Double -> Layout a
dragUpDownPane 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)
right = case right' of
Rectangle x y w h -> Rectangle x (y+halfHandleWidth) w (h-halfHandleWidth)
handr = case left' of
Rectangle x y w h ->
Rectangle x (y + fromIntegral h - halfHandleWidth) w (2*halfHandleWidth)
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 (\_ ey ->
sendMessage (SetFrac ident ((fromIntegral ey - leftmost)/widt)))
(return ())
ml' <- if length wrs > 1 then Just `fmap` handle (dragUpDownPane 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))
| 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 )