-
-
Notifications
You must be signed in to change notification settings - Fork 24
/
Copy pathKEYOBJ
302 lines (259 loc) · 11 KB
/
KEYOBJ
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
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
(FILECREATED "19-Nov-85 12:22:23" {ERIS}<IRIS>GREGCO>KEYOBJ.;3 10904
changes to: (FNS KEYOBJ.BUTTONEVENTINFN KEYOBJ.CREATE)
previous date: "28-Jan-85 01:34:31" {ERIS}<LISP>KOTO>LISPUSERS>KEYOBJ.;1)
(* Copyright (c) 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT KEYOBJCOMS)
(RPAQQ KEYOBJCOMS ((FNS KEYOBJ.BUTTONEVENTINFN KEYOBJ.COPYFN KEYOBJ.CREATE KEYOBJ.DISPLAYFN
KEYOBJ.GETFN KEYOBJ.IMAGEBOXFN KEYOBJ.IMAGESTREAMTYPE KEYOBJ.INSTALL.BITMAP
KEYOBJ.PUTFN KEYOBJ.WHENOPERATEDONFN TYPEA)
[VARS (KEYOBJ.IMAGEFNS (IMAGEFNSCREATE (FUNCTION KEYOBJ.DISPLAYFN)
(FUNCTION KEYOBJ.IMAGEBOXFN)
(FUNCTION KEYOBJ.PUTFN)
(FUNCTION KEYOBJ.GETFN)
(FUNCTION KEYOBJ.COPYFN)
(FUNCTION KEYOBJ.BUTTONEVENTINFN)
(FUNCTION NILL)
(FUNCTION NILL)
(FUNCTION NILL)
(FUNCTION NILL)
(FUNCTION NILL)
(FUNCTION NILL)
(FUNCTION NILL]
(INITVARS (KEYOBJ.FONT (FONTCREATE (QUOTE HELVETICA)
10)))
(BITMAPS KEYOBJ.TEMPLATE)))
(DEFINEQ
(KEYOBJ.BUTTONEVENTINFN
[LAMBDA (KEYOBJ WINDOWSTREAM SEL RELX RELY WINDOW TEXTSTREAM BUTTON)
(* gbn "19-Nov-85 12:21")
(* * gets called when the "key" goes down. sends the down transition, inverts the bitmap of the key, when the mouse
comes up, uninverts the picture and sends the up transition)
(* * NOTE: inside buttoneventinfn's the origin is the left bottom of the imageobj)
(PROG ((KEYNUMBER (IMAGEOBJPROP KEYOBJ (QUOTE KEYNUMBER)))
(ABORTABLE (IMAGEOBJPROP KEYOBJ (QUOTE ABORTABLE)))
(IMAGEBOX (IMAGEOBJPROP KEYOBJ (QUOTE IMAGEBOX)))
X Y)
(IMAGEOBJPROP KEYOBJ (QUOTE STATE)
(QUOTE DOWN))
(IMAGEOBJPROP KEYOBJ (QUOTE WINDOW)
(fetch \WINDOW of (TEXTOBJ TEXTSTREAM)))
(KEYOBJ.DISPLAYFN KEYOBJ WINDOWSTREAM NIL NIL T)
(if ABORTABLE
then (* since this is an abortable key don't send any
transitions until the key comes up)
NIL
else (* send the down transition)
(\DECODETRANSITION KEYNUMBER T))
(while (MOUSESTATE (OR LEFT MIDDLE RIGHT)) do NIL)
(IMAGEOBJPROP KEYOBJ (QUOTE STATE)
(QUOTE UP))
(KEYOBJ.DISPLAYFN KEYOBJ WINDOWSTREAM NIL NIL T)
(SETQ X (LASTMOUSEX WINDOW))
(SETQ Y (LASTMOUSEY WINDOW))
(if (AND (ILEQ X (fetch XSIZE of IMAGEBOX))
(IGEQ X 0)
(ILEQ Y (fetch YSIZE of IMAGEBOX))
(IGEQ Y 0))
then
(* only send the transition if the mouse is still in the region. This is not consistent with the key metaphor,
however, the menu functionality is useful)
(if ABORTABLE
then (* now send the saved down transition)
(\DECODETRANSITION KEYNUMBER T))
(\DECODETRANSITION KEYNUMBER))
(RETURN (QUOTE DON'T])
(KEYOBJ.COPYFN
[LAMBDA (IMAGEOBJ FROMSTREAM TOSTREAM) (* jds "10-Jan-85 01:03")
(* * shouldn't be called)
(* (SHOULDNT "why are you copying a keyobj?"))
(KEYOBJ.CREATE (IMAGEOBJPROP IMAGEOBJ (QUOTE KEYNAME))
TOSTREAM])
(KEYOBJ.CREATE
[LAMBDA (KEYNAME KEYLABEL ABORTABLE) (* gbn "19-Nov-85 12:05")
(PROG ((KEYOBJ (IMAGEOBJCREATE NIL KEYOBJ.IMAGEFNS))
BITMAP
(KEYLABEL (OR KEYLABEL KEYNAME))
DS)
(IMAGEOBJPROP KEYOBJ (QUOTE STATE)
(QUOTE UP))
(IMAGEOBJPROP KEYOBJ (QUOTE KEYNUMBER)
(\KEYNAMETONUMBER KEYNAME))
(IMAGEOBJPROP KEYOBJ (QUOTE KEYNAME)
KEYNAME)
(IMAGEOBJPROP KEYOBJ (QUOTE KEYLABEL)
KEYLABEL)
(IMAGEOBJPROP KEYOBJ (QUOTE ABORTABLE)
ABORTABLE)
(KEYOBJ.INSTALL.BITMAP KEYOBJ)
(SETQ BITMAP (IMAGEOBJPROP KEYOBJ (QUOTE BITMAP)))
(IMAGEOBJPROP KEYOBJ (QUOTE IMAGEBOX)
(create IMAGEBOX
XSIZE _(BITMAPWIDTH BITMAP)
YSIZE _(BITMAPHEIGHT BITMAP)
YDESC _ 0
XKERN _ 0))
(RETURN KEYOBJ])
(KEYOBJ.DISPLAYFN
[LAMBDA (KEYOBJ IMAGE.STREAM MODE TEXTSTREAM OFFSETS0?) (* jds "10-Jan-85 01:02")
(* function which displays the bitmap of the hrule on
the display or calls an {inter}press function to draw
the rule on a file)
(PROG [[SOURCETYPE (SELECTQ (IMAGEOBJPROP KEYOBJ (QUOTE STATE))
(UP (QUOTE INPUT))
(DOWN (QUOTE INVERT))
(ERROR "Illegal state in KEYOBJ" (IMAGEOBJPROP KEYOBJ (QUOTE STATE]
(BITMAP (IMAGEOBJPROP KEYOBJ (QUOTE BITMAP] (* (IMAGE.STREAM (IMAGEOBJPROP KEYOBJ
(QUOTE WINDOW))))
(SELECTQ (IMAGESTREAMTYPE IMAGE.STREAM)
[DISPLAY
(* (PROMPTPRINT (CONCAT (IMAGEOBJPROP KEYOBJ (QUOTE STATE)) "CLIP " (DSPCLIPPINGREGION NIL IMAGE.STREAM) " OFFSETS"
(DSPXOFFSET NIL IMAGE.STREAM) " " (DSPYOFFSET NIL IMAGE.STREAM) " X AND Y POS " (DSPXPOSITION NIL IMAGE.STREAM) " "
(DSPYPOSITION NIL IMAGE.STREAM))) (INVERTW IMAGE.STREAM))
(if OFFSETS0?
then (BITBLT BITMAP NIL NIL IMAGE.STREAM 0 0 NIL NIL SOURCETYPE
(QUOTE REPLACE))
else (BITBLT BITMAP NIL NIL IMAGE.STREAM (DSPXPOSITION NIL IMAGE.STREAM)
(DSPYPOSITION NIL IMAGE.STREAM)
NIL NIL SOURCETYPE (QUOTE REPLACE]
(ERROR "NO OTHER STREAMS DEFINED FOR KEYOBJ.DISPLAYFN"])
(KEYOBJ.GETFN
[LAMBDA (INPUT.STREAM TEXTSTREAM) (* gbn "27-Jan-85 23:36")
(* * just reads the keyname and calls keyobj.create)
(KEYOBJ.CREATE (READ INPUT.STREAM)
(READ INPUT.STREAM])
(KEYOBJ.IMAGEBOXFN
[LAMBDA (KEYOBJ IMAGE.STREAM CURRENT.X RIGHT.MARGIN) (* gbn " 9-Jan-85 21:35")
(* * since all keyobjs have constant dimensions, they are cached as the imagebox prop)
(IMAGEOBJPROP KEYOBJ (QUOTE IMAGEBOX])
(KEYOBJ.IMAGESTREAMTYPE
[LAMBDA (STREAM) (* gbn "13-May-84 12:38")
(* hack until imagestreamtype works)
(if (STKPOS (QUOTE TEDIT.HARDCOPY))
then (QUOTE INTERPRESS)
else (QUOTE DISPLAY])
(KEYOBJ.INSTALL.BITMAP
(LAMBDA (KEYOBJ) (* edited: "18-Jan-85 18:52")
(* * Takes an imageobj and installs the image according to the size and label on the props)
(PROG ((BITMAP (BITMAPCOPY KEYOBJ.TEMPLATE))
(KEYLABEL (IMAGEOBJPROP KEYOBJ (QUOTE KEYLABEL)))
DS QUARTER)
(SETQ DS (DSPCREATE BITMAP))
(DSPFONT KEYOBJ.FONT DS)
(if (LISTP KEYLABEL)
then (* this is supposed to have two labels, one on top of
the other)
(SETQ QUARTER (IQUOTIENT (BITMAPHEIGHT BITMAP)
4))
(CENTERPRINTINREGION (CADR KEYLABEL)
(SETQ REGION
(create REGION
LEFT _ 0
BOTTOM _ QUARTER
WIDTH _ (BITMAPWIDTH BITMAP)
HEIGHT _ QUARTER))
DS)
(replace BOTTOM of REGION with (ITIMES 2 QUARTER))
(CENTERPRINTINREGION (CAR KEYLABEL)
REGION DS)
else (CENTERPRINTINREGION KEYLABEL (create REGION
LEFT _ 0
BOTTOM _ 0
WIDTH _ (BITMAPWIDTH BITMAP)
HEIGHT _ (BITMAPHEIGHT BITMAP))
DS))
(CLOSEF DS)
(IMAGEOBJPROP KEYOBJ (QUOTE BITMAP)
BITMAP)
(RETURN KEYOBJ))))
(KEYOBJ.PUTFN
[LAMBDA (KEYOBJ OUTPUT.STREAM) (* gbn "27-Jan-85 23:35")
(* prints only the rule.width to the file, the rest can
be discovered)
(PRINT (IMAGEOBJPROP KEYOBJ (QUOTE KEYNAME))
OUTPUT.STREAM)
(PRINT (IMAGEOBJPROP KEYOBJ (QUOTE KEYLABEL))
OUTPUT.STREAM])
(KEYOBJ.WHENOPERATEDONFN
[LAMBDA (A B C C) (* gbn " 6-Jan-85 13:23")
(* DUMMY)
])
(TYPEA
[LAMBDA NIL (* gbn " 9-Jan-85 21:09")
(* fakes typing an A)
(\DT 46 T)
(\DT 46 NIL])
)
(RPAQ KEYOBJ.IMAGEFNS (IMAGEFNSCREATE (FUNCTION KEYOBJ.DISPLAYFN)
(FUNCTION KEYOBJ.IMAGEBOXFN)
(FUNCTION KEYOBJ.PUTFN)
(FUNCTION KEYOBJ.GETFN)
(FUNCTION KEYOBJ.COPYFN)
(FUNCTION KEYOBJ.BUTTONEVENTINFN)
(FUNCTION NILL)
(FUNCTION NILL)
(FUNCTION NILL)
(FUNCTION NILL)
(FUNCTION NILL)
(FUNCTION NILL)
(FUNCTION NILL)))
(RPAQ? KEYOBJ.FONT (FONTCREATE (QUOTE HELVETICA)
10))
(RPAQ KEYOBJ.TEMPLATE (READBITMAP))
(80 50
"OOOOOOOOOOOOOOOOOOOO"
"OOOOOOOOOOOOOOOOOOOO"
"OO@@@@@@@@@@@@@@@@OO"
"OH@@@@@@@@@@@@@@@@AO"
"OH@@@@@@@@@@@@@@@@AO"
"NL@@@@@@@@@@@@@@@@BG"
"OFCOOOOOOOOOOOOOOLDG"
"NKF@@@@@@@@@@@@@@FHG"
"MEH@@@@@@@@@@@@@@A@C"
"NK@@@@@@@@@@@@@@@@HC"
"MG@@@@@@@@@@@@@@@@LC"
"NJ@@@@@@@@@@@@@@@@DC"
"MF@@@@@@@@@@@@@@@@DC"
"NJ@@@@@@@@@@@@@@@@DC"
"MF@@@@@@@@@@@@@@@@DC"
"NJ@@@@@@@@@@@@@@@@DC"
"MF@@@@@@@@@@@@@@@@DC"
"NJ@@@@@@@@@@@@@@@@DC"
"MF@@@@@@@@@@@@@@@@DC"
"NJ@@@@@@@@@@@@@@@@DC"
"MF@@@@@@@@@@@@@@@@DC"
"NJ@@@@@@@@@@@@@@@@DC"
"MF@@@@@@@@@@@@@@@@DC"
"NJ@@@@@@@@@@@@@@@@DC"
"MF@@@@@@@@@@@@@@@@DC"
"NJ@@@@@@@@@@@@@@@@DC"
"MF@@@@@@@@@@@@@@@@DC"
"NJ@@@@@@@@@@@@@@@@DC"
"MF@@@@@@@@@@@@@@@@DC"
"NJ@@@@@@@@@@@@@@@@DC"
"MF@@@@@@@@@@@@@@@@DC"
"NJ@@@@@@@@@@@@@@@@DC"
"MF@@@@@@@@@@@@@@@@DC"
"NJ@@@@@@@@@@@@@@@@DC"
"MF@@@@@@@@@@@@@@@@DC"
"NJ@@@@@@@@@@@@@@@@DC"
"MF@@@@@@@@@@@@@@@@DC"
"NJ@@@@@@@@@@@@@@@@DC"
"MF@@@@@@@@@@@@@@@@DC"
"NK@@@@@@@@@@@@@@@@LC"
"ME@@@@@@@@@@@@@@@@HC"
"NKH@@@@@@@@@@@@@@A@C"
"OBN@@@@@@@@@@@@@@GHG"
"NDKOOOOOOOOOOOOOONLG"
"OIAEEEEEEEEEEEEEEEFG"
"OBBJJJJJJJJJJJJJJJKO"
"OLEEEEEEEEEEEEEEEEEO"
"ONBJJJJJJJJJJJJJJJOO"
"OOOOOOOOOOOOOOOOOOOO"
"OOOOOOOOOOOOOOOOOOOO")
(PUTPROPS KEYOBJ COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1109 9187 (KEYOBJ.BUTTONEVENTINFN 1119 . 3259) (KEYOBJ.COPYFN 3261 . 3611) (
KEYOBJ.CREATE 3613 . 4559) (KEYOBJ.DISPLAYFN 4561 . 6043) (KEYOBJ.GETFN 6045 . 6300) (
KEYOBJ.IMAGEBOXFN 6302 . 6570) (KEYOBJ.IMAGESTREAMTYPE 6572 . 6913) (KEYOBJ.INSTALL.BITMAP 6915 . 8327
) (KEYOBJ.PUTFN 8329 . 8751) (KEYOBJ.WHENOPERATEDONFN 8753 . 8954) (TYPEA 8956 . 9185)))))
STOP