|
|
1.1 root 1: % Copyright Barbara Liskov 1985, 1986
2:
3: x_flush = proc ()
4: x_buf$flush()
5: end x_flush
6:
7: x_feep = proc (volume: int)
8: x_buf$setup(x_feep_, 0, 0, 0)
9: x_buf$set_s0(volume)
10: end x_feep
11:
12: x_store_cut = proc (buf: int, s: string)
13: x_buf$setup(x_storebytes, buf, 0, 0)
14: x_buf$set_s0(string$size(s))
15: x_buf$send_data(s2b(s), 1, string$size(s))
16: end x_store_cut
17:
18: x_fetch_cut = proc (buf: int) returns (string) signals (error(string))
19: x_buf$setup(x_fetchbytes, buf, 0, 0)
20: x_buf$receive()
21: resignal error
22: b: _bytevec := _bytevec$create(x_buf$get_sp0())
23: x_buf$receive_data(b)
24: return(b2s(b))
25: end x_fetch_cut
26:
27: x_rotate_cuts = proc (buf: int)
28: x_buf$setup(x_rotatecuts, buf, 0, 0)
29: end x_rotate_cuts
30:
31: x_mouse_control = proc (accel, thresh: int)
32: x_buf$setup(x_mousecontrol, 0, 0, 0)
33: x_buf$set_s01(accel, thresh)
34: end x_mouse_control
35:
36: x_feep_control = proc (volume: int)
37: x_buf$setup(x_feepcontrol, 0, 0, 0)
38: x_buf$set_s0(volume)
39: end x_feep_control
40:
41: x_shift_lock = proc (toggle: bool)
42: if toggle
43: then x_buf$setup(x_shiftlock, LockToggleMode, 0, 0)
44: else x_buf$setup(x_shiftlock, LockUpDownMode, 0, 0)
45: end
46: end x_shift_lock
47:
48: x_key_click = proc (volume: int)
49: x_buf$setup(x_keyclick, volume, 0, 0)
50: end x_key_click
51:
52: x_auto_repeat = proc (on: bool)
53: if on
54: then x_buf$setup(x_autorepeat, 1, 0, 0)
55: else x_buf$setup(x_autorepeat, 0, 0, 0)
56: end
57: end x_auto_repeat
58:
59: x_screen_saver = proc (video: bool, timeout, shift: int)
60: if video
61: then x_buf$setup(x_screensaver, 1, 0, 0)
62: else x_buf$setup(x_screensaver, 0, 0, 0)
63: end
64: x_buf$set_s01(timeout, shift)
65: end x_screen_saver
66:
67: x_default = proc (prog, option: string) returns (string) signals (not_found)
68: as = array[string]
69: own init: bool := false
70: own lines: as
71: if ~init
72: then lines := as$new()
73: buf: _bytevec := _bytevec$create(128)
74: init := true
75: c: _chan := _chan$open(file_name$parse("~/.Xdefaults"), "read", 0)
76: s: string
77: l: int := 1
78: h: int := 0
79: while true do
80: s, l, h := _chan$get(c, buf, l, h, "\n", false)
81: if l <= h
82: then l := l + 1 end
83: if ~string$empty(s) cand s[1] ~= '#'
84: then as$addl(lines, s) end
85: end except when end_of_file, not_possible (*): end
86: _chan$close(c)
87: end except when not_possible (*): end
88: match1: int := string$size(prog) + 1
89: for s: string in as$elements(lines) do
90: i: int := 1
91: if s[1] ~= '.'
92: then if string$size(s) <= match1 cor
93: string$indexs(prog, s) ~= 1 cor s[match1] ~= '.'
94: then continue end
95: i := match1
96: end
97: i := i + 1
98: j: int := _bytevec$indexc(':', s2b(s), i)
99: if j = 0 cor j - i ~= string$size(option) cor
100: _bytevec$nc_indexv(s2b(option), s2b(s), i) ~= i
101: then continue end
102: k: int := j + 1
103: while s[k] = ' ' cor s[k] = '\t' do
104: k := k + 1
105: end except when bounds: continue end
106: return(string$rest(s, k))
107: end
108: signal not_found
109: end x_default
110:
111: x_parse_color = proc (spec: string) returns (int, int, int)
112: signals (bad_format, undefined)
113: zero = char$c2i('0')
114: upper = char$c2i('A') - 10
115: lower = char$c2i('a') - 10
116: if string$empty(spec)
117: then signal bad_format
118: elseif spec[1] ~= '#'
119: then r, g, b, dr, dg, db: int := x_display$lookup_color(spec)
120: except when error (*): signal undefined end
121: return(r, g, b)
122: elseif ~(string$size(spec) = 4 cor string$size(spec) = 7 cor
123: string$size(spec) = 10 cor string$size(spec) = 13)
124: then signal bad_format end
125: n: int := string$size(spec) / 3
126: r: int := 0
127: g: int := 0
128: b: int := 0
129: for i: int in int$from_to_by(2, string$size(spec), n) do
130: r := g
131: g := b
132: b := 0
133: for j: int in int$from_to(i, i + n - 1) do
134: c: char := spec[j]
135: if c >= '0' cand c <= '9'
136: then b := b * 16 + (char$c2i(c) - zero)
137: elseif c >= 'A' cand c <= 'F'
138: then b := b * 16 + (char$c2i(c) - upper)
139: elseif c >= 'a' cand c <= 'f'
140: then b := b * 16 + (char$c2i(c) - lower)
141: else signal bad_format end
142: end
143: end
144: n := 2 ** (16 - 4 * n)
145: return(r * n, g * n, b * n)
146: end x_parse_color
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.