diff options
author | Norbert Preining <norbert@preining.info> | 2019-09-02 13:46:59 +0900 |
---|---|---|
committer | Norbert Preining <norbert@preining.info> | 2019-09-02 13:46:59 +0900 |
commit | e0c6872cf40896c7be36b11dcc744620f10adf1d (patch) | |
tree | 60335e10d2f4354b0674ec22d7b53f0f8abee672 /dviware/dviimp/dviimp.ch |
Initial commit
Diffstat (limited to 'dviware/dviimp/dviimp.ch')
-rw-r--r-- | dviware/dviimp/dviimp.ch | 1059 |
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 |