|
|
1.1 root 1: % Copyright Barbara Liskov 1985, 1986
2:
3: x_bitmap = cluster is none, create, screate, destroy, c2b, get_id,
4: equal, similar, copy
5:
6: rep = int
7:
8: none = proc () returns (cvt)
9: return(0)
10: end none
11:
12: create = proc (width, height: int, bits: _wordvec) returns (cvt)
13: signals (error(string))
14: x_buf$setup(x_storebitmap, 0, 0, 0)
15: x_buf$set_s01(height, width)
16: x_buf$send_data(w2b(bits), 1, ((width + 15) / 16) * height * 2)
17: x_buf$receive()
18: resignal error
19: return(x_buf$get_lp0())
20: end create
21:
22: screate = proc (width, height: int, bits: string) returns (x_bitmap)
23: signals (error(string))
24: bts: _bytevec := _bytevec$create(string$size(bits))
25: for i: int in int$from_to_by(1, string$size(bits), 2) do
26: bts[i] := bits[i + 1]
27: bts[i + 1] := bits[i]
28: end
29: return(create(width, height, b2w(bts)))
30: resignal error
31: end screate
32:
33: destroy = proc (bit: cvt)
34: x_buf$setup(x_freebitmap, 0, 0, 0)
35: x_buf$set_l0(bit)
36: end destroy
37:
38: c2b = proc (font: x_font, c: char) returns (cvt) signals (error(string))
39: x_buf$setup(x_charbitmap, 0, 0, 0)
40: x_buf$set_l0s23(f2i(font), char$c2i(c), 0)
41: x_buf$receive()
42: resignal error
43: return(x_buf$get_lp0())
44: end c2b
45:
46: get_id = proc (bit: cvt) returns (int)
47: return(bit)
48: end get_id
49:
50: equal = proc (bit1, bit2: cvt) returns (bool)
51: return(bit1 = bit2)
52: end equal
53:
54: similar = proc (bit1, bit2: cvt) returns (bool)
55: return(bit1 = bit2)
56: end similar
57:
58: copy = proc (bit: cvt) returns (cvt)
59: return(bit)
60: end copy
61:
62: end x_bitmap
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.