BSD 4_3_Tahoe development

[unix-history] / usr / src / new / 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