![[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.