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