Simtel MSDOS 1992 June/SIMTEL_0692.cdr/msdos/tex/hp2tex.arc/HP2TEX.PAS

Pascal/Delphi Source File | 1988-03-02 | 26.4 KB | 820 lines

{HP2TEX - CONVERT HP SOFT FONT FILES TO TEX PL AND PXL FILES. (TurboPascal 3.0)

This program will read an HP soft font and generate two files
useful to TeX users, a PL and a PXL file. In order to use the font
in TeX, take the PL file and run PLTOTF (part of TeXware, ask your
local wizard if this is meaningless to you). The PXL file may be useful
if you have an obsolete driver. More likely you will need to run PXTOPK
(also part of the TeXware distribution) to generate a packed PK file used by
more modern drivers. If you require GF files, I'm afraid you are out of luck.

This program was written by David Strip, Albquerque NM with generous help from
Dimitri L. Vulis of NYC. This program is copyrighted, and in keeping with the
spirit of the TeX community, you are granted permission to copy and
redistribute this program, so long as you provide the source along with any
executable. In addition, you may not charge any fee in excess of the actual
cost of the media and reasonable labor charges. This charge may not exceed
$3.00 per disk plus shipping costs. This software may not be packaged together
with any other software unless the complete package also meet the stated terms
for redistribution. These terms apply to derivative codes as well. To put it
simply, we are not making a profit on this code, and we won't allow you to
either. Exemptions to these terms may be granted only by the authors, and must
be in writing.

If you should modify this code in a useful way, we would be pleased to receive
a copy of your efforts. An ambitious soul might try to add a capability to
read the kerns from one of the CM font .pl files and 'scale' them as a first
cut at kerns for the font being converted. We will also attempt to respond to
bug reports. Bear in mind, however, that you didn't pay anything for this
code.

We have already noted that certain fonts generated by glyphix appear to
convert with a bad underscore character that is far too low. This is in fact
how the underscore is encoded in the font, not an artifact of the conversion.
Sorry, we are not planning to try to correct glyphix's error.

If you are pleased with what you got and want to return the favor, send us a
disk with your favorite HP downloadable fonts, or anything else nice. Surprise
us with goodies in our mailboxes!!!!

February 29, 1988

David Strip (arpanet: [e-mail]
  uucp: ....(ucbvax, cmu!rice, ihnp4!lanl, gatech)!unmvax!intvax!drstrip)
             Snail mail:
                431 Camino de la Sierra NE
                Albuquerque, NM 87123

Dimitri L. Vulis (bitnet: [e-mail]
             arpanet: [e-mail])
             Snail mail:
                529 W. 111 St. #61
                New York, New York 10025-1943

(c) Copyright 1988, David Strip and Dimitri L. Vulis, all rights reserved.


------------------------------------------------------------------------
Change History:

V. 1.0  Original Release, February, 1988

}

program hp2tex;

type
  s=string[255];
  fname = string[60];
  m_string = string[80];
  fontheader = record
     len: integer;
     filler: byte;
     font_type: byte;
     filler2: integer;
     baseline_pos: integer;
     cell_width: integer;
     cell_height: integer;
     orientation: byte;
     fixed: byte;
     symbol_set: integer;
     pitch: integer;
     height: integer;
     filler3: integer;
     filler4: byte;
     style: byte;
     stroke: byte;
     typeface: byte;
     end;

   char_header = record
     four: byte;
     zero1: byte;
     fourteen: byte;
     one: byte;
     orientation: byte;
     zero2: byte;
     left_offset: integer;
     top_offset: integer;
     char_width: integer;
     char_height: integer;
     delta_x: integer;
     end;

  word = record case boolean of  {simulated longint}
     false: (low_half, high_half: integer);
     true: (b0,b1,b2,b3: byte);
     end;

  dir_entry = record
     pxl_width: integer;  {dots}
     pxl_height: integer; {dots}
     x_offset: integer;   {dots}
     y_offset: integer;   {dots}
     pointer: word;
     tfm_width: word;     {fixes}
     radix_width: integer;{radix points}
     end;

