1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
|
{-# OPTIONS_GHC -fglasgow-exts #-}
-----------------------------------------------------------------------------
-- |
-- Module : XMonadContrib.DragPane
-- Copyright : (c) Spencer Janssen <sjanssen@cse.unl.edu>
-- David Roundy <droundy@darcs.net>,
-- Andrea Rossato <andrea.rossato@unibz.it>
-- License : BSD3-style (see LICENSE)
--
-- Maintainer : David Roundy <droundy@darcs.net>
-- Andrea Rossato <andrea.rossato@unibz.it>
-- Stability : unstable
-- Portability : unportable
--
-- Layouts that splits the screen either horizontally or vertically and
-- shows two windows. The first window is always the master window, and
-- the other is either the currently focused window or the second window in
-- layout order.
-----------------------------------------------------------------------------
module XMonadContrib.DragPane (
-- * Usage
-- $usage
dragPane
, DragType (..)
) where
import Control.Monad.Reader ( asks )
import Graphics.X11.Xlib
import Graphics.X11.Xlib.Extras
import XMonad
import Data.Bits
import Data.Unique
import Operations
import qualified StackSet as W
-- $usage
--
-- You can use this module with the following in your Config.hs file:
--
-- > import XMonadContrib.DragPane
--
-- and add, to the list of layouts:
--
-- > dragPane Vertical 0.1 0.5
halfHandleWidth :: Integral a => a
halfHandleWidth = 1
handleColor :: String
handleColor = "#000000"
dragPane :: DragType -> Double -> Double -> DragPane a
dragPane t x y = DragPane Nothing t x y
data DragPane a =
DragPane (Maybe (Window,Rectangle,Int)) DragType Double Double
deriving ( Show, Read )
data DragType = Horizontal | Vertical deriving ( Show, Read )
instance Layout DragPane Window where
doLayout d@(DragPane _ Vertical _ _) = doLay id d
doLayout d@(DragPane _ Horizontal _ _) = doLay mirrorRect d
handleMessage = handleMess
data SetFrac = SetFrac Int Double deriving ( Show, Read, Eq, Typeable )
instance Message SetFrac
handleMess :: DragPane Window -> SomeMessage -> X (Maybe (DragPane Window))
handleMess d@(DragPane mb@(Just (win,_,ident)) ty delta split) x
| Just e <- fromMessage x :: Maybe Event = do
handleEvent d e
return Nothing
| Just Hide <- fromMessage x = do
hideDragWin win
return $ Just (DragPane mb ty delta split)
| Just ReleaseResources <- fromMessage x = do
destroyDragWin win
return $ Just (DragPane Nothing ty delta split)
-- layout specific messages
| Just Shrink <- fromMessage x = return $ Just (DragPane mb ty delta (split - delta))
| Just Expand <- fromMessage x = return $ Just (DragPane mb ty delta (split + delta))
| Just (SetFrac ident' frac) <- fromMessage x, ident' == ident = do
return $ Just (DragPane mb ty delta frac)
handleMess _ _ = return Nothing
handleEvent :: DragPane Window -> Event -> X ()
handleEvent (DragPane (Just (win,r,ident)) ty _ _)
(ButtonEvent {ev_window = thisw, ev_subwindow = thisbw, ev_event_type = t })
| t == buttonPress && thisw == win || thisbw == win = do
mouseDrag (\ex ey -> do
let frac = case ty of
Vertical -> (fromIntegral ex - (fromIntegral $ rect_x r))/(fromIntegral $ rect_width r)
Horizontal -> (fromIntegral ey - (fromIntegral $ rect_y r))/(fromIntegral $ rect_height r)
sendMessage (SetFrac ident frac))
(return ())
handleEvent _ _ = return ()
doLay :: (Rectangle -> Rectangle) -> DragPane Window -> Rectangle -> W.Stack a -> X ([(a, Rectangle)], Maybe (DragPane a))
doLay mirror (DragPane mw ty delta split) r s = do
handlec <- withDisplay $ \dpy -> io $ initColor dpy handleColor
let r' = mirror r
(left', right') = splitHorizontallyBy split r'
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 ->
mirror $ Rectangle (x+halfHandleWidth) y (w-halfHandleWidth) h
handr = case left' of
Rectangle x y w h ->
mirror $ Rectangle (x + fromIntegral w - halfHandleWidth) y (2*halfHandleWidth) h
wrs = case reverse (W.up s) of
(master:_) -> [(master,left),(W.focus s,right)]
[] -> case W.down s of
(next:_) -> [(W.focus s,left),(next,right)]
[] -> [(W.focus s, r)]
if length wrs > 1
then case mw of
Just (w,_,ident) -> do
w' <- updateDragWin w handlec handr
return (wrs, Just $ DragPane (Just (w',r',ident)) ty delta split)
Nothing -> do
w <- newDragWin handlec handr
i <- io $ newUnique
return (wrs, Just $ DragPane (Just (w,r',hashUnique i)) ty delta split)
else return (wrs, Nothing)
newDragWin :: Pixel -> Rectangle -> X Window
newDragWin p r = do
d <- asks display
dragWin d p r
updateDragWin :: Window -> Pixel -> Rectangle -> X Window
updateDragWin w p r = do
d <- asks display
io $ destroyWindow d w
dragWin d p r
hideDragWin :: Window -> X ()
hideDragWin w = do
d <- asks display
io $ unmapWindow d w
destroyDragWin :: Window -> X ()
destroyDragWin w = do
d <- asks display
io $ destroyWindow d w
dragWin :: Display -> Pixel -> Rectangle -> X Window
dragWin d p (Rectangle x y wt ht) = do
rt <- asks theRoot
w <- io $ createSimpleWindow d rt x y wt ht 0 p p
io $ selectInput d w $ exposureMask .|. buttonPressMask
io $ mapWindow d w
return w
|
