![[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 / sun|
Return to x_display.clu CVS log | Up to [CSRG BSD Unix] / 43BSD / contrib / 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.