summaryrefslogtreecommitdiff
path: root/dviware/dviimp/dviimp.ch
diff options
context:
space:
mode:
authorNorbert Preining <norbert@preining.info>2019-09-02 13:46:59 +0900
committerNorbert Preining <norbert@preining.info>2019-09-02 13:46:59 +0900
commite0c6872cf40896c7be36b11dcc744620f10adf1d (patch)
tree60335e10d2f4354b0674ec22d7b53f0f8abee672 /dviware/dviimp/dviimp.ch
Initial commit
Diffstat (limited to 'dviware/dviimp/dviimp.ch')
-rw-r--r--dviware/dviimp/dviimp.ch1059
1 files changed, 1059 insertions, 0 deletions
diff --git a/dviware/dviimp/dviimp.ch b/dviware/dviimp/dviimp.ch
new file mode 100644
index 0000000000..9d6ede8d02
--- /dev/null
+++ b/dviware/dviimp/dviimp.ch
@@ -0,0 +1,1059 @@
+% 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