% 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