const
   pxlheader: word = (low_half:1001; high_half:0); {32-bit aligned}
    {16-bit aligned files with header=1002 will be supported later}
   zero: byte = 0;
   zero_int: integer = 0;
   zero_word: word = (low_half:0; high_half:0);


var
   hpfile: file;
   pxlfile: file;
   plfile: text;

   hpbuf: array[1..2048] of byte;
   hpbufptr: integer;
   hpbuflen: integer;

   pxlbuf: array[1..2048] of byte;
   pxlbufptr: integer;

   c: byte;

   font1: fontheader;
   char1: char_header;
   pxl_dir: array[0..127] of dir_entry;

   char_code, char_len: integer;

   byte_width: integer;
   extra_bytes: integer;

   pxlbyte: byte;
   pxl_ptr: word;

   design_size:integer;
   designsize: word;
   magnification: word;
   magn_scale: real; {1000/magnification}
   dot_scale: real; {dots -> fixes}
   radix_scale: real; {radix pts (1/4 dot) -> fixes}


   filename: fname;
   i,j,k,l,m,n:integer;
   buffer: array[1..2048] of byte;

procedure die(w:s);
begin
   writeln(w);
   writeln('File pos=',filepos(hpfile));
   halt;
end;

function getchar:byte;

begin
  if hpbufptr>=hpbuflen then begin
    blockread(hpfile, hpbuf, 2048, hpbuflen);
    hpbufptr:=1;
    getchar:=hpbuf[1];
    end
  else begin
    hpbufptr:=hpbufptr+1;
    getchar:=hpbuf[hpbufptr];
    end;
  end;

procedure putchar(c:byte);
begin
  pxlbuf[pxlbufptr]:=c;
  if pxlbufptr=2048 then begin
    blockwrite(pxlfile, pxlbuf, 2048);
    pxlbufptr:=1;
    end
  else pxlbufptr:=pxlbufptr+1;
  end;

procedure closeout(var outfile: file);
begin
  if pxlbufptr>1 then blockwrite(pxlfile, pxlbuf, pxlbufptr-1);
  close(pxlfile);
  end;


procedure writea(var outfile: file; var t;i:integer);
var
   j:integer;
begin
   if i>2048 then die('Died writing an impossibly large character');
   move(t,buffer,i);
   for j:=1 to i do
      putchar(buffer[j]);
   end;

{This procedure is not needed if someone ports this code to a
 Bigendian machine. Just remove this stuff snd replace the calls to it
 by just writea.}

procedure writear(var outfile: file; var t;i:integer); {write reversed}
var
   j:integer;
begin
   if i>2048 then die('Died writing an impossibly large character');
   move(t,buffer,i);
   for j:=i downto 1 do
      putchar(buffer[j]);
     end;


procedure swapbytes(var x:integer);
{this procedure is not needed if someone ports this code to a
 Bigendian machine. Just remove this stuff as well as the calls to it.}
var x1:record case boolean of
0: (i1,i2: byte);
1: (i3: integer);
end;
begin
x1.i3:=x;
x1.i1:=x1.i1 xor x1.i2;
x1.i2:=x1.i1 xor x1.i2;
x1.i1:=x1.i1 xor x1.i2;
x:=x1.i3
end;



procedure readn(var infile: file; var num: integer; x:char);
     {read number, expressed in chars from infle, convert, put it in num}
var c:byte;
begin
   num:=0;
   c:=getchar;
   if not (c in [ord('0')..ord('9')]) then die('Number expected');
   repeat
   num:=num*10+c-ord('0');
   c:=getchar;
   until not (c in [ord('0')..ord('9')]);
   if c<>ord(x) then die(x+' expected');
   end;

procedure pchar(i:byte);
begin
   case i of
0:      write('NULL character');
7:      write('BELL character');
8:      write('BACKSPACE character');
9:      write('TAB character');
10:     write('LINE FEED character');
12:     write('FORM FEED character');
13:     write('CARRIAGE RETURN character');
26:     write('END-OF-FILE character');
27:     write('ESCAPE character');
32:     write('SPACE character');
33..126:write('``',chr(i),'''''');
127:    write('DEL');
   else write('chr(',i:0,')'); {A control character, or >127}
   end;
end;

