path: root/dviware/dviimp/dviimp.ch

%   Change file for the DVIIMP processor, for use on Berkeley UNIX systems.
%   It uses the pc compiler.  The resulting Pascal program must be run through
%   "pxp -O" to handle the "others" clauses in case statements.
%   This file was created by Howard Trickey.

% History:
%  6/25/85 (HWT)	Created, based on dvip.ch
%  7/10/85 (HWT)	Version 0.92
%  12/5/87 (PAM)	to Version 0.94
@x
% Here is TeX material that gets inserted after \input webmac
@y
\let\maybe=\iffalse
@z
@x
  \centerline{(Version 0.94, November 1987)}
@y
  \centerline{(Version 0.94, November 1987, for Berkeley UNIX)}
@z


@x banner
@d banner=='This is DVIIMP, Version 0.94' {printed when the program starts}
@y
@d banner=='This is DVIIMP, Version 0.94 for Berkeley UNIX'
    {printed when the program starts}
@z

@x debug..gubed
@d debug==@{ {change this to `$\\{debug}\equiv\null$' when debugging}
@d gubed==@t@>@} {change this to `$\\{gubed}\equiv\null$' when debugging}
@y
@d debug==@{
@d gubed==@t@>@}
@z

@x declare input file
@p program DVI_IMP(@!dvi_file,@!im_file,@!output);
@y
@p program DVI_IMP(@!dvi_file,@!im_file,@!input,@!output);
@z

@x Add inclusion of diext.h
procedure initialize; {this procedure gets things started properly}
@y
@#
@\@=#include "diext.h"@>@\ {declarations for external procedures}
procedure initialize; {this procedure gets things started properly}
@z

@x longer file names
@!name_length=50; {a file name shouldn't be longer than this}
@y
@!name_length=100; {a file name shouldn't be longer than this}
@z

@x Change jump_out to an exit(1) (so we can test exit status)
@p procedure jump_out;
begin goto final_end;
end;
@y
@d UNIX_exit==e@&x@&i@&t {Tangle trick}

@p procedure jump_out;
begin print_ln(' '); UNIX_exit(1);
end;
@z

@x Change definition of 'byte_file' to correct subrange
We shall stick to simple \PASCAL\ in this program, for reasons of clarity,
even if such simplicity is sometimes unrealistic.

@<Types...@>=
@!eight_bits=0..255; {unsigned one-byte quantity}
@!byte_file=packed file of eight_bits; {files that contain binary data}
@y
On Berkeley {\mc UNIX}, we have to use |-128..127| for byte files, as
explained in the \TeX\ changes.

@<Types...@>=
@!eight_bits=0..255; {unsigned one-byte quantity}
@!byte_file=packed file of -128..127; {files that contain binary data}
@z

@x get rid of read_f, read_n, and read_c
@ The following procedures will be needed.

@p function read_int:integer;
var i:integer;
@!neg_flag:boolean;
begin
neg_flag:=false; i:=0;
get(tty);
while tty^=' ' do get(tty);
if (tty^='-') then neg_flag:=true;
while (tty^='-') or (tty^='+') do get(tty);
while (tty^>='0') and (tty^<='9') do begin
    i:=i*10+xord[tty^]-"0"; get(tty);
    end;
if neg_flag then i:=-i;
read_int:=i;
end;
@#
procedure read_f;
begin
start_page:=read_int;
f_flag:=true;
end;
@#
procedure read_n;
begin
num_pages:=read_int;
if num_pages=0 then num_pages:=max_pages;
n_flag:=true;
end;
@#
procedure read_c;
begin
copies:=read_int;
end;
@#
procedure read_h;
begin
h_org:=read_int;
end;
@#
procedure read_v;
begin
v_org:=read_int;
end;
@y
@ The command line parsing is done elsewhere in the Berkeley UNIX version,
since it takes many modules, so we use this module to declare some
procedures.
@p
@<|scan_args|> procedure@>@/
@<|output_im_preamble| procedure@>
@z

@x Fix up opening the binary files
@p procedure open_dvi_file; {prepares to read packed bytes in |dvi_file|}
begin reset(dvi_file);
cur_loc:=0;
end;
@#
procedure open_gf_file; {prepares to read packed bytes in |gf_file|}
begin reset(gf_file,cur_name);
cur_gf_loc:=0;
end;
@#
procedure open_tfm_file; {prepares to read packed bytes in |tfm_file|}
begin reset(tfm_file,cur_tfm_name);
end;
@y
We use the external |test_access| procedure to find
out if a file whose name is |cur_name|
is accessible before attempting to open it.
It also does path searching, based on the user's environment or the
default path.
The |open_tfm_file| procedure is changed into a function that returns
false if the open fails.
The |open_dvi_file| and |open_gf_file| procedures need to set up the
global |eof_dvi_file| and |eof_gf_file| variables (used for efficiency).
The latter follows the convention that |eof_gf_file| is set if the
open fails.  If the \.{DVI} file can't be opened, we just quit here.

@d read_access_mode=4  {``read'' mode for |test_access|}
@d write_access_mode=2 {``write'' mode for |test_access|}

@d no_file_path=0    {no path searching should be done}
@d font_file_path=3  {path specifier for \.{TFM} and \.{GF} files}

@p procedure open_dvi_file; {prepares to read packed bytes in |dvi_file|}
var i:integer;
begin 
    for i:=1 to name_length do
	cur_name[i]:=dvi_file_name_chars[i];
    if test_access(read_access_mode,no_file_path) then begin
	reset(dvi_file,real_name_of_file);
	eof_dvi_file:=false;
	end
    else begin
	write_ln('Cannot read dvi file');
	UNIX_exit(1);
	end;
cur_loc:=0;
end;
@#
procedure open_gf_file; {prepares to read packed bytes in |gf_file|}
begin 
    if test_access(read_access_mode,font_file_path) then begin
	reset(gf_file,real_name_of_file);
	eof_gf_file:=false;
	end
    else
	eof_gf_file:=true;
    cur_gf_loc:=0;
end;
@#
function open_tfm_file:boolean; {prepares to read packed bytes in |tfm_file|}
var i:integer;
begin
    for i:=1 to name_length do
	cur_name[i]:=cur_tfm_name[i];
    if test_access(read_access_mode,font_file_path) then begin
	reset(tfm_file,real_name_of_file);
	open_tfm_file:=true;
	end
    else
	open_tfm_file:=false;
end;
@z

@x opening im_file
@p procedure open_im_file; {prepares to write packed bytes in |im_file|}
begin rewrite(im_file); im_byte_no:=0;
end;
@y
@p procedure open_im_file; {prepares to write packed bytes in |im_file|}
var i:integer;
begin
    for i:=1 to name_length do
	cur_name[i]:=im_file_name_chars[i];
    if test_access(write_access_mode,no_file_path) then
	rewrite(im_file, real_name_of_file)
    else begin
	write_ln('Cannot create impress file');
	UNIX_exit(1);
	end;
    im_byte_no:=0;
end;
@z

@x Declare real_name_of_file.
@!cur_name:packed array[1..name_length] of char; {external name,
  with no lower case letters}
@y
@!cur_name:packed array[1..name_length] of char; {external name,
  with no lower case letters}
@!real_name_of_file:packed array[1..name_length] of char; {filled by
  the external |test_access| procedure: it is |cur_name|
  with a path prepended}
@z

@x Fix gf getting functions
@p function gf_byte:integer; {returns the next byte, unsigned}
var b:eight_bits;
begin if eof(gf_file) then gf_byte:=0
else  begin read(gf_file,b); incr(cur_gf_loc); gf_byte:=b;
  end;
end;
@#
function gf_two_bytes:integer; {returns the next two bytes, unsigned}
var a,@!b:eight_bits;
begin read(gf_file,a); read(gf_file,b);
cur_gf_loc:=cur_gf_loc+2;
gf_two_bytes:=a*256+b;
end;
@#
function gf_three_bytes:integer; {returns the next three bytes, unsigned}
var a,@!b,@!c:eight_bits;
begin read(gf_file,a); read(gf_file,b); read(gf_file,c);
cur_gf_loc:=cur_gf_loc+3;
gf_three_bytes:=(a*256+b)*256+c;
end;
@#
function gf_signed_quad:integer; {returns the next four bytes, signed}
var a,@!b,@!c,@!d:eight_bits;
begin read(gf_file,a); read(gf_file,b); read(gf_file,c); read(gf_file,d);
cur_gf_loc:=cur_gf_loc+4;
if a<128 then gf_signed_quad:=((a*256+b)*256+c)*256+d
else gf_signed_quad:=(((a-256)*256+b)*256+c)*256+d;
end;
@y
For UNIX, use external |@!gf_byte|, etc., procedures.
Use this module to declare the |eof_gf_file| variable that will be set
by those procedures.

@<Globals...@>=
@!eof_gf_file:boolean; {|true| when \.{.GF} file has ended}
@z

@x Fix read_tfm_word to read bytes properly
@p procedure read_tfm_word;
begin read(tfm_file,b0); read(tfm_file,b1);
read(tfm_file,b2); read(tfm_file,b3);
end;
@y
@d get_tfm_byte(#) ==
    read(tfm_file,byte); if byte < 0 then # := byte + 256 else # := byte;

@p procedure read_tfm_word;
var byte : -128..127;
begin
get_tfm_byte(b0);
get_tfm_byte(b1);
get_tfm_byte(b2);
get_tfm_byte(b3);
end;
@z

@x Fix up functions to read DVI bytes
@p function get_byte:integer; {returns the next byte, unsigned}
var b:eight_bits;
begin if eof(dvi_file) then get_byte:=0
else  begin read(dvi_file,b); incr(cur_loc); get_byte:=b;
  end;
end;
@#
function signed_byte:integer; {returns the next byte, signed}
var b:eight_bits;
begin read(dvi_file,b); incr(cur_loc);
if b<128 then signed_byte:=b @+ else signed_byte:=b-256;
end;
@#
function get_two_bytes:integer; {returns the next two bytes, unsigned}
var a,@!b:eight_bits;
begin read(dvi_file,a); read(dvi_file,b);
cur_loc:=cur_loc+2;
get_two_bytes:=a*256+b;
end;
@#
function signed_pair:integer; {returns the next two bytes, signed}
var a,@!b:eight_bits;
begin read(dvi_file,a); read(dvi_file,b);
cur_loc:=cur_loc+2;
if a<128 then signed_pair:=a*256+b
else signed_pair:=(a-256)*256+b;
end;
@#
function get_three_bytes:integer; {returns the next three bytes, unsigned}
var a,@!b,@!c:eight_bits;
begin read(dvi_file,a); read(dvi_file,b); read(dvi_file,c);
cur_loc:=cur_loc+3;
get_three_bytes:=(a*256+b)*256+c;
end;
@#
function signed_trio:integer; {returns the next three bytes, signed}
var a,@!b,@!c:eight_bits;
begin read(dvi_file,a); read(dvi_file,b); read(dvi_file,c);
cur_loc:=cur_loc+3;
if a<128 then signed_trio:=(a*256+b)*256+c
else signed_trio:=((a-256)*256+b)*256+c;
end;
@#
function signed_quad:integer; {returns the next four bytes, signed}
var a,@!b,@!c,@!d:eight_bits;
begin read(dvi_file,a); read(dvi_file,b); read(dvi_file,c); read(dvi_file,d);
cur_loc:=cur_loc+4;
if a<128 then signed_quad:=((a*256+b)*256+c)*256+d
else signed_quad:=(((a-256)*256+b)*256+c)*256+d;
end;
@y
For UNIX, use external |@!get_byte|, etc., procedures.
Use this module to declare the |eof_dvi_file| variable that will be set
by those procedures.

@<Globals...@>=
@!eof_dvi_file:boolean; {|true| when DVI file has ended}
@z

@x Change impress file writing procedures
@d im_byte(#)==begin write(im_file,#);
 incr(im_byte_no); end

@p procedure im_sbyte(@!w:integer);
begin
if w<0 then w:=w+@"100;
im_byte(w);
end;
@#
procedure im_halfword(@!w:integer);
begin
if w<0 then w:=w+@"10000;
im_byte(w div @"100);
im_byte(w mod @"100);
end;
@y
External C procedures are used for writing the impress file, but
|im_sbyte| is the same as |im_byte|.

@d im_sbyte(#)==im_byte(#)
@z

@x
@ Having found the |gf_postamble|, we must now read it and stow the
data away as as halfwords as required later by \.{IMAGEN}.
@y
@ Having found the |gf_postamble|, we must now read it and stow the
data away as as halfwords as required later by \.{IMAGEN}.
We define |other_gf_cases| to be those \.{GF} commands not expected
during the processing of glyphs, so that the |othercases| clause can
be removed from several critical places below.
The method used on UNIX to get rid of |othercases| clauses produces
incredibly awful code when the number of default cases is large enough
that a bit-set test membership can't be generated.

@d other_gf_cases==paint2+1,boc,boc1,skip2,skip2+1,char_loc,246,247,248,249,
	250,251,252,253,254,255
@z

LINE 1950
@x eof(gf_file)
while not eof(gf_file) do m:=gf_byte; {to close out file}
@y
while not eof_gf_file do m:=gf_byte; {to close out file}
@z

@x remove othercases from in_gf (pxp -O causes bad code here)
  eoc: goto done;
  othercases
    print_ln('! Unexpected command: ',o:1)
@y
  eoc: goto done;
  other_gf_cases:
    print_ln('! Unexpected command: ',o:1)
@z

LINE 2580
@x Define term_in and term_out
and |term_out| for terminal output.
@^system dependencies@>

@<Glob...@>=
@!buffer:array[0..terminal_line_length] of ASCII_code;
@!term_in:text_file; {the terminal, considered as an input file}
@!term_out:text_file; {the terminal, considered as an output file}
@y
and |term_out| for terminal output.
@^system dependencies@>

@d term_in==input
@d term_out==output

@<Glob...@>=
@!buffer:array[0..terminal_line_length] of ASCII_code;
@z

@x Define update_terminal
@d update_terminal == break(term_out) {empty the terminal output buffer}
@y
@d update_terminal == flush(term_out) {empty the terminal output buffer}
@z

LINE 2610
@x Remove call to reset(term_in)
begin update_terminal; reset(term_in);
@y
begin update_terminal;
@z

LINE 2918
@x
if eof(gf_file) then
@y
if eof_gf_file then
@z

LINE 2927
@x open_tfm_file is a function
    open_tfm_file;
    if eof(tfm_file) then
@y
    if not open_tfm_file then
@z

LINE 2940
@x Set default_directory_name
@d default_directory_name=='TeXGFs:' {change this to the correct name}
@d default_directory_name_length=7 {change this to the correct length}
@d dflt_tfm_directory_name=='TeXfonts:' {change this to the correct name}
@d dflt_tfm_directory_name_length=9 {change this to the correct length}

@<Glob...@>=
@!default_directory:packed array[1..default_directory_name_length] of char;
@!dflt_tfm_directory:packed array[1..dflt_tfm_directory_name_length] of char;
@y
Actually, under UNIX the standard area is defined in an external
``texpaths.h'' file.  And the user has a path serached for fonts,
by setting the TEXFONTS environment variable.
@z

@x don't need to initialize now-deleted default directories
@ @<Set init...@>=
default_directory:=default_directory_name;
dflt_tfm_directory:=dflt_tfm_directory_name;
@y
@ (Deleted module).
@z

LINE 2980
@x GF files don't get directories prepended, and stay lowercase
\.{GF} file for the current font. This usually means that we need to
prepend the name of the default directory, and
to append the suffix `\.{.GF}'. Furthermore, we change lower case letters
to upper case, since |cur_name| is a \PASCAL\ string.
@^system dependencies@>

@<Move font name into the |cur_name| string@>=
for k:=1 to name_length do cur_name[k]:=' ';
if p=0 then
  begin for k:=1 to default_directory_name_length do
    cur_name[k]:=default_directory[k];
  r:=default_directory_name_length;
  end
else r:=0;
for k:=font_name[cur_font] to font_name[cur_font+1]-1 do
  begin incr(r);
  if r+4>name_length then
    abort('DVIIMP capacity exceeded (max font name length=',
      name_length:1,')!');
@.DVIIMP capacity exceeded...@>
  if (names[k]>="a")and(names[k]<="z") then
      cur_name[r]:=xchr[names[k]-@'40]
  else cur_name[r]:=xchr[names[k]];
  end;
cur_name[r+1]:='.'; cur_name[r+2]:='G'; cur_name[r+3]:='F';
{|cur_name[r+4]:='M';|}
@y
\.{GF} file for the current font. The directory name will be prepended by
|test_access|.
As at {\mc SAIL}, we use the overall font magnification as the extension,
using a funny scheme where the magnification 999 is followed by :00
(since `:' comes after 9 in the ASCII sequence).
@^system dependencies@>

@<Move font name into the |cur_name| string@>=
for k:=1 to name_length do cur_name[k]:=' ';
r:=0;
for k:=font_name[cur_font] to font_name[cur_font+1]-1 do
  begin incr(r);
  if r+6>name_length then
    abort('DVIIMP capacity exceeded (max font name length=',
      name_length:1,')!');
@.DVIIMP capacity exceeded...@>
  cur_name[r]:=xchr[names[k]];
  end;
m:=font_m_val[cur_font];
cur_name[r+1]:='.';
cur_name[r+2]:=xchr[m div 100+@'60];
cur_name[r+3]:=xchr[(m mod 100) div 10+@'60];
cur_name[r+4]:=xchr[m mod 10+@'60];
cur_name[r+5]:='g';
cur_name[r+6]:='f';
@z

@x finding TFM files;  no default directory
The following module takes care of setting the external name of this
\.{TFM} file.

@<Move font name into the |cur_tfm_name| string@>=
for k:=1 to name_length do cur_tfm_name[k]:=' ';
if p=0 then
  begin for k:=1 to dflt_tfm_directory_name_length do
    cur_tfm_name[k]:=dflt_tfm_directory[k];
  r:=dflt_tfm_directory_name_length;
  end
else r:=0;
for k:=font_name[cur_font] to font_name[cur_font+1]-1 do
  begin incr(r);
  if r+4>name_length then
    abort('DVIIMP capacity exceeded (max font name length=',
      name_length:1,')!');
@.DVIIMP capacity exceeded...@>
  if (names[k]>="a")and(names[k]<="z") then
      cur_tfm_name[r]:=xchr[names[k]-@'40]
  else cur_tfm_name[r]:=xchr[names[k]];
  end;
cur_tfm_name[r+1]:='.'; cur_tfm_name[r+2]:='T';
cur_tfm_name[r+3]:='F'; cur_tfm_name[r+4]:='M';

@y
The following module takes care of setting the external name of this
\.{TFM} file.

@<Move font name into the |cur_tfm_name| string@>=
for k:=1 to name_length do cur_tfm_name[k]:=' ';
r:=0;
for k:=font_name[cur_font] to font_name[cur_font+1]-1 do
  begin incr(r);
  if r+4>name_length then
    abort('DVIIMP capacity exceeded (max font name length=',
      name_length:1,')!');
@.DVIIMP capacity exceeded...@>
  cur_tfm_name[r]:=xchr[names[k]];
  end;
cur_tfm_name[r+1]:='.'; cur_tfm_name[r+2]:='t';
cur_tfm_name[r+3]:='f'; cur_tfm_name[r+4]:='m';
@z

@x update_terminal after printing page number
    do_page; print('[',count[0]:1,'] ');
@y
    do_page; print('[',count[0]:1,'] '); update_terminal;
@z

LINE 3752
@x
if eof(dvi_file) then bad_dvi('the file ended prematurely');
@y
if eof_dvi_file then bad_dvi('the file ended prematurely');
@z

LINE 3769
@x fix case statement in dopage so that othercases isn't needed
if o<set_char_0+128 then goto fin_set
else case o of
@y
if o<set_char_0+128 then goto fin_set
else if o<down1 then case o of
@z

@x continue previous change
  othercases begin special_cases(o,p,a); goto done; end
  endcases
@y
  endcases
else begin special_cases(o,p,a); goto done; end
@z

@x Remove need for othercases from special_cases (lower test done at call)
case o of
@t\4@>@<Cases for vertical motion@>@;
@y
if o<=post_post then
  case o of
  @t\4@>@<Cases for vertical motion@>@;
@z

@x
othercases bad_dvi('undefined command ',o:1,'!')
@.undefined command@>
endcases;
@y
  endcases
else
  bad_dvi('undefined command ',o:1,'!');
@.undefined command@>
@z

LINE 4176
@x scan_args
@p begin initialize; {get all variables initialized}
@y
@p begin initialize; {get all variables initialized}
    scan_args;
@z

LINE 4178
@x file and user id preamble to impress file (vars are set by set_paths_
open_im_file;
@y
open_im_file;
output_im_preamble;
@z

LINE 4182
@x new-line before exit and exit(0)
final_end:end.
@y
print_ln(' ');
UNIX_exit(0);
final_end:end.
@z

@x fix header-printing bug (is it realy a bug, or just unix?)
  begin incr(p); id[p]:=get_byte;
@y
  begin id[p]:=get_byte; incr(p);
@z

@x Extra declarations.
This section should be replaced, if necessary, by changes to the program
that are necessary to make \.{DVIIMP} work at a particular installation.
It is usually best to design your change file so that all changes to
previous sections preserve the section numbering; then everybody's version
will be consistent with the printed program. More extensive changes,
which introduce new sections, can be inserted here; then only the index
itself will get a new section number.
@^system dependencies@>
@y
Here is the stuff for command line processing.
@^system dependencies@>

@<Glob...@>=
@!num_copies:integer;
@!print_impress_header,insert_grant_name:boolean;
@!dvi_file_name_chars,
@!grant_name,
@!im_file_name_chars:packed array [1..name_length] of char;
	{string form of file names}

@ The |scan_args| procedure looks at the command line arguments and sets
the file name variables accordingly.
At least one file name must be present: the \.{DVI} file.  It may have
an extension, or it may omit it to get |'.dvi'| added.
The \.{IMPRESS} output file name is formed by replacing the \.{DVI} file
name extension by |'.im'|.

An argument beginning with a minus sign is a flag.
Any letters following the minus sign may cause global flag variables to be
set.
A |-i| means the next argument should be used as the \.{IMPRESS} file.
A |-f| means the next argument is the first page to print.
A |-n| means the next argument is the number of pages to print.
A |-c| means the next argument is the number of copies of the document to produce.
A |-h| means do not print the header page.
A |-g| means insert the next argument into the "grant" field of the document header.

@<|scan_args|...@>=
@<|usage_error| procedure@>@/
@<|getargint| function@>
@#
procedure scan_args;
var dot_pos,i,a: integer; {indices}
@!fname: array[1..name_length] of char; {temporary argument holder}
@!found_dvi,@!found_im: boolean; {|true| when that file name has been seen}
begin
setpaths; {read environment, to find TEXFONTS, if there}
found_dvi:=false;
found_im:=false;
print_impress_header:=true;
insert_grant_name:=false;
num_copies:=1;
a:=1;
while a<argc do begin
        argv(a,fname); {put argument number |a| into |fname|}
        if fname[1]<>'-' then begin
                if not found_dvi then
                        @<Get |dvi_file_name_chars| and
			 |im_file_name_chars| variables from |fname|@>
                else  usage_error;
                end
        else @<Handle flag argument in |fname|@>;
	incr(a);
        end;
if not found_dvi then usage_error;
end;

@ Use all of |fname| for the |dvi_file_name_chars| if there is a |'.'| in it,
otherwise add |'.dvi'|.
The impress file name comes from adding things after the dot.
The |argv| procedure will not put more than |max_file_name_length-5|
characters into |fname|, and this leaves enough room in the |file_name|
variables to add the extensions.

The end of a file name is marked with a |' '|, the convention assumed by 
the |reset| and |rewrite| procedures.

@<Get |dvi_file_name_chars|...@>=
begin
dot_pos:=-1;
i:=1;
while (fname[i]<>' ') and (i<=name_length-5) do begin
        dvi_file_name_chars[i]:=fname[i];
        if fname[i]='.' then dot_pos:=i;
        incr(i);
        end;
if dot_pos=-1 then begin
        dot_pos:=i;
        dvi_file_name_chars[dot_pos]:='.';
        dvi_file_name_chars[dot_pos+1]:='d';
        dvi_file_name_chars[dot_pos+2]:='v';
        dvi_file_name_chars[dot_pos+3]:='i';
        dvi_file_name_chars[dot_pos+4]:=' ';
        end
    else dvi_file_name_chars[i] := ' '; {terminate string}
if not found_im then begin
    for i:=1 to dot_pos do begin
        im_file_name_chars[i]:=dvi_file_name_chars[i];
        end;
    im_file_name_chars[dot_pos+1]:='i';
    im_file_name_chars[dot_pos+2]:='m';
    im_file_name_chars[dot_pos+3]:=' ';
    end;
found_dvi:=true;
end

@  @<Handle flag...@>=
begin
case fname[2] of
    'i':begin
	incr(a);
	if found_im or(a>=argc) then usage_error;
	argv(a,fname); {use next argument as impress file name}
	i:=1;
	while (fname[i]<>' ') and (i<=name_length-7) do begin
	    im_file_name_chars[i]:=fname[i];
	    incr(i);
	    end;
	im_file_name_chars[i]:=' ';
	found_im:=true;
	end;
    'f':begin
	incr(a);
	start_page:=getargint(a);
	f_flag:=true;
	end;
    'n':begin
	incr(a);
	num_pages:=getargint(a);
	n_flag:=true;
	end;
    'c':begin
	incr(a);
	num_copies:=getargint(a);
	end;
    'h':begin
        print_impress_header:=false;
	end;
    'g':begin
        incr(a);
	if (a >= argc) then usage_error;
	argv(a,grant_name);
        insert_grant_name:=true;
	end;
    othercases
	usage_error;
    endcases;
end

@ This function scans argv(argno) for an integer, and returns it, but
prints the usage error and quits if there is no integer there.
@<|getargint| function@>=
function getargint(argno:integer):integer;
var argbuf:array[1..name_length] of char;@/
    i,d,sign,n:integer;@/
begin
    if argno>=argc then
	usage_error;
    argv(argno,argbuf);
    i:=1;
    if (argbuf[i]='-') then sign:=-1 @+else sign:=1;
    if (argbuf[i]='+')or(argbuf[i]='-') then i:=i+1;
    n:=0;
    d:=ord(argbuf[i])-ord('0');
    while (0<=d)and(d<=9) do begin
	n:=10*n + d;
	i:=i+1;
	d:=ord(argbuf[i])-ord('0');
	end;
    if i=1 then
	usage_error;
    getargint:=sign*n;
end;

@ If there is a mistake in the arguments, print a usage message and quit.

@<|usage_error| procedure@>=
procedure usage_error;
begin
print_ln('Usage: dviimp dvifile[.dvi] options');
print_ln('   -i file       specify Impress output file');
print_ln('   -c N          produce N copies');
print_ln('   -h            suppress Impress header sheet');
print_ln('   -n N          print N pages');
print_ln('   -f N          begin at page N');
print_ln('   -g grant      insert grant accounting field');
UNIX_exit(1);
end;

@ The external procedure |set_user_name| fills these variables,
used in the following |output_im_preamble| procedure.
@<Glob...@>=
@!user_name:packed array[1..name_length] of char;
	{name of user who called this program}
@!len_user_name:integer; {the amount actually used}
@!host_name:packed array[1..name_length] of char;
@!len_host_name:integer;

@ Here is a procedure to put some identifying characters at the beginning
of the \.{IMPRESS} file.
@<|output_im_preamble| procedure@>=
procedure im_pos_integer(i:integer);
   begin
   if i > 0 then begin
       im_pos_integer(i div 10);
       im_byte(i mod 10+ord('0'));
   end;
end;
procedure im_integer(i:integer);
   begin
   if i < 0 then begin
   im_byte("-");
   i := -i;
   end;
   if i > 0
   then im_pos_integer(i)
   else im_byte("0");   
end;
procedure output_im_preamble;
var i:integer;
begin
im_byte("@@");
im_byte("d");
im_byte("o");
im_byte("c");
im_byte("u");
im_byte("m");
im_byte("e");
im_byte("n");
im_byte("t");
im_byte("(");

im_byte("p");
im_byte("a");
im_byte("g");
im_byte("e");
im_byte("r");
im_byte("e");
im_byte("v");
im_byte("e");
im_byte("r");
im_byte("s");
im_byte("a");
im_byte("l");
im_byte(" ");
im_byte("o");
im_byte("f");
im_byte("f");
im_byte(",");
im_byte(" ");

im_byte("p");
im_byte("a");
im_byte("g");
im_byte("e");
im_byte("c");
im_byte("o");
im_byte("l");
im_byte("l");
im_byte("a");
im_byte("t");
im_byte("i");
im_byte("o");
im_byte("n");
im_byte(" ");
im_byte("o");
im_byte("f");
im_byte("f");
im_byte(",");
im_byte(" ");



im_byte("l");
im_byte("a");
im_byte("n");
im_byte("g");
im_byte("u");
im_byte("a");
im_byte("g");
im_byte("e");
im_byte(" ");
im_byte("i");
im_byte("m");
im_byte("P");
im_byte("r");
im_byte("e");
im_byte("s");
im_byte("s");
im_byte(",");
im_byte(" ");

if not print_impress_header then begin
   im_byte("j");
   im_byte("o");
   im_byte("b");
   im_byte("h");
   im_byte("e");
   im_byte("a");
   im_byte("d");
   im_byte("e");
   im_byte("r");
   im_byte(" ");
   im_byte("o");
   im_byte("f");
   im_byte("f");
   im_byte(",");
   end;

if insert_grant_name then begin
   im_byte("G");
   im_byte("r");
   im_byte("a");
   im_byte("n");
   im_byte("t");
   im_byte(" ");
   im_byte("""");
   i:=1;
   while (grant_name[i]<>' ') do
	   begin im_byte(xord[grant_name[i]]); incr(i);
   	   end;
   im_byte("""");
   im_byte(",");
   end;

if num_copies > 1 then begin
   im_byte("c");
   im_byte("o");
   im_byte("p");
   im_byte("i");
   im_byte("e");
   im_byte("s");
   im_byte(" ");
   im_integer(num_copies);
   im_byte(",");
   end;

im_byte("O");
im_byte("w");
im_byte("n");
im_byte("e");
im_byte("r");
im_byte(" ");
im_byte("""");
setusername;
for i:=1 to len_user_name do im_byte(xord[user_name[i]]);
im_byte("""");
im_byte(",");

sethostnam;
if len_host_name > 0 then begin
   im_byte("H");
   im_byte("o");
   im_byte("s");
   im_byte("t");
   im_byte(" ");
   im_byte("""");
   for i:=1 to len_host_name do im_byte(xord[host_name[i]]);
   im_byte("""");
   im_byte(",");
   end;

im_byte("N");
im_byte("a");
im_byte("m");
im_byte("e");
im_byte(" ");
im_byte("""");
i:=1;
while (dvi_file_name_chars[i]<>' ') do
	begin im_byte(xord[dvi_file_name_chars[i]]); incr(i);
	end;
im_byte("""");
im_byte(",");
im_byte("D");
im_byte("V");
im_byte("I");
im_byte("-");
im_byte("i");
im_byte("d");
im_byte(" ");
im_byte("""");
for p:=1 to id_len do im_byte(id[p]);
im_byte("""");
im_byte(")");
end;
@z