diff options
Diffstat (limited to 'lib/events.sls')
-rw-r--r-- | lib/events.sls | 83 |
1 files changed, 83 insertions, 0 deletions
diff --git a/lib/events.sls b/lib/events.sls new file mode 100644 index 0000000..9bb78ee --- /dev/null +++ b/lib/events.sls | |||
@@ -0,0 +1,83 @@ | |||
1 | ;;; (acdwm events) --- event handlers | ||
2 | |||
3 | (import (acdwm keys) | ||
4 | (acdwm xlib) | ||
5 | (acdwm util) | ||
6 | (srfi 1)) | ||
7 | |||
8 | (export make-drag drag? drag-type drag-event drag-window drag-attrs) | ||
9 | (define-record drag type event window attrs) | ||
10 | |||
11 | (define drag (make-parameter #f)) | ||
12 | (define drag-types '(move resize)) | ||
13 | |||
14 | (define-public (initialize-drag type event) | ||
15 | (assert (memq type drag-types)) | ||
16 | (let ((win (and (buttonpress? event) | ||
17 | (xevent-xbutton-subwindow event)))) | ||
18 | (and win | ||
19 | (drag (make-drag type event win (get-window-attributes win)))))) | ||
20 | |||
21 | (define-public (cancel-drag) | ||
22 | (free-xevent (drag-event (drag))) | ||
23 | (free-xwindowattributes (drag-attrs (drag))) | ||
24 | (drag #f)) | ||
25 | |||
26 | (define-public (handle-events #!optional (dpy (get-display))) | ||
27 | (let loop ((this (get-next-event dpy))) | ||
28 | (dprint "handling a " (xevent-type-name (xevent-type this))) | ||
29 | (cond | ||
30 | ((keypress? this) | ||
31 | (handle-keypress this dpy) | ||
32 | (loop (get-next-event dpy))) | ||
33 | ((buttonpress? this) | ||
34 | (handle-buttonpress this) | ||
35 | (loop (get-next-event dpy))) | ||
36 | ((buttonrelease? this) | ||
37 | (handle-buttonrelease this) | ||
38 | (loop (get-next-event dpy))) | ||
39 | ((motionnotify? this) | ||
40 | (handle-motion this) | ||
41 | (loop (get-next-event dpy))) | ||
42 | ;; Make sure this is at the end! | ||
43 | (else | ||
44 | (loop (get-next-event dpy)))))) | ||
45 | |||
46 | ;;; Handlers | ||
47 | |||
48 | (define-public (handle-keypress event | ||
49 | #!optional (dpy (get-display))) | ||
50 | (let ((binding (find-keybinding event))) | ||
51 | (dprint "handle-keypress: " binding) | ||
52 | (and binding ((keybind-proc binding) event dpy)))) | ||
53 | |||
54 | (define-public (handle-buttonpress event | ||
55 | #!optional (dpy (get-display))) | ||
56 | (let ((binding (find-mousebinding event))) | ||
57 | (dprint "handle-buttonpress: " binding) | ||
58 | (and binding ((mousebind-proc binding) event dpy)))) | ||
59 | |||
60 | (define-public (handle-buttonrelease event | ||
61 | #!optional (dpy (get-display))) | ||
62 | (dprint "handle-buttonrelease") | ||
63 | (cancel-drag)) | ||
64 | |||
65 | (define-public (handle-motion event | ||
66 | #!optional (dpy (get-display))) | ||
67 | (dprint "handle-motion") | ||
68 | (when (drag) | ||
69 | (when (some? (drag-window (drag))) | ||
70 | (let ((xd (- (xevent-xbutton-x_root event) | ||
71 | (xevent-xbutton-x_root (drag-event (drag))))) | ||
72 | (yd (- (xevent-xbutton-y_root event) | ||
73 | (xevent-xbutton-y_root (drag-event (drag)))))) | ||
74 | (let ((xnew (+ (xwindowattributes-x (drag-attrs (drag))) | ||
75 | (if (eq? (drag-type (drag)) 'move) xd 0))) | ||
76 | (ynew (+ (xwindowattributes-y (drag-attrs (drag))) | ||
77 | (if (eq? (drag-type (drag)) 'move) yd 0))) | ||
78 | (wnew (max 1 (+ (xwindowattributes-width (drag-attrs (drag))) | ||
79 | (if (eq? (drag-type (drag)) 'resize) xd 0)))) | ||
80 | (hnew (max 1 (+ (xwindowattributes-height (drag-attrs (drag))) | ||
81 | (if (eq? (drag-type (drag)) 'resize) yd 0))))) | ||
82 | (dprint wnew "x" hnew "+" xnew "+" ynew) | ||
83 | (xmoveresizewindow dpy (drag-window (drag)) xnew ynew wnew hnew)))))) | ||