Revision: 1.1 - (view) (download)
1 : | ktanaka | 1.1 | ;; --------- ;; |
2 : | ;; main loop ;; | ||
3 : | ;; --------- ;; | ||
4 : | (defun main-loop (disp isend? (win nil)) | ||
5 : | (loop | ||
6 : | (event-case (disp) | ||
7 : | (:exposure | ||
8 : | (event-window count) | ||
9 : | (and (0= count) (handle-exposure event-window)) | ||
10 : | t) | ||
11 : | (:button-press | ||
12 : | (event-window code x y) | ||
13 : | (handle-button-press event-window code x y) | ||
14 : | t) | ||
15 : | (:enter-notify | ||
16 : | (event-window) | ||
17 : | (handle-enter-notify event-window) | ||
18 : | t) | ||
19 : | (:leave-notify | ||
20 : | (event-window) | ||
21 : | (handle-leave-notify event-window) | ||
22 : | t) | ||
23 : | (:motion-notify | ||
24 : | (event-window x y) | ||
25 : | (and (eq event-window win) | ||
26 : | (handle-motion-notify event-window x y)) | ||
27 : | t) | ||
28 : | (otherwise | ||
29 : | t)) | ||
30 : | (cond ((funcall isend?) (exit))))) | ||
31 : | |||
32 : | ;; ---------- ;; | ||
33 : | ;; local loop ;; | ||
34 : | ;; ---------- ;; | ||
35 : | (defun loop-disable-other-win (win isend?) | ||
36 : | (if (not (listp win)) | ||
37 : | (setq win (ncons win))) | ||
38 : | (let ((disp (window-display (car win)))) | ||
39 : | (loop | ||
40 : | (event-case (disp) | ||
41 : | (:exposure | ||
42 : | (event-window count) | ||
43 : | (and (0= count) (handle-exposure event-window)) | ||
44 : | t) | ||
45 : | (:button-press | ||
46 : | (event-window code x y) | ||
47 : | (and (memq event-window win) | ||
48 : | (handle-button-press event-window code x y)) | ||
49 : | t) | ||
50 : | (:button-release | ||
51 : | (event-window code x y) | ||
52 : | (and (memq event-window win) | ||
53 : | (handle-button-release event-window code x y)) | ||
54 : | t) | ||
55 : | (:motion-notify | ||
56 : | (event-window x y) | ||
57 : | (and (memq event-window win) | ||
58 : | (handle-motion-notify event-window x y)) | ||
59 : | t) | ||
60 : | (:enter-notify | ||
61 : | (event-window) | ||
62 : | (and (memq event-window win) | ||
63 : | (handle-enter-notify event-window)) | ||
64 : | t) | ||
65 : | (:leave-notify | ||
66 : | (event-window) | ||
67 : | (and (memq event-window win) | ||
68 : | (handle-leave-notify event-window)) | ||
69 : | t) | ||
70 : | (otherwise | ||
71 : | t)) | ||
72 : | (cond ((funcall isend?) (exit)))))) | ||
73 : |
ktanaka Powered by ViewCVS 1.0-dev |
ViewCVS and CVS Help |