function expect(var infile: file; w:s): boolean;
begin
   expect:=true; {innocent until proven guilty}
   for j:=1 to length(w) do begin
      c:=getchar;
      if chr(c)<>w[j] then begin
         pchar(ord(w[j]));
         write(' expected but found ');
         pchar(c);
         expect:=false;
         exit; {for}
         end; {if}
      end; {for j}
end;

procedure reada(var infile: file; var t;i:integer);
var
   j:integer;
   x:array[0..2048] of byte;
begin
   if i>2048 then
    die('Died reading an impossibly large character or font header');
   for j:=0 to i-1 do
      x[j]:=getchar;
   move(x,t,i);
   end;


procedure open_untyped_file(var infile: file; filename,dft: fname; r_w: char;
                     message: m_string);
begin
   repeat
      while filename='' do begin
         write(message);
         readln(filename);
         end;
      i:=ord(filename[0]); if i>4 then i:=4;
      if pos('.',copy(filename,ord(filename[0])-i+1,i))=0 then
        filename:=filename+'.'+dft;
      assign(infile,filename);
      filename:='';
   {$I-}
      if r_w='w' then rewrite(infile,1) else reset(infile,1);
   {$I+}
      until ioresult=0;
   end;

procedure open_text_file(var infile: text; filename,dft: fname; r_w: char;
                     message: m_string);
begin
   repeat
      while filename='' do begin
         write(message);
         readln(filename);
         end;
      i:=ord(filename[0]); if i>4 then i:=4;
      if pos('.',copy(filename,ord(filename[0])-i+1,i))=0 then
        filename:=filename+'.'+dft;
      assign(infile,filename);
      filename:='';
   {$I-}
      if r_w='w' then rewrite(infile) else reset(infile);
   {$I+}
      until ioresult=0;
   end;

procedure set_tfm_width(radix: integer; var fixes: word);

{the tfm width in .pxl file is expressed in 'fixes' which are 1/2^20 of
the design size. To get this, divide the width in radix points by the
design size (in points), then multiply by 2^20. radix_scale is the
precomputed conversion factor.}

var
   real_fixes: real;
begin
{float everything and divide. If we had longints, we'd say:
 fixes:=trunc(2^20*radix*radix_scale);
Here we lose the lowest bit, but it does not matter since the real
 arithmetic makes the entire low byte meaningless}
   real_fixes:=radix*radix_scale*16;
   fixes.high_half:=trunc(real_fixes);
   fixes.low_half:=trunc((real_fixes-fixes.high_half)*32768.0) shl 1;
   end;

procedure skipjunk(num: integer);
{Skip junk bytes. However, some vendors (notably HP itself) hide certain
 info (e.g. a copyright notice) in these junk bytes, so we will display
 whatever ASCII we find}
var f:boolean;
begin
  write('Skipping ',num,' bytes of junk');
  {Amazingly, this seems to work faster than b4---seek flushes buffers!}
  f:=true;
  for i:=1 to num do begin
     c:=getchar;
     if c in [ord(' ')..126] then begin
        if f then write(' [');
        write(chr(c));
        f:=false;
        end
     else begin
        if not f then write(']');
        f:=true;
        end;
     end;
  if not f then write(']');
  writeln;
  end;


