% Copyright    Barbara Liskov    1985, 1986

x_font = cluster is create, destroy, query, widths, width, all_widths,
		    get_id, equal, similar, copy

rep = int

create = proc (name: string) returns (cvt) signals (error(string))
    x_buf$setup(x_getfont, 0, 0, 0)
    x_buf$set_s0(string$size(name))
    x_buf$send_data(s2b(name), 1, string$size(name))
    x_buf$receive()
       resignal error
    return(x_buf$get_lp0())
    end create

destroy = proc (font: cvt)
    x_buf$setup(x_freefont, 0, 0, 0)
    x_buf$set_l0(font)
    end destroy

% returns (avg_width, height, first_char, last_char, baseline, fixedwidth)

query = proc (font: cvt) returns (int, int, char, char, int, bool)
	  signals (error(string))
    x_buf$setup(x_queryfont, 0, 0, 0)
    x_buf$set_l0(font)
    x_buf$receive()
       resignal error
    return(x_buf$get_sp1(), x_buf$get_sp0(),
	   char$i2c(x_buf$get_sp2()), char$i2c(x_buf$get_sp3()),
	   x_buf$get_sp4(), x_buf$get_sp5() ~= 0)
    end query

widths = iter (font: cvt, s: string) yields (char, int) signals (error(string))
    x_buf$setup(x_charwidths, 0, 0, 0)
    x_buf$set_l0s23(font, string$size(s), 0)
    x_buf$send_data(s2b(s), 1, string$size(s))
    x_buf$receive()
       resignal error
    b: _bytevec := _bytevec$create(x_buf$get_lp0())
    x_buf$receive_data(b)
    i: int := 1
    for c: char in string$chars(s) do
	yield(c, _wordvec$wfetch(b2w(b), i))
	i := i + 2
	end
    end widths

width = proc (font: cvt, s: string) returns (int) signals (error(string))
    x_buf$setup(x_stringwidth, 0, 0, 0)
    x_buf$set_l0s23(font, string$size(s), 0)
    x_buf$send_data(s2b(s), 1, string$size(s))
    x_buf$receive()
       resignal error
    return(x_buf$get_sp0())
    end width

all_widths = proc (font: cvt) returns (_wordvec) signals (error(string))
    x_buf$setup(x_fontwidths, 0, 0, 0)
    x_buf$set_l0(font)
    x_buf$receive()
       resignal error
    b: _bytevec := _bytevec$create(x_buf$get_lp0())
    x_buf$receive_data(b)
    return(b2w(b))
    end all_widths

get_id = proc (font: cvt) returns (int)
    return(font)
    end get_id

equal = proc (font1, font2: cvt) returns (bool)
    return(font1 = font2)
    end equal

similar = proc (font1, font2: cvt) returns (bool)
    return(font1 = font2)
    end similar

copy = proc (font: cvt) returns (cvt)
    return(font)
    end copy

end x_font