4.3BSD/usr/contrib/X/CLUlib/vax/x_font.clu

% Copyright    Barbara Liskov    1985

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))
    or: oreq, er: ereq := x_buf$get()
    er.code := x_getfont
    er.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)
    or: oreq, er: ereq := x_buf$get()
    er.code := x_freefont
    lr(er).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))
    or: oreq, er: ereq := x_buf$get()
    er.code := x_queryfont
    lr(er).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))
    or: oreq, er: ereq := x_buf$get()
    er.code := x_charwidths
    lr(er).l0 := font
    er.s2 := string$size(s)
    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))
    or: oreq, er: ereq := x_buf$get()
    er.code := x_stringwidth
    lr(er).l0 := font
    er.s2 := string$size(s)
    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))
    or: oreq, er: ereq := x_buf$get()
    er.code := x_fontwidths
    lr(er).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