|
|
1.1 root 1: % Copyright Barbara Liskov 1985, 1986
2:
3: x_window = cluster is none, create, create_transparency,
4: destroy, destroy_subwindows, map, map_subwindows,
5: unmap, unmap_subwindows, unmap_transparent, raise, lower,
6: circulate_up, circulate_down, move, change, configure,
7: set_background, set_border, set_tilemode, set_clipmode,
8: query, query_tree, get_name, set_name, set_icon,
9: get_resize, set_resize, set_cursor, set_input,
10: grab_mouse, ungrab_mouse, grab_button, ungrab_button,
11: query_mouse, interpret_locator,
12: warp_mouse, cond_warp_mouse,
13: focus_keyboard, clear, pix_set, pix_fill, tile_set,
14: tile_fill, pixmap_put, pixmap_xybitsput, pixmap_zbitsput,
15: bitmap_bitsput, move_area, copy_area,
16: text, textv, texta, text_pad, textv_pad, texta_pad,
17: text_mask, textv_mask, texta_mask,
18: text_mask_pad, textv_mask_pad, texta_mask_pad,
19: line, draw,
20: draw_dashed, draw_patterned, draw_filled, draw_tiled,
21: save_region, read_xyregion, read_zregion,
22: get_id, equal, similar, copy
23:
24: rep = int
25:
26: none = proc () returns (cvt)
27: return(0)
28: end none
29:
30: create = proc (x, y, width, height: int, background: x_pixmap, parent: cvt,
31: borderwidth: int, border: x_pixmap) returns (cvt)
32: signals (error(string))
33: x_buf$setup(x_createwindow, borderwidth, 0, parent)
34: x_buf$set_s0123(height, width, x, y)
35: x_buf$set_l23(border.id, background.id)
36: x_buf$receive()
37: resignal error
38: return(x_buf$get_lp0())
39: end create
40:
41: create_transparency = proc (x, y, width, height: int, parent: cvt) returns (cvt)
42: signals (error(string))
43: x_buf$setup(x_createtransparency, 0, 0, parent)
44: x_buf$set_s0123(height, width, x, y)
45: x_buf$receive()
46: resignal error
47: return(x_buf$get_lp0())
48: end create_transparency
49:
50: destroy = proc (w: cvt)
51: x_buf$setup(x_destroywindow, 0, 0, w)
52: end destroy
53:
54: destroy_subwindows = proc (w: cvt)
55: x_buf$setup(x_destroysubwindows, 0, 0, w)
56: end destroy_subwindows
57:
58: map = proc (w: cvt)
59: x_buf$setup(x_mapwindow, 0, 0, w)
60: end map
61:
62: map_subwindows = proc (w: cvt)
63: x_buf$setup(x_mapsubwindows, 0, 0, w)
64: end map_subwindows
65:
66: unmap = proc (w: cvt)
67: x_buf$setup(x_unmapwindow, 0, 0, w)
68: end unmap
69:
70: unmap_subwindows = proc (w: cvt)
71: x_buf$setup(x_unmapsubwindows, 0, 0, w)
72: end unmap_subwindows
73:
74: unmap_transparent = proc (w: cvt)
75: x_buf$setup(x_unmaptransparent, 0, 0, w)
76: end unmap_transparent
77:
78: raise = proc (w: cvt)
79: x_buf$setup(x_raisewindow, 0, 0, w)
80: end raise
81:
82: lower = proc (w: cvt)
83: x_buf$setup(x_lowerwindow, 0, 0, w)
84: end lower
85:
86: circulate_up = proc (w: cvt)
87: x_buf$setup(x_circwindowup, 0, 0, w)
88: end circulate_up
89:
90: circulate_down = proc (w: cvt)
91: x_buf$setup(x_circwindowdown, 0, 0, w)
92: end circulate_down
93:
94: move = proc (w: cvt, x, y: int)
95: x_buf$setup(x_movewindow, 0, 0, w)
96: x_buf$set_s01(x, y)
97: end move
98:
99: change = proc (w: cvt, width, height: int)
100: x_buf$setup(x_changewindow, 0, 0, w)
101: x_buf$set_s01(height, width)
102: end change
103:
104: configure = proc (w: cvt, x, y, width, height: int)
105: x_buf$setup(x_configurewindow, 0, 0, w)
106: x_buf$set_s0123(height, width, x, y)
107: end configure
108:
109: set_background = proc (w: cvt, background: x_pixmap)
110: x_buf$setup(x_changebackground, 0, 0, w)
111: x_buf$set_l0(p2i(background))
112: end set_background
113:
114: set_border = proc (w: cvt, border: x_pixmap)
115: x_buf$setup(x_changeborder, 0, 0, w)
116: x_buf$set_l0(p2i(border))
117: end set_border
118:
119: set_tilemode = proc (w: cvt, relative: bool)
120: if relative
121: then x_buf$setup(x_tilemode, TileModeRelative, 0, w)
122: else x_buf$setup(x_tilemode, TileModeAbsolute, 0, w)
123: end
124: end set_tilemode
125:
126: set_clipmode = proc (w: cvt, drawthru: bool)
127: if drawthru
128: then x_buf$setup(x_clipmode, ClipModeDrawThru, 0, w)
129: else x_buf$setup(x_clipmode, ClipModeClipped, 0, w)
130: end
131: end set_clipmode
132:
133: % returns (x, y, width, height, border, map, kind, icon)
134:
135: query = proc (w: cvt) returns (int, int, int, int, int, int, int, cvt)
136: signals (error(string))
137: x_buf$setup(x_querywindow, 0, 0, w)
138: x_buf$receive()
139: resignal error
140: return(x_buf$get_sp2(), x_buf$get_sp3(), x_buf$get_sp1(), x_buf$get_sp0(),
141: x_buf$get_sp4(), x_buf$get_bp10(), x_buf$get_bp11(),
142: x_buf$get_lp3())
143: end query
144:
145: query_tree = proc (w: cvt) returns (cvt, wlist) signals (error(string))
146: wlist = array[x_window]
147: x_buf$setup(x_querytree, 0, 0, w)
148: x_buf$receive()
149: resignal error
150: parent: int := x_buf$get_lp0()
151: n: int := x_buf$get_lp1()
152: subs: wlist := wlist$fill(1, n, up(parent))
153: if n > 0
154: then b: _bytevec := _bytevec$create(n * 4)
155: x_buf$receive_data(b)
156: for i: int in int$from_to(1, n) do
157: subs[i] := up(b2w(b)[i])
158: end
159: end
160: return(parent, subs)
161: end query_tree
162:
163: get_name = proc (w: cvt) returns (string) signals (error(string))
164: x_buf$setup(x_fetchname, 0, 0, w)
165: x_buf$receive()
166: resignal error
167: n: int := x_buf$get_sp0()
168: if n = 0
169: then return("") end
170: b: _bytevec := _bytevec$create(n)
171: x_buf$receive_data(b)
172: return(b2s(b))
173: end get_name
174:
175: set_name = proc (w: cvt, n: string)
176: x_buf$setup(x_storename, 0, 0, w)
177: x_buf$set_s0(string$size(n))
178: x_buf$send_data(s2b(n), 1, string$size(n))
179: end set_name
180:
181: set_icon = proc (w, icon: cvt)
182: x_buf$setup(x_seticonwindow, 0, 0, w)
183: x_buf$set_l0(icon)
184: end set_icon
185:
186: get_resize = proc (w: cvt) returns (int, int, int, int) signals (error(string))
187: x_buf$setup(x_getresizehint, 0, 0, w)
188: x_buf$receive()
189: resignal error
190: return(x_buf$get_sp2(), x_buf$get_sp3(), x_buf$get_sp0(), x_buf$get_sp1())
191: end get_resize
192:
193: set_resize = proc (w: cvt, width0, widthinc, height0, heightinc: int)
194: x_buf$setup(x_setresizehint, 0, 0, w)
195: x_buf$set_s0123(height0, heightinc, width0, widthinc)
196: end set_resize
197:
198: set_cursor = proc (w: cvt, cursor: x_cursor)
199: x_buf$setup(x_definecursor, 0, 0, w)
200: x_buf$set_l0(c2i(cursor))
201: end set_cursor
202:
203: set_input = proc (w: cvt, mask: int)
204: x_buf$setup(x_selectinput, 0, 0, w)
205: x_buf$set_l0(mask)
206: end set_input
207:
208: grab_mouse = proc (w: cvt, mask: int, cursor: x_cursor) signals (error(string))
209: x_buf$setup(x_grabmouse, 0, 0, w)
210: x_buf$set_l01(c2i(cursor), mask)
211: x_buf$receive()
212: resignal error
213: end grab_mouse
214:
215: ungrab_mouse = proc ()
216: x_buf$setup(x_ungrabmouse, 0, 0, 0)
217: end ungrab_mouse
218:
219: grab_button = proc (w: cvt, button, mask: int, cursor: x_cursor)
220: signals (error(string))
221: x_buf$setup(x_grabbutton, 0, button, w)
222: x_buf$set_l01(c2i(cursor), mask)
223: x_buf$receive()
224: resignal error
225: end grab_button
226:
227: ungrab_button = proc (button: int)
228: x_buf$setup(x_ungrabmouse, 0, button, 0)
229: end ungrab_button
230:
231: % returns (x, y, window)
232:
233: query_mouse = proc (w: cvt) returns (int, int, cvt) signals (error(string))
234: x_buf$setup(x_querymouse, 0, 0, w)
235: x_buf$receive()
236: resignal error
237: return(x_buf$get_sp2(), x_buf$get_sp3(), x_buf$get_lp0())
238: end query_mouse
239:
240: interpret_locator = proc (w: cvt, x, y: int) returns (int, int, cvt)
241: signals (error(string))
242: x_buf$setup(x_interpretlocator, 0, 0, w)
243: x_buf$set_s01(x, y)
244: x_buf$receive()
245: resignal error
246: return(x_buf$get_sp2(), x_buf$get_sp3(), x_buf$get_lp0())
247: end interpret_locator
248:
249: warp_mouse = proc (w: cvt, x, y: int)
250: x_buf$setup(x_warpmouse, 0, 0, w)
251: x_buf$set_s01l1(x, y, down(x_display$root()))
252: x_buf$set_s4567(0, 0, 0, 0)
253: end warp_mouse
254:
255: cond_warp_mouse = proc (dstw: cvt, dstx, dsty: int, srcw: cvt,
256: srcx, srcy, srcwidth, srcheight: int)
257: x_buf$setup(x_warpmouse, 0, 0, dstw)
258: x_buf$set_s01l1(dstx, dsty, srcw)
259: x_buf$set_s4567(srcheight, srcwidth, srcx, srcy)
260: end cond_warp_mouse
261:
262: focus_keyboard = proc (w: cvt)
263: x_buf$setup(x_focuskeyboard, 0, 0, w)
264: end focus_keyboard
265:
266: clear = proc (w: cvt)
267: x_buf$setup(x_clear, 0, 0, w)
268: end clear
269:
270: pix_set = proc (w: cvt, pixel, x, y, width, height: int)
271: x_buf$setup(x_pixfill, GXcopy, -1, w)
272: x_buf$set_s0123(height, width, x, y)
273: x_buf$set_s45l3(pixel, 0, 0)
274: end pix_set
275:
276: pix_fill = proc (w: cvt, pixel: int, mask: x_bitmap, x, y, width, height: int,
277: func, planes: int)
278: x_buf$setup(x_pixfill, func, planes, w)
279: x_buf$set_s0123(height, width, x, y)
280: x_buf$set_s45l3(pixel, 0, b2i(mask))
281: end pix_fill
282:
283: tile_set = proc (w: cvt, tile: x_pixmap, x, y, width, height: int)
284: x_buf$setup(x_tilefill, GXcopy, -1, w)
285: x_buf$set_s0123(height, width, x, y)
286: x_buf$set_l23(p2i(tile), 0)
287: end tile_set
288:
289: tile_fill = proc (w: cvt, tile: x_pixmap, mask: x_bitmap,
290: x, y, width, height, func, planes: int)
291: x_buf$setup(x_tilefill, func, planes, w)
292: x_buf$set_s0123(height, width, x, y)
293: x_buf$set_l23(p2i(tile), b2i(mask))
294: end tile_fill
295:
296: pixmap_put = proc (w: cvt, pix: x_pixmap,
297: srcx, srcy, width, height, dstx, dsty, func, planes: int)
298: x_buf$setup(x_pixmapput, func, planes, w)
299: x_buf$set_s0123(height, width, srcx, srcy)
300: x_buf$set_l2s67(p2i(pix), dstx, dsty)
301: end pixmap_put
302:
303: pixmap_zbitsput = proc (w: cvt, width, height: int, bits: _wordvec,
304: mask: x_bitmap, x, y, func, planes: int)
305: x_buf$setup(x_pixmapbitsput, func, planes, w)
306: x_buf$set_s0123(height, width, x, y)
307: x_buf$set_s45l3(ZFormat, 0, b2i(mask))
308: z: int := width * height
309: if x_display$planes() > 8
310: then z := z + z end
311: x_buf$send_data(w2b(bits), 1, z)
312: end pixmap_zbitsput
313:
314: pixmap_xybitsput = proc (w: cvt, width, height: int, bits: _wordvec,
315: mask: x_bitmap, x, y, func, planes: int)
316: x_buf$setup(x_pixmapbitsput, func, planes, w)
317: x_buf$set_s0123(height, width, x, y)
318: x_buf$set_s45l3(XYFormat, 0, b2i(mask))
319: x_buf$send_data(w2b(bits), 1,
320: ((width + 15) / 16) * height * 2 * x_display$planes())
321: end pixmap_xybitsput
322:
323: bitmap_bitsput = proc (w: cvt, width, height: int, bits: _wordvec,
324: fore, back: int, mask: x_bitmap, x, y, func, planes: int)
325: x_buf$setup(x_bitmapbitsput, func, planes, w)
326: x_buf$set_s0123(height, width, x, y)
327: x_buf$set_s45l3(fore, back, b2i(mask))
328: x_buf$send_data(w2b(bits), 1, ((width + 15) / 16) * height * 2)
329: end bitmap_bitsput
330:
331: move_area = proc (w: cvt, srcx, srcy, width, height, dstx, dsty: int)
332: x_buf$setup(x_copyarea, GXcopy, -1, w)
333: x_buf$set_s0123(height, width, srcx, srcy)
334: x_buf$set_s4567(0, 0, dstx, dsty)
335: end move_area
336:
337: copy_area = proc (w: cvt, srcx, srcy, width, height, dstx, dsty: int,
338: func, planes: int)
339: x_buf$setup(x_copyarea, func, planes, w)
340: x_buf$set_s0123(height, width, srcx, srcy)
341: x_buf$set_s4567(0, 0, dstx, dsty)
342: end copy_area
343:
344: text = proc (w: cvt, s: string, font: x_font, fore, back, x, y: int)
345: x_buf$setup(x_text, GXcopy, -1, w)
346: x_buf$set_s01l1(x, y, f2i(font))
347: x_buf$set_s4567(fore, back, string$size(s), 0)
348: x_buf$send_data(s2b(s), 1, string$size(s))
349: end text
350:
351: textv = proc (w: cvt, b: _bytevec, start, z: int, font: x_font,
352: fore, back, x, y: int)
353: x_buf$setup(x_text, GXcopy, -1, w)
354: x_buf$set_s01l1(x, y, f2i(font))
355: x_buf$set_s4567(fore, back, z, 0)
356: x_buf$send_data(b, start, z)
357: end textv
358:
359: texta = proc (w: cvt, a: array[char], start, z: int, font: x_font,
360: fore, back, x, y: int)
361: x_buf$setup(x_text, GXcopy, -1, w)
362: x_buf$set_s01l1(x, y, f2i(font))
363: x_buf$set_s4567(fore, back, z, 0)
364: x_buf$send_array(a, start, z)
365: end texta
366:
367: text_pad = proc (w: cvt, s: string, font: x_font, fore, back, cpad, spad: int,
368: x, y: int, func, planes: int)
369: x_buf$setup(x_text, func, planes, w)
370: x_buf$set_s01l1(x, y, f2i(font))
371: x_buf$set_s4567(fore, back, string$size(s), (spad // 2**8) + cpad * 2**8)
372: x_buf$send_data(s2b(s), 1, string$size(s))
373: end text_pad
374:
375: textv_pad = proc (w: cvt, b: _bytevec, start, z: int, font: x_font,
376: fore, back, cpad, spad: int, x, y: int, func, planes: int)
377: x_buf$setup(x_text, func, planes, w)
378: x_buf$set_s01l1(x, y, f2i(font))
379: x_buf$set_s4567(fore, back, z, (spad // 2**8) + cpad * 2**8)
380: x_buf$send_data(b, start, z)
381: end textv_pad
382:
383: texta_pad = proc (w: cvt, a: array[char], start, z: int, font: x_font,
384: fore, back, cpad, spad: int, x, y: int, func, planes: int)
385: x_buf$setup(x_text, func, planes, w)
386: x_buf$set_s01l1(x, y, f2i(font))
387: x_buf$set_s4567(fore, back, z, (spad // 2**8) + cpad * 2**8)
388: x_buf$send_array(a, start, z)
389: end texta_pad
390:
391: text_mask = proc (w: cvt, s: string, font: x_font, pixel, x, y: int)
392: x_buf$setup(x_textmask, GXcopy, -1, w)
393: x_buf$set_s01l1(x, y, f2i(font))
394: x_buf$set_s4567(pixel, 0, string$size(s), 0)
395: x_buf$send_data(s2b(s), 1, string$size(s))
396: end text_mask
397:
398: textv_mask = proc (w: cvt, b: _bytevec, start, z: int, font: x_font,
399: pixel, x, y: int)
400: x_buf$setup(x_textmask, GXcopy, -1, w)
401: x_buf$set_s01l1(x, y, f2i(font))
402: x_buf$set_s4567(pixel, 0, z, 0)
403: x_buf$send_data(b, start, z)
404: end textv_mask
405:
406: texta_mask = proc (w: cvt, a: array[char], start, z: int, font: x_font,
407: pixel, x, y: int)
408: x_buf$setup(x_textmask, GXcopy, -1, w)
409: x_buf$set_s01l1(x, y, f2i(font))
410: x_buf$set_s4567(pixel, 0, z, 0)
411: x_buf$send_array(a, start, z)
412: end texta_mask
413:
414: text_mask_pad = proc (w: cvt, s: string, font: x_font, pixel, cpad, spad: int,
415: x, y: int, func, planes: int)
416: x_buf$setup(x_textmask, func, planes, w)
417: x_buf$set_s01l1(x, y, f2i(font))
418: x_buf$set_s4567(pixel, 0, string$size(s), (spad // 2**8) + cpad * 2**8)
419: x_buf$send_data(s2b(s), 1, string$size(s))
420: end text_mask_pad
421:
422: textv_mask_pad = proc (w: cvt, b: _bytevec, start, z: int, font: x_font,
423: pixel, cpad, spad: int, x, y: int, func, planes: int)
424: x_buf$setup(x_textmask, func, planes, w)
425: x_buf$set_s01l1(x, y, f2i(font))
426: x_buf$set_s4567(pixel, 0, z, (spad // 2**8) + cpad * 2**8)
427: x_buf$send_data(b, start, z)
428: end textv_mask_pad
429:
430: texta_mask_pad = proc (w: cvt, a: array[char], start, z: int, font: x_font,
431: pixel, cpad, spad: int, x, y: int, func, planes: int)
432: x_buf$setup(x_textmask, func, planes, w)
433: x_buf$set_s01l1(x, y, f2i(font))
434: x_buf$set_s4567(pixel, 0, z, (spad // 2**8) + cpad * 2**8)
435: x_buf$send_array(a, start, z)
436: end texta_mask_pad
437:
438: line = proc (w: cvt, pixel, width, height, x1, y1, x2, y2, func, planes: int)
439: x_buf$setup(x_line, func, planes, w)
440: x_buf$set_s0123(x1, y1, x2, y2)
441: x_buf$set_s4567(pixel, (width // 2**8) + height * 2**8, 0, 0)
442: end line
443:
444: draw = proc (w: cvt, verts: x_vlist, z, pixel, width, height, func, planes: int)
445: x_buf$setup(x_draw, func, planes, w)
446: x_buf$set_s0123(z, pixel, (width // 2**8) + height * 2**8, DrawSolidLine)
447: x_buf$send_data(v2b(verts), 1, 6 * z)
448: end draw
449:
450: draw_dashed = proc (w: cvt, verts: x_vlist, z, pixel, width, height: int,
451: pattern, patlen, patmul, func, planes: int)
452: x_buf$setup(x_draw, func, planes, w)
453: x_buf$set_s0123(z, pixel, (width // 2**8) + height * 2**8, DrawDashedLine)
454: x_buf$set_s4567(0, pattern, patlen, patmul)
455: x_buf$send_data(v2b(verts), 1, 6 * z)
456: end draw_dashed
457:
458: draw_patterned = proc (w: cvt, verts: x_vlist, z, pixel, altpix: int,
459: width, height, pattern, patlen, patmul, func, planes: int)
460: x_buf$setup(x_draw, func, planes, w)
461: x_buf$set_s0123(z, pixel, (width // 2**8) + height * 2**8, DrawPatternedLine)
462: x_buf$set_s4567(altpix, pattern, patlen, patmul)
463: x_buf$send_data(v2b(verts), 1, 6 * z)
464: end draw_patterned
465:
466: draw_filled = proc (w: cvt, verts: x_vlist, z, pixel, func, planes: int)
467: x_buf$setup(x_drawfilled, func, planes, w)
468: x_buf$set_s01l1(z, pixel, 0)
469: x_buf$send_data(v2b(verts), 1, 6 * z)
470: end draw_filled
471:
472: draw_tiled = proc (w: cvt, verts: x_vlist, z: int, tile: x_pixmap,
473: func, planes: int)
474: x_buf$setup(x_drawfilled, func, planes, w)
475: x_buf$set_s01l1(z, 0, p2i(tile))
476: x_buf$send_data(v2b(verts), 1, 6 * z)
477: end draw_tiled
478:
479: save_region = proc (w: cvt, x, y, width, height: int) returns (x_pixmap)
480: signals (error(string))
481: x_buf$setup(x_pixmapsave, 0, 0, w)
482: x_buf$set_s0123(height, width, x, y)
483: x_buf$receive()
484: resignal error
485: return(_cvt[int, x_pixmap](x_buf$get_lp0()))
486: end save_region
487:
488: read_xyregion = proc (w: cvt, x, y, width, height: int) returns (_wordvec)
489: signals (error(string))
490: x_buf$setup(x_pixmapget, XYFormat, 0, w)
491: x_buf$set_s0123(height, width, x, y)
492: x_buf$receive()
493: resignal error
494: b: _bytevec := _bytevec$create(x_buf$get_lp0())
495: x_buf$receive_data(b)
496: return(b2w(b))
497: end read_xyregion
498:
499: read_zregion = proc (w: cvt, x, y, width, height: int) returns (_wordvec)
500: signals (error(string))
501: x_buf$setup(x_pixmapget, ZFormat, 0, w)
502: x_buf$set_s0123(height, width, x, y)
503: x_buf$receive()
504: resignal error
505: b: _bytevec := _bytevec$create(x_buf$get_lp0())
506: x_buf$receive_data(b)
507: return(b2w(b))
508: end read_zregion
509:
510: get_id = proc (w: cvt) returns (int)
511: return(w)
512: end get_id
513:
514: equal = proc (w1, w2: cvt) returns (bool)
515: return(w1 = w2)
516: end equal
517:
518: similar = proc (w1, w2: cvt) returns (bool)
519: return(w1 = w2)
520: end similar
521:
522: copy = proc (w: cvt) returns (cvt)
523: return(w)
524: end copy
525:
526: end x_window
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.