diff options
Diffstat (limited to 'acdwm.scm')
-rwxr-xr-x | acdwm.scm | 110 |
1 files changed, 110 insertions, 0 deletions
diff --git a/acdwm.scm b/acdwm.scm new file mode 100755 index 0000000..fdd8395 --- /dev/null +++ b/acdwm.scm | |||
@@ -0,0 +1,110 @@ | |||
1 | #!/bin/sh | ||
2 | #| -*- scheme -*- | ||
3 | exec csi -ss "$0" "$@" ; acdwm | ||
4 | based on tinywm: https://github.com/mackstann/tinywm/ | ||
5 | |# | ||
6 | |||
7 | (import (chicken bitwise) | ||
8 | (chicken process-context) | ||
9 | (srfi 1) | ||
10 | matchable | ||
11 | xlib) | ||
12 | |||
13 | (define TRUE 1) | ||
14 | (define FALSE 0) | ||
15 | |||
16 | (define dpy (make-parameter #f)) | ||
17 | (define screen (make-parameter #f)) | ||
18 | (define root (make-parameter #f)) | ||
19 | |||
20 | (define (grab-keys) | ||
21 | (xgrabkey (dpy) | ||
22 | (char->integer (xkeysymtokeycode (dpy) (xstringtokeysym "F1"))) | ||
23 | MOD1MASK | ||
24 | (root) | ||
25 | TRUE | ||
26 | GRABMODEASYNC | ||
27 | GRABMODEASYNC) | ||
28 | (xgrabbutton (dpy) | ||
29 | 1 | ||
30 | MOD1MASK | ||
31 | (root) | ||
32 | TRUE | ||
33 | (bitwise-ior BUTTONPRESSMASK | ||
34 | BUTTONRELEASEMASK | ||
35 | POINTERMOTIONMASK) | ||
36 | GRABMODEASYNC | ||
37 | GRABMODEASYNC | ||
38 | NONE | ||
39 | NONE) | ||
40 | (xgrabbutton (dpy) | ||
41 | 3 | ||
42 | MOD1MASK | ||
43 | (root) | ||
44 | TRUE | ||
45 | (bitwise-ior BUTTONPRESSMASK | ||
46 | BUTTONRELEASEMASK | ||
47 | POINTERMOTIONMASK) | ||
48 | GRABMODEASYNC | ||
49 | GRABMODEASYNC | ||
50 | NONE | ||
51 | NONE)) | ||
52 | |||
53 | (define (handle-events) | ||
54 | (let ((event (make-xevent)) | ||
55 | (start (make-xbuttonevent)) | ||
56 | (attrs (make-xwindowattributes))) | ||
57 | (set-xbuttonevent-subwindow! start NONE) | ||
58 | (let loop () | ||
59 | (xnextevent (dpy) event) | ||
60 | (cond | ||
61 | ((and (= KEYPRESS (xevent-type event)) | ||
62 | (not (= NONE (xevent-xkey-subwindow event)))) | ||
63 | (xraisewindow (dpy) (xevent-xkey-subwindow event))) | ||
64 | |||
65 | ((and (= BUTTONPRESS (xevent-type event)) | ||
66 | (not (= NONE (xevent-xbutton-subwindow event)))) | ||
67 | (print "button!") | ||
68 | (xgetwindowattributes (dpy) (xevent-xbutton-subwindow event) attrs) | ||
69 | (set-xbuttonevent-x_root! start (xevent-xbutton-x_root event)) | ||
70 | (set-xbuttonevent-y_root! start (xevent-xbutton-y_root event)) | ||
71 | (set-xbuttonevent-button! start (xevent-xbutton-button event)) | ||
72 | (set-xbuttonevent-subwindow! start (xevent-xbutton-subwindow event))) | ||
73 | |||
74 | ((and (= MOTIONNOTIFY (xevent-type event)) | ||
75 | (not (= NONE (xbuttonevent-subwindow start)))) | ||
76 | (let ((xdiff (- (xevent-xbutton-x_root event) | ||
77 | (xbuttonevent-x_root start))) | ||
78 | (ydiff (- (xevent-xbutton-y_root event) | ||
79 | (xbuttonevent-y_root start))) | ||
80 | (button (xbuttonevent-button start))) | ||
81 | (xmoveresizewindow (dpy) | ||
82 | (xbuttonevent-subwindow start) | ||
83 | (+ (xwindowattributes-x attrs) | ||
84 | (if (= button 1) xdiff 0)) | ||
85 | (+ (xwindowattributes-y attrs) | ||
86 | (if (= button 1) ydiff 0)) | ||
87 | (max 1 (+ (xwindowattributes-width attrs) | ||
88 | (if (= button 3) xdiff 0))) | ||
89 | (max 1 (+ (xwindowattributes-height attrs) | ||
90 | (if (= button 3) ydiff 0)))))) | ||
91 | |||
92 | ((= BUTTONRELEASE (xevent-type event)) | ||
93 | (print "buttonrelease!") | ||
94 | (set-xbuttonevent-subwindow! start NONE))) | ||
95 | |||
96 | ;; Annnd go around again | ||
97 | (loop)))) | ||
98 | |||
99 | (define (main args) | ||
100 | (parameterize ((dpy (xopendisplay #f))) | ||
101 | (assert (dpy)) | ||
102 | (parameterize ((screen (xdefaultscreen (dpy)))) | ||
103 | (parameterize ((root (xrootwindow (dpy) (screen)))) | ||
104 | (grab-keys) | ||
105 | (handle-events))))) | ||
106 | |||
107 | (cond-expand | ||
108 | ((or chicken-script compiling) | ||
109 | (main (command-line-arguments))) | ||
110 | (else)) | ||