% Copyright    Barbara Liskov    1985, 1986

x_flush = proc ()
    x_buf$flush()
    end x_flush

x_feep = proc (volume: int)
    x_buf$setup(x_feep_, 0, 0, 0)
    x_buf$set_s0(volume)
    end x_feep

x_store_cut = proc (buf: int, s: string)
    x_buf$setup(x_storebytes, buf, 0, 0)
    x_buf$set_s0(string$size(s))
    x_buf$send_data(s2b(s), 1, string$size(s))
    end x_store_cut

x_fetch_cut = proc (buf: int) returns (string) signals (error(string))
    x_buf$setup(x_fetchbytes, buf, 0, 0)
    x_buf$receive()
       resignal error
    b: _bytevec := _bytevec$create(x_buf$get_sp0())
    x_buf$receive_data(b)
    return(b2s(b))
    end x_fetch_cut

x_rotate_cuts = proc (buf: int)
    x_buf$setup(x_rotatecuts, buf, 0, 0)
    end x_rotate_cuts

x_mouse_control = proc (accel, thresh: int)
    x_buf$setup(x_mousecontrol, 0, 0, 0)
    x_buf$set_s01(accel, thresh)
    end x_mouse_control

x_feep_control = proc (volume: int)
    x_buf$setup(x_feepcontrol, 0, 0, 0)
    x_buf$set_s0(volume)
    end x_feep_control

x_shift_lock = proc (toggle: bool)
    if toggle
       then x_buf$setup(x_shiftlock, LockToggleMode, 0, 0)
       else x_buf$setup(x_shiftlock, LockUpDownMode, 0, 0)
       end
    end x_shift_lock

x_key_click = proc (volume: int)
    x_buf$setup(x_keyclick, volume, 0, 0)
    end x_key_click

x_auto_repeat = proc (on: bool)
    if on
       then x_buf$setup(x_autorepeat, 1, 0, 0)
       else x_buf$setup(x_autorepeat, 0, 0, 0)
       end
    end x_auto_repeat

x_screen_saver = proc (video: bool, timeout, shift: int)
    if video
       then x_buf$setup(x_screensaver, 1, 0, 0)
       else x_buf$setup(x_screensaver, 0, 0, 0)
       end
    x_buf$set_s01(timeout, shift)
    end x_screen_saver

x_default = proc (prog, option: string) returns (string) signals (not_found)
    as = array[string]
    own init: bool := false
    own lines: as
    if ~init
       then lines := as$new()
	    buf: _bytevec := _bytevec$create(128)
	    init := true
	    c: _chan := _chan$open(file_name$parse("~/.Xdefaults"), "read", 0)
	    s: string
	    l: int := 1
	    h: int := 0
	    while true do
		s, l, h := _chan$get(c, buf, l, h, "\n", false)
		if l <= h
		   then l := l + 1 end
		if ~string$empty(s)  cand  s[1] ~= '#'
		   then as$addl(lines, s) end
		end except when end_of_file, not_possible (*): end
	    _chan$close(c)
       end except when not_possible (*): end
    match1: int := string$size(prog) + 1
    for s: string in as$elements(lines) do
	i: int := 1
	if s[1] ~= '.'
	   then if string$size(s) <= match1  cor
		   string$indexs(prog, s) ~= 1  cor  s[match1] ~= '.'
		   then continue end
		i := match1
	   end
	i := i + 1
	j: int := _bytevec$indexc(':', s2b(s), i)
	if j = 0  cor  j - i ~= string$size(option)  cor
	   _bytevec$nc_indexv(s2b(option), s2b(s), i) ~= i
	   then continue end
	k: int := j + 1
	while s[k] = ' '  cor  s[k] = '\t' do
	    k := k + 1
	    end except when bounds: continue end
	return(string$rest(s, k))
	end
    signal not_found
    end x_default

x_parse_color = proc (spec: string) returns (int, int, int)
		  signals (bad_format, undefined)
    zero = char$c2i('0')
    upper = char$c2i('A') - 10
    lower = char$c2i('a') - 10
    if string$empty(spec)
       then signal bad_format
     elseif spec[1] ~= '#'
       then r, g, b, dr, dg, db: int := x_display$lookup_color(spec)
	       except when error (*): signal undefined end
	    return(r, g, b)
     elseif ~(string$size(spec) = 4  cor  string$size(spec) = 7  cor
	      string$size(spec) = 10  cor  string$size(spec) = 13)
       then signal bad_format end
    n: int := string$size(spec) / 3
    r: int := 0
    g: int := 0
    b: int := 0
    for i: int in int$from_to_by(2, string$size(spec), n) do
	r := g
	g := b
	b := 0
	for j: int in int$from_to(i, i + n - 1) do
	    c: char := spec[j]
	    if c >= '0'  cand  c <= '9'
	       then b := b * 16 + (char$c2i(c) - zero)
	     elseif c >= 'A'  cand  c <= 'F'
	       then b := b * 16 + (char$c2i(c) - upper)
	     elseif c >= 'a'  cand  c <= 'f'
	       then b := b * 16 + (char$c2i(c) - lower)
	     else signal bad_format end
	    end
	end
    n := 2 ** (16 - 4 * n)
    return(r * n, g * n, b * n)
    end x_parse_color