![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to x_display.clu CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSD / contrib / X / CLUlib / vax|
Return to x_display.clu CVS log | Up to [CSRG BSD Unix] / 43BSD / contrib / X / CLUlib / vax |
1.1 root 1: % Copyright Barbara Liskov 1985
2:
3: x_display = cluster is init,
4: root, width, height, device, protocol, planes, cells,
5: grab, ungrab,
6: alloc_color, alloc_cell, alloc_cells,
7: free_color, free_colors,
8: store_color, store_colors, query_color, lookup_color,
9: black, white
10:
11: rep = null
12:
13: own base: x_window
14: own rwidth: int
15: own rheight: int
16: own devid: int
17: own numproto: int
18: own numplanes: int
19: own numcells: int
20: own haveblack: bool
21: own blackp: x_pixmap
22: own havewhite: bool
23: own whitep: x_pixmap
24: own colbuf: _bytevec
25:
26: init = proc (display: string) signals (error(string))
27: qw = sequence[_wordvec]
28: if string$empty(display)
29: then display := _environ("DISPLAY")
30: except when not_found: end
31: end
32: num: int := string$indexc(':', display)
33: if num ~= 0
34: then display, num := string$substr(display, 1, num - 1),
35: int$parse(string$rest(display, num + 1))
36: end
37: addrs: qw := qw$new()
38: if string$empty(display) cor display = "unix"
39: then addrs := qw$addh(addrs,
40: _cvt[string, _wordvec]("\001\000/dev/X" ||
41: int$unparse(num)))
42: end
43: if string$empty(display) cor display ~= "unix"
44: then if string$empty(display)
45: then display := _host_name() end
46: l, r: int := host_address(display)
47: except when not_found, bad_address: signal error("bad host") end
48: addr: _wordvec := _wordvec$create(4)
49: _wordvec$wstore(addr, 1, 2)
50: num := num + 5800
51: _wordvec$bstore(addr, 3, num / 2**8)
52: _wordvec$bstore(addr, 4, num)
53: _wordvec$wstore(addr, 5, r)
54: _wordvec$wstore(addr, 7, l)
55: addrs := qw$addh(addrs, addr)
56: end
57: err: string := ""
58: for addr: _wordvec in qw$elements(addrs) do
59: x_buf$init(addr)
60: except when error (why: string):
61: err := why
62: continue
63: end
64: err := ""
65: break
66: end
67: if ~string$empty(err)
68: then signal error(err) end
69: or: oreq, er: ereq := x_buf$get()
70: er.code := x_setup
71: x_buf$receive()
72: base := _cvt[int, x_window](x_buf$get_lp0())
73: rwidth := 0
74: rheight := 0
75: numproto := x_buf$get_sp2()
76: devid := x_buf$get_sp3()
77: numplanes := x_buf$get_sp4()
78: numcells := x_buf$get_sp5() // 2**16
79: haveblack := false
80: havewhite := false
81: colbuf := _bytevec$create(8)
82: x_input$init()
83: end init
84:
85: root = proc () returns (x_window)
86: return(base)
87: end root
88:
89: width = proc () returns (int)
90: if rwidth = 0
91: then x, y, w, h, b, s, k: int, i: x_window := x_window$query(base)
92: rwidth := w
93: rheight := h
94: end
95: return(rwidth)
96: end width
97:
98: height = proc () returns (int)
99: if rheight = 0
100: then x, y, w, h, b, s, k: int, i: x_window := x_window$query(base)
101: rwidth := w
102: rheight := h
103: end
104: return(rheight)
105: end height
106:
107: device = proc () returns (int)
108: return(devid)
109: end device
110:
111: protocol = proc () returns (int)
112: return(numproto)
113: end protocol
114:
115: planes = proc () returns (int)
116: return(numplanes)
117: end planes
118:
119: cells = proc () returns (int)
120: return(numcells)
121: end cells
122:
123: grab = proc ()
124: or: oreq, er: ereq := x_buf$get()
125: er.code := x_grabserver
126: end grab
127:
128: ungrab = proc ()
129: or: oreq, er: ereq := x_buf$get()
130: er.code := x_ungrabserver
131: end ungrab
132:
133: alloc_color = proc (red, green, blue: int) returns (int)
134: signals (error(string))
135: or: oreq, er: ereq := x_buf$get()
136: er.code := x_getcolor
137: er.s0 := red
138: or.s1 := green
139: er.s2 := blue
140: x_buf$receive()
141: resignal error
142: return(x_buf$get_sp0() // 2**16)
143: end alloc_color
144:
145: alloc_cell = proc () returns (int) signals (error(string))
146: or: oreq, er: ereq := x_buf$get()
147: er.code := x_getcolorcells
148: er.s0 := 1
149: or.s1 := 0
150: x_buf$receive()
151: resignal error
152: b: _bytevec := _bytevec$create(2)
153: x_buf$receive_data(b)
154: return(_wordvec$wfetch(b2w(b), 1))
155: end alloc_cell
156:
157: alloc_cells = proc (ncolors, nplanes: int, contig: bool)
158: returns (pixellist, int) signals (error(string))
159: or: oreq, er: ereq := x_buf$get()
160: if contig
161: then er.code := x_getcolorcells + (1 * 2**8)
162: else er.code := x_getcolorcells
163: end
164: er.s0 := ncolors
165: or.s1 := nplanes
166: x_buf$receive()
167: resignal error
168: mask: int := x_buf$get_sp0() // 2**16
169: pixels: pixellist := pixellist$fill(1, ncolors, 0)
170: if ncolors > 0
171: then b: _bytevec := _bytevec$create(ncolors * 2)
172: x_buf$receive_data(b)
173: for i: int in int$from_to_by(ncolors, 1, -1) do
174: pixels[i] := _wordvec$wfetch(b2w(b), i * 2 - 1)
175: end
176: end
177: return(pixels, mask)
178: end alloc_cells
179:
180: free_color = proc (pixel: int)
181: or: oreq, er: ereq := x_buf$get()
182: er.code := x_freecolors
183: or.mask := 0
184: er.s0 := 1
185: b: _bytevec := _bytevec$create(2)
186: _wordvec$wstore(b2w(b), 1, pixel)
187: x_buf$send_data(b, 1, 2)
188: end free_color
189:
190: free_colors = proc (pixels: pixellist, mask: int)
191: or: oreq, er: ereq := x_buf$get()
192: er.code := x_freecolors
193: or.mask := mask
194: er.s0 := pixellist$size(pixels)
195: b: _bytevec := _bytevec$create(pixellist$size(pixels) * 2)
196: i: int := 1
197: for pixel: int in pixellist$elements(pixels) do
198: _wordvec$wstore(b2w(b), i, pixel)
199: i := i + 2
200: end
201: x_buf$send_data(b, 1, _bytevec$size(b))
202: end free_colors
203:
204: store_color = proc (pixel, red, green, blue: int)
205: or: oreq, er: ereq := x_buf$get()
206: er.code := x_storecolors
207: er.s0 := 1
208: _wordvec$wstore(b2w(colbuf), 1, pixel)
209: _wordvec$wstore(b2w(colbuf), 3, red)
210: _wordvec$wstore(b2w(colbuf), 5, green)
211: _wordvec$wstore(b2w(colbuf), 7, blue)
212: x_buf$send_data(colbuf, 1, 8)
213: end store_color
214:
215: store_colors = proc (defs: colordeflist)
216: or: oreq, er: ereq := x_buf$get()
217: er.code := x_storecolors
218: er.s0 := colordeflist$size(defs)
219: z: int := colordeflist$size(defs) * 8
220: if _bytevec$size(colbuf) < z
221: then colbuf := _bytevec$create(z) end
222: i: int := 1
223: for def: colordef in colordeflist$elements(defs) do
224: _wordvec$wstore(b2w(colbuf), i, def.pixel)
225: _wordvec$wstore(b2w(colbuf), i + 2, def.red)
226: _wordvec$wstore(b2w(colbuf), i + 4, def.green)
227: _wordvec$wstore(b2w(colbuf), i + 6, def.blue)
228: i := i + 8
229: end
230: x_buf$send_data(colbuf, 1, z)
231: end store_colors
232:
233: query_color = proc (pixel: int) returns (int, int, int) signals (error(string))
234: or: oreq, er: ereq := x_buf$get()
235: er.code := x_querycolor
236: er.s0 := pixel
237: x_buf$receive()
238: resignal error
239: return(x_buf$get_sp0() // 2**16,
240: x_buf$get_sp1() // 2**16,
241: x_buf$get_sp2() // 2**16)
242: end query_color
243:
244: lookup_color = proc (name: string) returns (int, int, int, int, int, int)
245: signals (error(string))
246: or: oreq, er: ereq := x_buf$get()
247: er.code := x_lookupcolor
248: er.s0 := string$size(name)
249: x_buf$send_data(s2b(name), 1, string$size(name))
250: x_buf$receive()
251: resignal error
252: return(x_buf$get_sp0() // 2**16,
253: x_buf$get_sp1() // 2**16,
254: x_buf$get_sp2() // 2**16,
255: x_buf$get_sp3() // 2**16,
256: x_buf$get_sp4() // 2**16,
257: x_buf$get_sp5() // 2**16)
258: end lookup_color
259:
260: black = proc () returns (x_pixmap)
261: if ~haveblack
262: then blackp := x_pixmap$tile(BlackPixel)
263: haveblack := true
264: end
265: return(blackp)
266: end black
267:
268: white = proc () returns (x_pixmap)
269: if ~havewhite
270: then whitep := x_pixmap$tile(WhitePixel)
271: havewhite := true
272: end
273: return(whitep)
274: end white
275:
276: end x_display
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.