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
|
{-# OPTIONS_GHC -fglasgow-exts #-} -- For deriving Data/Typeable
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-}
-----------------------------------------------------------------------------
-- |
-- 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
, DragPane, DragType (..)
) where
import Graphics.X11.Xlib
import Graphics.X11.Xlib.Extras
import XMonad
import Data.Bits
import Data.Unique
import Operations
import qualified StackSet as W
import XMonadContrib.Invisible
import XMonadContrib.XUtils
-- $usage
--
-- You can use this module with the following in your Config.hs file:
--
-- > import XMonadContrib.DragPane
--
-- and add, to the list of layouts:
--
-- > Layout $ dragPane Horizontal 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 (I Nothing) t x y
data DragPane a =
DragPane (Invisible Maybe (Window,Rectangle,Int)) DragType Double Double
deriving ( Show, Read )
data DragType = Horizontal | Vertical deriving ( Show, Read )
instance LayoutClass DragPane a 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 a -> SomeMessage -> X (Maybe (DragPane a))
handleMess d@(DragPane mb@(I (Just (win,_,ident))) ty delta split) x
| Just e <- fromMessage x :: Maybe Event = do handleEvent d e
return Nothing
| Just Hide <- fromMessage x = do hideWindow win
return $ Just (DragPane mb ty delta split)
| Just ReleaseResources <- fromMessage x = do deleteWindow win
return $ Just (DragPane (I 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 a -> Event -> X ()
handleEvent (DragPane (I (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_x r))/(fromIntegral $ rect_width r)
sendMessage (SetFrac ident frac))
(return ())
handleEvent _ _ = return ()
doLay :: (Rectangle -> Rectangle) -> DragPane a -> Rectangle -> W.Stack a -> X ([(a, Rectangle)], Maybe (DragPane a))
doLay mirror (DragPane mw ty delta split) r s = do
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
I (Just (w,_,ident)) -> do
w' <- deleteWindow w >> newDragWin handr
return (wrs, Just $ DragPane (I $ Just (w',r',ident)) ty delta split)
I Nothing -> do
w <- newDragWin handr
i <- io $ newUnique
return (wrs, Just $ DragPane (I $ Just (w,r',hashUnique i)) ty delta split)
else return (wrs, Nothing)
newDragWin :: Rectangle -> X Window
newDragWin r = do
let mask = Just $ exposureMask .|. buttonPressMask
w <- createNewWindow r mask handleColor
showWindow w
return w
|
