-
-
Notifications
You must be signed in to change notification settings - Fork 24
/
Copy pathREGION
188 lines (141 loc) · 9.41 KB
/
REGION
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
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
(FILECREATED "13-Nov-87 15:59:49" {QV}<HDAVIS>LISP>LYRIC>USERS>REGION.;5 9127
changes to%: (VARS REGIONCOMS) (FNS MAKEREGIONEVENT ENABLE-WINDOW DISABLE-WINDOW REMOVEREGIONEVENT ADDREGIONEVENT)
(VARIABLES DISABLEDFLG) (PROPS (REGION MAKEFILE-ENVIRONMENT))
previous date%: "12-Nov-87 18:11:28" {QV}<HDAVIS>LISP>LYRIC>USERS>REGION.;4)
(* "
Copyright (c) 1987 by Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT REGIONCOMS)
(RPAQQ REGIONCOMS ((RECORDS REGIONEVENT) (FNS ADDREGIONEVENT DISABLE-WINDOW DISABLED-WINDOW? ENABLE-WINDOW MAKEREGIONEVENT MOUSE-POSITION MOUSE-REGIONS REGIONEVENTFN REGIONINFN REGIONMOVEDFN REGIONOUTFN REGIONREPAINTFN REMOVEREGIONEVENT SET-REGIONS SETUP-FOR-REGIONS UPDATE-MOUSE-IN-WINDOW) (GLOBALVARS DISABLEDFLG) (PROP MAKEFILE-ENVIRONMENT REGION) (VARIABLES DISABLEDFLG))
)
(DECLARE%: EVAL@COMPILE
(RECORD REGIONEVENT (EVENTREGION REGIONBUTTONFN REGIONMOVEDFN REGIONINFN REGIONOUTFN REGIONREPAINTFN DATA)
)
)
(DEFINEQ
(ADDREGIONEVENT
[LAMBDA (Window RegionEvent) (* ; "Edited 12-Nov-87 18:07 by hed")
(WINDOWADDPROP Window 'REGIONEVENTLST RegionEvent T])
(DISABLE-WINDOW
[LAMBDA (Window) (* ; "Edited 12-Nov-87 18:10 by hed")
(if (EQ DISABLEDFLG T)
then NIL
elseif (NULL DISABLEDFLG)
then (SETQ DISABLEDFLG (LIST Window))
elseif (WINDOWP DISABLEDFLG)
then (SETQ DISABLEDFLG (LIST Window DISABLEDFLG))
elseif (NLISTP DISABLEDFLG)
then (SETQ DISABLEDFLG (LIST Window))
else (CL:PUSHNEW Window DISABLEDFLG])
(DISABLED-WINDOW?
[LAMBDA (Window) (* ; "Edited 10-Nov-87 19:33 by hed")
(OR (EQ DISABLEFLG T)
(EQ DISABLEFLG Window)
(AND (LISTP DISABLEFLG)
(FMEMB Window DISABLEFLG])
(ENABLE-WINDOW
[LAMBDA (Window) (* ; "Edited 12-Nov-87 18:07 by hed")
(if (EQ DISABLEDFLG Window)
then (SETQ DISABLEDFLG NIL)
elseif (LISTP DISABLEDFLG)
then (DREMOVE Window DISABLEDFLG)
else (ERROR "Can't enable just one window when DISABLEDFLG is T."])
(MAKEREGIONEVENT
(LAMBDA (EventRegion Data ButtonFn MovedFn InFn OutFn RepaintFn) (* ; "Edited 13-Nov-87 15:56 by hed") (create REGIONEVENT EVENTREGION _ EventRegion REGIONBUTTONFN _ ButtonFn REGIONMOVEDFN _ MovedFn REGIONINFN _ InFn REGIONOUTFN _ OutFn REGIONREPAINTFN _ RepaintFn DATA _ Data))
)
(MOUSE-POSITION
[LAMBDA (Window) (* ; "Edited 10-Nov-87 19:25 by hed")
(create POSITION (XCOORD _ (WINDOWPROP Window 'LASTMOUSEX))
(YCOORD _ (WINDOWPROP Window 'LASTMOUSEY])
(MOUSE-REGIONS
[LAMBDA (Window) (* ; "Edited 11-Nov-87 11:22 by hed")
(for Reg in (WINDOWPROP Window 'REGIONEVENTLST) collect Reg
when (INSIDEP (fetch EVENTREGION of Reg)
(WINDOWPROP Window 'LASTMOUSEX)
(WINDOWPROP Window 'LASTMOUSEY])
(REGIONEVENTFN
[LAMBDA (Window) (* ; "Edited 11-Nov-87 11:39 by hed")
(* ;; " Called whenever a mouse button is changed in a regionized window. Calls the REGIONBUTTONFN of every region the mouse is in.")
(if (NOT (DISABLED-WINDOW? Window))
then (for Reg in (MOUSE-REGIONS Window) bind FN
do (if (SETQ FN (fetch REGIONBUTTONFN of Reg))
then (APPLY* FN Window (MOUSE-POSITION Window])
(REGIONINFN
[LAMBDA (Window) (* ; "Edited 11-Nov-87 11:34 by hed")
(* ;; "Called whenever the cursor moves into a regionized window. Calls the CURSORINFN of every region which the cursor is now in.")
(UPDATE-MOUSE-IN-WINDOW Window)
(if (NOT (DISABLED-WINDOW? Window))
then (for Reg in (MOUSE-REGIONS Window) bind FN
do (if (SETQ FN (fetch REGIONINFN of Reg))
then (APPLY* FN Window Reg])
(REGIONMOVEDFN
[LAMBDA (Window) (* ; "Edited 11-Nov-87 11:37 by hed")
(* ;; " Called whenever the mouse moves within a regionized window. Calls the REGIONOUTFN of any regions the mouse has left, the REGIONINFN of any regions the mouse has now entered, and the REGIONMOVEDFN of any regions the mouse has moved around in. Also updates the LASTMOUSEX and LASTMOUSEY window properties for the next time.")
(LET ((OldActives (MOUSE-REGIONS Window))
NewActives)
(UPDATE-MOUSE-IN-WINDOW Window)
(if (NOT (DISABLED-WINDOW? Window))
then (SETQ NewActives (MOUSE-REGIONS Window))
[for Reg in (INTERSECTION OldActives NewActives) bind FN
do (if (SETQ FN (fetch REGIONMOVEDFN of Reg))
then (APPLY* FN Window (MOUSE-POSITION Window]
(for Reg in (LDIFFERENCE OldActives NewActives) bind FN
do (if (SETQ FN (fetch REGIONOUTFN of Reg))
then (APPLY* FN Window Reg)))
(for Reg in (LDIFFERENCE NewActives OldActives) bind FN
do (if (SETQ FN (fetch REGIONINFN of Reg))
then (APPLY* FN Window Reg])
(REGIONOUTFN
[LAMBDA (Window) (* ; "Edited 11-Nov-87 11:36 by hed")
(* ;; "Called whenever the mouse leaves a regionized window. Calls the CURSOROUTFN of every region the mouse was in. The mouse's position within the window is cached on the window properties LASTMOUSEX and LASTMOUSEY, updated by REGIONINFN and REGIONMOVEDFN, so we can tell where the mouse was before leaving.")
[if (NOT (DISABLED-WINDOW? Window))
then (for Reg in (MOUSE-REGIONS Window) bind FN
do (if (SETQ FN (fetch REGIONOUTFN of Reg))
then (APPLY* FN Window Reg]
(UPDATE-MOUSE-IN-WINDOW Window) (* ;
"Will put some negative numbers in there, but that's OK.")
])
(REGIONREPAINTFN
[LAMBDA (Window RepaintRegion) (* ; "Edited 11-Nov-87 11:41 by hed")
(* ;; "Called whenever a regionized window is repainted. Calls the REGIONREPAINTFN of every region intersecting the RepaintRegion.")
(if (NOT (DISABLED-WINDOW? Window))
then (for Reg in (WINDOWPROP Window 'REGIONEVENTLST) bind FN
do (if (SETQ FN (fetch REGIONREPAINTFN of Reg))
then (APPLY* FN Window Reg)) when (REGIONSINTERSECTP RepaintRegion
(fetch EVENTREGION of Reg])
(REMOVEREGIONEVENT
[LAMBDA (Window RegionEvent) (* ; "Edited 12-Nov-87 18:07 by hed")
(WINDOWDELPROP Window 'REGIONEVENTLST RegionEvent])
(SET-REGIONS
[LAMBDA (Window RegionEvents) (* ; "Edited 11-Nov-87 11:08 by hed")
(WINDOWPROP Window 'REGIONEVENTLST RegionEvents)
(SETUP-FOR-REGIONS Window)
(UPDATE-MOUSE-IN-WINDOW Window])
(SETUP-FOR-REGIONS
[LAMBDA (Window) (* ; "Edited 10-Nov-87 19:32 by hed")
(WINDOWPROP Window 'CURSORINFN (FUNCTION REGIONINFN))
(WINDOWPROP Window 'CURSOROUTFN (FUNCTION REGIONOUTFN))
(WINDOWPROP Window 'REPAINTFN (FUNCTION REGIONREPAINTFN))
(WINDOWPROP Window 'CURSORMOVEDFN (FUNCTION REGIONMOVEDFN))
(WINDOWPROP Window 'BUTTONEVENTFN (FUNCTION REGIONEVENTFN])
(UPDATE-MOUSE-IN-WINDOW
[LAMBDA (Window) (* ; "Edited 11-Nov-87 10:59 by hed")
(* ;; "Updates LASTMOUSEX and LASTMOUSEY properties of Window with latest mouse location in window co-ordinates.")
(LET [(WinReg (WINDOWPROP Window 'REGION]
(WINDOWPROP Window 'LASTMOUSEX (LASTMOUSEX Window))
(WINDOWPROP Window 'LASTMOUSEY (LASTMOUSEX Window])
)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS DISABLEDFLG)
)
(PUTPROPS REGION MAKEFILE-ENVIRONMENT (:READTABLE "INTERLISP" :PACKAGE "INTERLISP"))
(CL:DEFVAR DISABLEDFLG NIL "NIL -> REGIONs is running for all windows; T -> REGIONs is off for all windows; Window or list of windows -> REGIONs is disabled for the specified windows.")
(PUTPROPS REGION COPYRIGHT ("Xerox Corporation" 1987))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1045 8710 (ADDREGIONEVENT 1055 . 1240) (DISABLE-WINDOW 1242 . 1744) (DISABLED-WINDOW?
1746 . 2004) (ENABLE-WINDOW 2006 . 2369) (MAKEREGIONEVENT 2371 . 2672) (MOUSE-POSITION 2674 . 2923) (
MOUSE-REGIONS 2925 . 3290) (REGIONEVENTFN 3292 . 3843) (REGIONINFN 3845 . 4406) (REGIONMOVEDFN 4408 .
5821) (REGIONOUTFN 5823 . 6713) (REGIONREPAINTFN 6715 . 7396) (REMOVEREGIONEVENT 7398 . 7584) (
SET-REGIONS 7586 . 7839) (SETUP-FOR-REGIONS 7841 . 8279) (UPDATE-MOUSE-IN-WINDOW 8281 . 8708)))))
STOP