procedure read_fontheader;
var hdr_len: integer;
begin
   if not expect(hpfile,chr(27)+')s') then
      die('escape sequence for font header not found');
   readn(hpfile,hdr_len,'W'); {size of font header}
   hdr_len:=hdr_len-26;
   if hdr_len<0 then
      die('font header is too short');
   reada(hpfile,font1,26);
   writeln('Font characteristics:');
   with font1 do begin
     swapbytes(cell_width);
     swapbytes(cell_height);
     swapbytes(pitch);
     swapbytes(height);
     writeln(' Cell width =',cell_width,' dots');
     writeln(' Cell height=',cell_height,' dots');
     writeln(' Font Pitch =',pitch,'/4 dots');
     writeln(' Font Height   =',height,'/4 dots');
     writeln(' Stroke Weight =',stroke+7,' (0..14, 7 normal)'); {signed}
     write('Font type: ');
     case font_type of
        0: write('7 bit');
        1: write('8 bit HP');
        2: write('8 bit IBM');
        else die('7/8 bit byte not 0,1 or 2');
        end; writeln;
     write('Font style: ');
     case style of
        0: write('upright');
        1: write('slanted');
        else write('neither upright nor slanted ',style);
        end; writeln;
     write('Orientation: ');
     case orientation of
        0:  write('portrait');
        1:  die  ('landscape---not supported');
{Landscape fonts have rasters sideways. Since it's highly unlikely
that someone has the landscape but not the portrait version of a
font, it just isn't worthwhile to rotate the raster}
        else die('orientation byte not 0 or 1');
        end; {orientation} writeln;
     write('Fixed/Prop: ');
     case fixed of
        0: write('fixed');
        1: write('proportional');
        else die('proportional byte not 0 or 1');
        end;
     writeln;
     write('Symbol set: (The hex is the PCL value): ');
     case symbol_set of
        $0100: write(' 0A  Math 7');
        $0200: write(' 0B  HP Line Draw');
        $0300: write(' 0C  Block characters');
        $0400: write(' 0D  Norwegian v1, ISO #60');
        $2400: write(' 1D  Norwegian v2, ISO #61');
        $0500: write(' 0E  HP Roman Ext');
        $2500: write(' 1E  United Kingdom, ISO #4');
        $0600: write(' 0F  French, ISO #25');
        $2600: write(' 1F  French, ISO #69');
        $0700: write(' 0G  HP German');
        $2700: write(' 1G  German, ISO #21');
        $0701: write(' 8G  HP Greek 8');
        $0800: write(' 0H  HP Hebrew 7');
        $0801: write(' 8H  HP Hebrew 8');
        $0900: write(' 0I  Italian, ISO #21');
        $0A00: write(' 0J  Currently Open');
        $0B00: write(' 0K  JIS ASCII, ISO #14');
        $2B00: write(' 1K  HP Katakana');
        $4B00: write(' 2K  Chinese, ISO #57');
        $0A01: write(' 8K  HP Kana 8');
        $2B01: write(' 9K  HP Korean 8');
        $0D01: write(' 8M  HP Math 8');
        $0E00: write(' 0N  ECMA-94 Latin 1, ISO #100');
        $2E00: write(' 1N  ECMA-94 Latin 2, ISO #101');
        $4E00: write(' 2N  ECMA-94 Latin 3, ISO #109');
        $6E00: write(' 3N  ECMA-94 Latin 4, ISO #110');
        $8E00: write(' 4N  ECMA Latin/Greek');
        $AE00: write(' 5N  ECMA Latin/Cyrillic');
        $CE00: write(' 6N  ECMA Latin/Arabic');
        $0F00: write(' 00  OCR-A');
        $2F00: write(' 10  OCR-B');
        $4F00: write(' 20  OCR-M');
        $1000: write(' 0P  APL (typewriter paired)');
        $3000: write(' 1P  APL (bit paired)');
        $1100: write(' 0Q  Reserved for Specials');
        $1200: write(' 0R  Cyrillic ASCII');
        $3200: write(' 1R  Cyrillic');
        $1300: write(' 0S  Swedish for Names, ISO #11');
        $3300: write(' 1S  HP Spanish');
        $5300: write(' 2S  Spanish, ISO #11');
        $7300: write(' 3S  Swedish, ISO #10');
        $9300: write(' 4S  Portugese, ISO #16');
        $B300: write(' 5S  Portugese, ISO #84');
        $D300: write(' 6S  Portugese, ISO #85');
        $1401: write(' 8T  HP Turkish 8');
        $1500: write(' 0U  ANSI US ASCII, ISO #6');
        $3500: write(' 1U  HP Legal');
        $5500: write(' 2U  Intl ref version, ISO #2');
        $B500: write(' 5U  HP HPL Language set');
        $1501: write(' 8U  HP Roman 8');
        $5501: write(' 10U IBM PC Set (US version)');
        $7501: write(' 11U IBM PC Set (Denmark/Norway version)');
        $9501: write(' 11U IBM PC Set');
        $F501: write(' 15U HP Pi font');
        $1600: write(' 0V  Arabic (Mackay)');
        $1601: write(' 8V  HP Arabic 8');
        $1900: write(' 0Y  3 of 9 bar code');
        $3900: write(' 1Y  Indus 2 of 5 bar code');
        $5900: write(' 2Y  Matrix 2 of 5 bar code');
        $9900: write(' 4Y  Interleaved 2 of 5 bar code');
        $B900: write(' 5Y  Coda bar code');
        $D900: write(' 6Y  MSI/Plessey bar code');
        $F900: write(' 7Y  Code II bar code');
        $1901: write(' 8Y  UPC/EAN bar code');
        else  write('Unknown symbol set ',symbol_set);
        end;
     writeln;
     write('Typeface code: ');
     case typeface of
       0: write('Line printer');
       1: write('Pica');
       2: write('Elite');
       3: write('Courier');
       4: write('Helvetica');
       5: write('Times Roman');
       6: write('Gothic');
       7: write('Script');
       8: write('Prestige');
       9: write('Caslon');
      10: write('Orator');
      11: write('Presentation');
      14: write('Swiss 721');
      15: write('Dutch 801');
      17: write('Optima');
      else write('Unknown Typeface code');
      end; {typeface code} writeln;
     end; {with}
{
 According to my HP docs, one should NOT put a copyright notice here.
 These bytes have some values assigned to them which are not used but
 will be used later. I think the best thing is to ignore them.
}
   if hdr_len>0 then skipjunk(hdr_len);
   end;

procedure ask_for_magn_and_design_size;
begin
{It is often the case that a 12-point HP font is actually the same as the
 10-point font scaled 1200. If this is the case, then you should tell the
 program that the magnification was indeed 1200. If you are not sure what
 is magnification and design size, just press enter in response to both
 questions. }
    magnification.high_half:=0;
    magnification.low_half:=1000; {default}
    writeln('Default magnification is 1000. If you are not sure what');
    writeln('magnification and design size are, just press enter ');
    writeln('in response to the next two questions.');
    write  ('Press enter or type another magnification:');
    readln (magnification.low_half);
    magn_scale:=1000.0/magnification.low_half; {for multiplication}
{Estimate TeX design size based on font height}
    design_size:=trunc((font1.height*3+25)*magn_scale) div 50;
    writeln('Suggested design size=',design_size,'pt (printer''s points)');
    write  ('Press enter or type another design size: ');
    readln (design_size);
    designsize.high_half:=16*design_size; {This is what will be stored to the
    .pxl file. It is a word measuring design size in fixes = 2^20
    times actual size. Set the lower half to zero (in initialization)
    and the high half to 2^4 times actual size.}
    designsize.low_half:=0;
{radix_scale is used to xlate radix points to fixes in set_tfm_widths
 for the .pxl file. Explanation: 72.27 pt/in / 1200 radix/in.
 the actual values in the next statement are from [72.27*100)/3]/[(1200*100)/3]
 which gives nice integer values to use when we upgrade to TP4 with longints.}
    radix_scale:=2409.0/design_size/40000.0*magn_scale;
    dot_scale:=radix_scale*4;
 end;


