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