procedure read_char(var char_code: integer);
{
 get all of character's data
 save its width etc in pxl_dir
 copy its raster to pxl file
}
begin
{Get the char code and print message}
if not expect(hpfile,chr(27)+'*c') then begin
   char_code:=-1;
{we don't die but gracefully exit}
   writeln(' while looking for character specification sequence');
   end
else begin
  readn(hpfile,char_code,'E');
  if not char_code in [0..127] then
    die('PXL file cannot handle characters outside 0..127');
  write(' [',char_code,'] '); pchar(char_code);
  {Now read the character header}
  if not expect(hpfile,chr(27)+'(s') then
     die('while looking for char header');
  readn(hpfile,char_len,'W');
  reada(hpfile,char1,16);
  with char1,pxl_dir[char_code] do begin
    if orientation<>font1.orientation then
      die('orientation does not match');
    swapbytes(left_offset);
    swapbytes(top_offset);
    swapbytes(char_width);
    swapbytes(char_height);
    swapbytes(delta_x);
    {save the data in pxl array}
    pxl_width:=char_width;
    pxl_height:=char_height;
    x_offset:= -left_offset;
    y_offset:= top_offset;
    pointer:=pxl_ptr;
    if font1.fixed=1 then
      radix_width:=delta_x
    else
      radix_width:=font1.pitch;
    set_tfm_width(radix_width,tfm_width);
    end; {with}
  char_len:=char_len-16;
  if (char1.char_width=0) or (char1.char_height=0) then begin {happens!}
    if char_len>0 then skipjunk(char_len);
    pxl_dir[char_code].pointer:=zero_word;
    end
{The pxl file is written in 4 byte words. The HP file is in bytes, with the
high order bit of the first byte corresponding to the left upper pixel. Thus,
we at least don't have to re-order bytes, since the h.o.bit of word 0 of the
pxl file format is also the left-upper pixel. We do, however, have to pad out
the row to a multiple of 4 bytes. And don't forget to save the WORD count to
the pxl file, this is needed to fill in the font directory.}
   else begin {copy rows}
       byte_width:=(char1.char_width+7) shr 3{div 8}; {# bytes to read}
       l:=byte_width and 3{mod 4};
       if l>0 then
         l:=byte_width+4-l {padding required}
       else
         l:=byte_width;    {no padding required}
     for j:=byte_width+1 to l do
        buffer[j]:=0; {the padding}
     {copy pixels from hpfile to pxlfile, padding out the rows}
     for i:=1 to char1.char_height do begin
        reada(hpfile,buffer,byte_width);
        writea(pxlfile,buffer,l);
        char_len:=char_len-byte_width;
        if char_len<0 then die('Raster too short');
        end; {for i}
     if char_len>0 then skipjunk(char_len);
     {update pointer to pxlfile}
     {the following kludge should be replaced if you have
      longints (it won't even work in TP4, I believe)}
     i:=((l shr 2 {div 4})*char1.char_height); {#word written}
     {pxl_ptr:=pxl_ptr+i;}
     inline(
      $A1/>i                 {MOV AX,I}
     /$01/06/>pxl_ptr        {ADD pxl_ptr.low_half,AX}
     /$83/$16/>pxl_ptr+2/$00 {ADC pxl_ptr.high_half,+00}
     );
     end; {copy rows}
  writeln;
  end {if char};
end;

procedure write_pxl_dir(char_no: integer);
begin
   with pxl_dir[char_no] do begin;
      writear(pxlfile, pxl_width, 2);
      writear(pxlfile, pxl_height, 2);
      writear(pxlfile, x_offset, 2);
      writear(pxlfile, y_offset, 2);
      writear(pxlfile, pointer, 4);
      writear(pxlfile, tfm_width, 4);
      end;
   end;

procedure init_pl_file;
var
   space_width, x_height: real;
begin
   writeln(plfile,'(COMMENT THIS PL FILE WAS PRODUCED BY HP2TEX)');
   writeln(plfile,'(FAMILY HPSOFT)');
   writeln(plfile,'(DESIGNSIZE D ', design_size, ')');
   writeln(plfile,'(COMMENT DESIGNSIZE IS IN POINTS)');
   writeln(plfile,'(COMMENT OTHER SIZES ARE MULTIPLES OF DESIGNSIZE)');
   writeln(plfile,'(CHECKSUM O 0)');
   writeln(plfile,'(SEVENBITSAFEFLAG TRUE)');
   writeln(plfile,'(CODINGSCHEME ASCII)');
   writeln(plfile,'(FONTDIMEN');

   if font1.fixed=1 then begin
       {if there is a space char (ascii 32), use its width +50% -33%
       as the space stretch and skip values.  Mext guess is based on
       char x (ascii 120). If neither available, arbitrarily
       use values of 1/2, 1/4 and 1/6 of design size}

      if pxl_dir[32].pxl_width<>0 then
         space_width:=pxl_dir[32].radix_width*radix_scale
      else if pxl_dir[120].radix_width<>0 then begin
         writeln
         ('Font contains no space, using x for stretch and shrink');
        space_width:=pxl_dir[120].radix_width*radix_scale
         end
      else begin
         writeln
         ('Font contains no space or x, using 1/2 design size for font space');
         space_width:=0.5 {half the design size}
         end;
      writeln(plfile,'   (SPACE R ',space_width:10:6,')');
      writeln(plfile,'   (STRETCH R ',space_width/2:10:6, ')');
      writeln(plfile,'   (SHRINK R ',space_width/3:10:6, ')');
      writeln(plfile,'   (EXTRASPACE R ',space_width/3:10:6, ')');
      end
   else begin
      space_width:=font1.pitch*radix_scale;
      writeln(plfile,'   (SPACE R ',space_width:10:6,')');
      writeln(plfile,'   (STRETCH R 0)');
      writeln(plfile,'   (SHRINK R 0)');
      writeln(plfile,'   (EXTRASPACE R ',space_width:10:6, ')');
      end;
   writeln(plfile,'   (QUAD R ',space_width*2:10:6, ')');

   {look in table for x to get height of x (char 120)}
   if pxl_dir[120].pxl_height <> 0 then
      x_height:=pxl_dir[120].pxl_height*dot_scale
   else begin
      x_height:=0.75;
      writeln
  ('This font contains no x, using 3/4 design size for x-height');
      end;
   writeln(plfile,'   (XHEIGHT R ',x_height:10:6,')');
   writeln(plfile,'   )');
   end;

procedure write_pl_entry(char_no: integer);
var depth,italcorr:real;
begin
   with pxl_dir[char_no] do begin
      writeln(plfile,'(CHARACTER D ', char_no);
      writeln(plfile,'   (CHARWD R ',radix_width*radix_scale:10:6,')');
      writeln(plfile,'   (CHARHT R ',y_offset*dot_scale:10:6,')');
      italcorr:=(pxl_width*4-radix_width)*radix_scale;
      if italcorr>0 then begin
         if font1.style=1 then
           writeln(plfile,'   (CHARIC R ',italcorr:10:6,')')
         else
           writeln('Warning: upright font has nonzero CHARIC');
         end;
      depth:=(pxl_height-y_offset)*dot_scale;
      if depth>0 then
         writeln(plfile,'   (CHARDP R ',depth:10:6,')');
      writeln(plfile,'   )');
      end;
   end;

begin

hpbufptr:=2048;
hpbuflen:=0;
pxlbufptr:=1;

writeln('This is HP2TeX ver. 1.0');
writeln;
{Open the font file}
filename:=paramstr(1);
open_untyped_file
   (hpfile, filename,'sfp','r','Enter name of HP soft font file: ');

read_fontheader;

ask_for_magn_and_design_size;

{Open the new pxl file}
filename:=paramstr(2);
open_untyped_file
   (pxlfile, filename,'pxl','w','Enter name of pxl file to write: ');

{Open the new tfm file}
filename:=paramstr(3);
open_text_file(plfile, filename,'pl','w','Enter name of pl file to write: ');

{Write the id to the pxl file}
writear(pxlfile, pxlheader,4);
pxl_ptr.high_half:=0;
pxl_ptr.low_half :=1; {longint 1}

{Initialize the pxl directory table to all zeros}
fillchar(pxl_dir,2304,0);

char_code:=0;
while (not (eof(hpfile)and(hpbufptr>=hpbuflen))) and (char_code <>-1) do
  read_char(char_code);

if char_code=-1 then
  writeln(
  'This font file contains some junk at the end which I will ignore');

{Now we start the pl file work.}
writeln('Starting on pl file and pxl directory');

init_pl_file;
for i:=0 to 127 do begin
   write_pxl_dir(i);
   if pxl_dir[i].pxl_width<>0 then write_pl_entry(i);
   end;


{Finish up by writing a zero for the checksum (ignore checksum),
 the magnification,
 finally the design size times 2^20,
 a pointer to the directory,
 and the pxl header word}

writear(pxlfile, zero_word, 4);
writear(pxlfile, magnification, 4);
writear(pxlfile, designsize, 4);
writear(pxlfile, pxl_ptr, 4);
writear(pxlfile, pxlheader, 4);


close(hpfile);
closeout(pxlfile);
close(plfile);

writeln('All done');
end.