path: root/dviware/vutex/cp6.chg

 CP6 changes file for the ASCII driver written by Warren Wolfe, Dec 10, 1987
 Copyright 1987 CUBE Software, Victoria, B.C., Canada

@x [2]
@d banner=='This is ',clone,', Version 1.00'
@y
@d banner=='This is ',clone,', DPS8/CP6 Version 1.00'
@z

@x [3]
@d othercases == others: {default for cases not listed explicitly}
@y
@d othercases == otherwise {CP6 default for cases not listed explicitly}
@z

@x [4] add tfm_file,gen_input,and input to program header
@p program vutex(dvi_file,bit_file,input,output);
label @<Labels in the outer block@>@/
const @<Constants in the outer block@>@/
type @<Types in the outer block@>@/
var @<Globals in the outer block@>@/
procedure initialize; {this procedure gets things started properly}
  var i:integer; {loop index for initializations}
  begin print_ln(banner);@/
  @<Set initial values@>@/
  end;
@y
@p program vutex(dvi_file,bit_file,tfm_file,gen_input,input,output);
label @<Labels in the outer block@>@/
const @<Constants in the outer block@>@/
type @<Types in the outer block@>@/
var @<Globals in the outer block@>@/
@<DPS8/CP-6 procedures@>@/
procedure initialize; {this procedure gets things started properly}
  var i:integer; {loop index for initializations}
  begin open_output ;  { must explicitly open output }
  print_ln(banner);@/
  @<Set initial values@>@/
  end;
@z

@x [9]
@!ASCII_code=" ".."~"; {a subrange of the integers}
@y
@!ASCII_code=0.."~"; {a subrange of the integers}
@z

@x [10]
@!text_file=packed file of text_char;
@y
@!text_file=text;
@z

@x [30]
@!byte_file=packed file of eight_bits; {files that contain binary data}
@!word_file=packed file of integer; {for pixel file words}
@y
{later we'll define files that contain binary data}
@z

@x [31] fix defn of dvi_file and pxl_file, add tfm_file,bit_file
@<Glob...@>=
@!dvi_file:byte_file; {the stuff we are \.{DVI}typing}
@!tfm_file:byte_file; {a font metric file}
@y
@<Glob...@>=
@!dvi_file:packed file of block; {the stuff we are \.{DVI}typing}
@!tfm_file:packed file of block; {a font metric file}
@!dvi_count:integer; {number of bytes read from current block of |dvi_file|}
@!tfm_count:integer; {number of bytes read from current block of |tfm_file|}
@!eof_tfm:boolean;  { true when end of \.{TFM} file reached }
@z

@x [32] fix up opens and closes
@ To prepare these files for input, we |reset| them. An extension of
\PASCAL\ is needed in the case of |tfm_file|, since we want to associate
it with external files whose names are specified dynamically (i.e., not
known at compile time). The following code assumes that `|reset(f,s)|'
does this, when |f| is a file variable and |s| is a string variable that
specifies the file name. If |eof(f)| is true immediately after
|reset(f,s)| has acted, we assume that no file named |s| is accessible.
@^system dependencies@>

@p procedure open_dvi_file; {prepares to read packed bytes in |dvi_file|}
begin reset(dvi_file);
cur_loc:=0;
end;
@#
procedure reopen_dvi_file; {reopens the |dvi_file| for the next scan}
begin reset(dvi_file);
cur_loc:=0;
end;
@#
procedure open_bit_file;  {prepares final output for writing}
begin rewrite(bit_file);
bit_is_open := true ;
end;
@#
procedure open_tfm_file; {opens \.{TFM} file}
begin reset(tfm_file,cur_name);
eof_tfm := eof(tfm_file);
end;
@#
procedure open_input_text ; {prepares to read from general purpose input}
begin reset(gen_input, cur_name) ;
end ;
@y
@ To prepare these files for input, we |reset| them. An extension of \PASCAL\ is
needed in the case of |tfm_file|, since we want to associate it with external
files whose names are specified dynamically (i.e., not known at compile time).
On CP6, we use the |set_file_parameter| extension to name the file before it is
|reset|. We also turn on FSFA for better performance.  This means output files
must be explicitly closed. If |eof(f)| is true immediately after |reset(f)| has
acted, we assume that no file named |s| is accessible.
@^system dependencies@>

@d close_file == @= close_file@>
@d close_bit_file == close_file(bit_file)
@d close_tfm_file == close_file(tfm_file)
@d close_input_text == close_file(gen_input)
@d set_file_parameters== @= set_file_parameters @>
@d file_status == @= file_status @>

@p procedure open_output; @= {explicitly opens output to assign the dcb to #4}@>
begin close_file(output) ;
set_file_parameters(output,'  ',@='dcb=#4'@>) ;
rewrite(output) ; end ;

procedure open_dvi_file; {prepares to read packed bytes in |dvi_file|}
begin set_file_parameters(dvi_file,'  ',@='error=continue,fsfa=no,dcb=#1'@>);
reset(dvi_file); if file_status(dvi_file)>0 then abort('Cannot open dvi file!');
dvi_count := 0; cur_loc := 0;
end;
@#
procedure reopen_dvi_file; {reopens the |dvi_file| for the next scan}
begin reset(dvi_file); dvi_count := 0;
cur_loc:=0;
end;
@#
procedure open_bit_file;  {prepares final output for writing}
begin set_file_parameters(bit_file,'  ','error=continue,fsfa=yes,dcb=#3');
rewrite(bit_file);
if file_status(bit_file)>0 then
   abort('Cannot open bit file or printer output!') ;
bit_is_open := true ;
end;
@#
procedure open_tfm_file; {opens \.{TFM} file}
begin set_file_parameters(tfm_file,cur_name,'error=continue,fsfa=yes,scrub=yes');
reset(tfm_file);
   eof_tfm := file_status(tfm_file)>0;
   if eof_tfm then print_ln('Couldn''t find ',cur_name);
   @.Couldn't find ...@>
   tfm_count := 0 ;
end;
@#
procedure open_input_text ; {prepares to read from general purpose input}
begin
   set_file_parameters(gen_input,cur_name,'error=continue,fsfa=yes,scrub=yes');
   reset(gen_input);
   if file_status(gen_input) <> 0 then
      print_ln('Couldn''t open ',cur_name);
      @.Couldn't open ...@>
end;
@z

@x [34]
@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
@d read_dvi_file(#)==begin
   if dvi_count=block_size then begin
      get(dvi_file); dvi_count:=0;
      end;
   #:=dvi_file^[dvi_count];
   incr(dvi_count);
   end

@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 get_word:integer; {returns the next four bytes, unsigned}
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;
get_word:=((a*256+b)*256+c)*256+d;
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;
@z

@x [37]
@ We need a function that will read in a word from the \.{TFM} file.  If
the particular system
@^system dependencies@>
requires buffering, here is the place to do it.  It also sets a global flag
|eof_tfm| when it reaches the end of the file.  If this flag is set on
entrance to |load_tfm_file|, it is assumed that the file is bad.

@p function tfm_integer : integer ;
var i:integer;
begin read(tfm_file, i);
eof_tfm:=eof(tfm_file);
tfm_integer:=i;
end;

@ There is nothing wrong with defining |eof_tfm| here.

@<Glob...@>=
@!eof_tfm:boolean;  {true when end of \.{TFM} file is reached.}
@y
@ We need a function that will read in a word from the \.{TFM} file.  If
the particular system
@^system dependencies@>
requires buffering, here is the place to do it.  It also sets a global flag
|eof_tfm| when it reaches the end of the file.  If this flag is set on
entrance to |load_tfm_file|, it is assumed that the file is bad.

Since |tfm_file| is blocked, we need a function to read an integer
from it.

@d read_tfm_file(#)==begin
   if tfm_count=block_size then begin
      get(tfm_file); tfm_count:=0;
      end;
   #:=tfm_file^[tfm_count];
   incr(tfm_count);
   end
@#
@p function tfm_integer : integer;
var i,@!result,@!temp:integer;
begin
   result := 0;
   for i:=1 to 4 do begin@/
       read_tfm_file(temp); result := result*two_8+temp;
   end;
   eof_tfm := eof(tfm_file);
   tfm_integer := result ;
end;
@z

@x [41]
@ And, finally, we have the procedure which will extract the information from
the \.{TFM} file.  This routine is for input from the \.{TFM} file, which is (or
should be) a |packed file of integer|, so this should cause no grief.  See the
documentation on |tftopl| for the structure of the file.


@ @p procedure load_tfm_file ; {read in the width data}
label 9997, {used for bad format}
  9999; {used for normal exit}
@y
@ For input and output from the \.{TFM} file, we have this procedure to
read the \.{TFM} file into memory after the current |next_mem_free|.
See the documentation on |tftopl| for the structure of the file.


@ @p procedure load_tfm_file ; {read in the width data}
@z

@x [42]
   if eof_tfm then goto 9997 ;
   while not eof_tfm do begin
      mem[k] := tfm_integer ;
      k := k + 1 ;
      if k > max_mem_size then
         abort(clone,' memory size exceeded on load of tfm file!') ;
   end ;
@y
   while not eof_tfm do begin
      mem[k] := tfm_integer ;
      k := k + 1 ;
      if k > max_mem_size then
         abort(clone,' memory size exceeded on load of tfm file!') ;
         @.memory size exceeded ... tfm file!@>
   end ;
   close_tfm_file;
   if k = next_mem_free then
      print_ln('---not loaded, TFM file is bad')
      @.---not loaded, TFM file is bad@>
   else begin
@z

@x [42]
   goto 9999 ;
9997: print_ln('---not loaded, TFM file is bad') ;
9999: end ;
@y
   end;
end;
@z

@x [43] add CP6 routine to get options from command line
@d errors_only=0 {value of |out_mode| when minimal printing occurs}
@y
@d CP6_parse_command == @= TEX_LIB$PARSE_COMMAND@>
@d CP6_interaction_mode == @= TEX_LIB$INTERACTION_MODE@>
@d errors_only=0 {value of |out_mode| when minimal printing occurs}
@z

@x [47]
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 {the terminal, considered as an input file}
@d term_out==output {the terminal, considered as an output file}

@<Glob...@>=
@!buffer: packed array[0..terminal_line_length] of ASCII_code;
@!buf_length: integer ; {length of command line}
@z

@x [48] use break_file on CP6
@d update_terminal == break(term_out) {empty the terminal output buffer}
@y
@d update_terminal == @= break_file@>(term_out) {empty the output buffer}
@z

@x [49] fix input_ln procedure
begin update_terminal; reset(term_in);
if eoln(term_in) then read_ln(term_in);
k:=0;
while (k<terminal_line_length)and not eoln(term_in) do
  begin buffer[k]:=xord[term_in^]; incr(k); get(term_in);
  end;
buffer[k]:=" ";
@y
begin update_terminal;
k:=0;
while (k<terminal_line_length)and not eoln(term_in) do
  begin buffer[k]:=xord[term_in^]; incr(k); get(term_in);
  end;
buffer[k]:=" ";
read_ln(term_in);
@z

@x [52]
@p procedure dialog;
var k:integer; {loop variable}
begin rewrite(term_out); {prepare the terminal for output}
@<Determine the desired |start_count| values@>;
@<Determine the desired |max_pages|@>;
@<Determine the truncation |print_width|@>;
@<Determine the compression mode@>;
@<Print all the selected options@>;
if compress and (print_width > (page_width * 3 div 4)) then
      page_width := 4 * print_width div 3
else if (not compress) and (print_width > page_width - hh_offset) then
      page_width := print_width + hh_offset;
if page_width > max_p_width then
   begin
      page_width := max_p_width;
      print_width := page_width - hh_offset;
   end;
num_lines := total_rast div page_width;
end;
@y

@d batch == 0   { batch mode response}
@d online == 1  { online mode response}

@p procedure dialog;
var i, k:integer; {loop variable}
interaction: integer; { to contain response from mode query}
command_ptr: com_buf_ptr;  { pointer to command line}

begin rewrite(term_out); {prepare the terminal for output}
CP6_parse_command(command_ptr,buf_length); {get command line}
CP6_interaction_mode(interaction,batch,online); { what access mode are we?}
if (interaction=online) and (buf_length=0) then begin
   @<Determine the desired |start_count| values@>;
   @<Determine the desired |max_pages|@>;
   @<Determine the truncation |print_width|@>;
   @<Determine the compression mode@>;
   @<Print all the selected options@>;
end else @<Determine the options from the command buffer@>;
if compress and (print_width > (page_width * 3 div 4)) then
      page_width := 4 * print_width div 3
else if (not compress) and (print_width > page_width - hh_offset) then
      page_width := print_width + hh_offset;
if page_width > max_p_width then
   begin
      page_width := max_p_width;
      print_width := page_width - hh_offset;
   end;
num_lines := total_rast div page_width;
end;


@ Here are  two new sections to support getting the options from the
command line.

@<Determine the options...@>==
 begin
   for i := 0 to buf_length-1 do buffer[i] := xord[command_ptr^[i]];
   buffer[i+1] := "?" ; { end it with a question mark }
   buf_ptr := 0 ;
   repeat
         case buffer[buf_ptr] of
         " ",",","G","g" : ;
         "S","s" : begin
            @<Skip to parameter@> ; k := 0 ;
            @<Parse the desired |start_vals|@> ;
               end ;
         "P","p" : begin
            @<Skip to parameter@> ;
            @<Parse the desired |max_pages|@> ;
               end ;
         "W","w" : begin
            @<Skip to parameter@> ;
            @<Parse the desired |print_width|@> ;
               end ;
         "T","t" : compress := false ;
         "D","d" : out_mode := 1 ;
         othercases
            print_ln('Error on command line. Skipping: ',xchr[buffer[buf_ptr]]);
            @.Error on command line...:@>
         endcases ;
         incr(buf_ptr);
   until buf_ptr >= buf_length;
   @<Print all the selected options@>;
end

@ @<Skip to parameter@>==
while (buf_ptr < buf_length) and (buffer[buf_ptr] <> " ") and
 (buffer[buf_ptr] <> "=") and (buffer[buf_ptr] <> ",") do
   incr(buf_ptr);
if buffer[buf_ptr] = "=" then incr(buf_ptr);
@z

@x [67] fix problem reading checksum from dvi file
c:=signed_quad; font_check_sum:=c;@/
@y
c:=get_word; font_check_sum:=c;@/
@z

@x [68] set up directory names
@d tfm_directory_name=='TeXfonts:'
@d tfm_directory_name_length=9
@y
@d tfm_directory_name=='.:TEX'
@d tfm_directory_name_length=5
@z

@x [70] fix the routine for the tfm name
@<Move tfm name into the |cur_name| string@>=
begin
for k:=1 to name_length do cur_name[k]:=' ';
r := 1 ;  k := font_name ;
if names[k]=0 then
  begin for i:=1 to tfm_directory_name_length do
    cur_name[i]:=tfm_directory[i];
  r:=tfm_directory_name_length+1;
  end  else begin
   while names[k] > 0 do begin
      cur_name[r] := xchr[names[k]] ;
      r := r + 1 ; k := k + 1 ;
   end ;
 end ;
k := k + 1 ;
while names[k] > 0 do begin
   cur_name[r] := xchr[names[k]] ;
   r := r + 1 ; k := k + 1 ;
end ;
cur_name[r] := '.' ;  r := r + 1 ;
cur_name[r] := 'T' ; r := r + 1 ;
cur_name[r] := 'F' ; r := r + 1 ;
cur_name[r] := 'M' ; r := r + 1 ;
for k := 1 to r do
   if (cur_name[k]>='a')and(cur_name[k]<='z') then
      cur_name[k]:=xchr[xord[cur_name[k]]-@'40] ;
end ;
@y
@<Move tfm name into the |cur_name| string@>=
begin
for k:=1 to name_length do cur_name[k]:=' ';
r := 1; k := font_name + 1 ;
while names[k] > 0 do begin
    cur_name[r] := xchr[names[k]] ; incr(r); incr(k); end;
cur_name[r] := ':' ; incr(r);
cur_name[r] := 't' ; incr(r);
cur_name[r] := 'f' ; incr(r);
cur_name[r] := 'm' ; incr(r);
    for k := 1 to tfm_directory_name_length do
    begin cur_name[r] := tfm_directory[k] ; incr(r); end ;
end;
@z

@x [121]
First, this routine reads the file \.{nonASCII.tex.fnt} to determine which fonts
are non ASCII, i.e. not printable on the screen.  This list is shorter than the
list of ASCII fonts.

@p procedure base_font ;
var i, j, k : integer ;
    f_type : integer ; {type for listed fonts}
    lf,lh,bc,ec,nw,np : integer ; {help in decoding the \.{TFM} file}
    value, x : integer ; {a \.{TFM} |fix_word|}
@<|base_font| variables@>
begin
   @<Load non ASCII font information@> ;
   @<Determine base font@> ;
end ;
@y
First, this routine reads the file \.{nonASCII\_tex\_fonts.:TEX} to determine
which fonts are non ASCII, i.e. not printable on the screen.  This list is
shorter than the list of ASCII fonts.

@p procedure base_font ;
var i, j, k : integer ;
    f_type : integer ; {type for listed fonts}
    lf,lh,bc,ec,nw,np : integer ; {help in decoding the /.{TFM} file}
    value, x : integer ; {a /.{TFM} |fix_word|}
@!r : integer ; {local necessary for font name manipulations}
@<|base_font| variables@>
begin
   @<Load non ASCII font information@> ;
   @<Determine base font@> ;
end ;
@z

@x [122]
@d font_list_file=='nonASCII.tex.fnt' {change this to correct name}
@d list_len==16
@y
@d font_list_file=='nonASCII_tex_fonts.:TEX'
@d list_len==23
@z

@x [124] don't change file name to uppercase, and close input file
for k := 1 to list_len do
   if (list_fonts[k] <= 'z') and (list_fonts[k] >= 'a') then
      cur_name[k] := xchr[xord[list_fonts[k]]-@'40]
   else cur_name[k] := list_fonts[k] ;
open_input_text ;
num_asc_fonts := 0 ;
while not eof(gen_input) do
   @<Process line@> ;

@y
for k := 1 to list_len do
   cur_name[k] := list_fonts[k] ;
open_input_text ;
num_asc_fonts :=0 ;
while not eof(gen_input) do
   @<Process line@> ;
close_input_text ;
@z

@x [133]
@p procedure clean_printer ;
begin
   write_ln(bit_file);
   write_ln(bit_file,'The end...');
   write_ln;
end ;
@y
@p procedure clean_printer ;
begin
   write_ln(bit_file);
   write_ln(bit_file,'The end...'); close_bit_file ;
end ;
@z

@x [137]
This section should be replaced, if necessary, by changes to the program
that are necessary to make \vutex\ work at a particular installation.
Any additional routines should be inserted here.
@^system dependencies@>
@y
This section should be replaced, if necessary, by changes to the program
that are necessary to make \vutex\ work at a particular installation.
Any additional routines should be inserted here.
@^system dependencies@>
Here are the remaining changes to the program
that are necessary to make \.{DVItype} work on CP6

@<Const...@>==
@!block_size=1024;
@!bs_minus_1=1023;
@!two_8= @'400;

@ @<Types...@>==
@!block = packed array [0..bs_minus_1] of 0..511;
@!buf_type = packed array[0..terminal_line_length] of char;
@!com_buf_ptr = ^buf_type; {pointer to command buffer}
@!name_file_type = packed array[1..9] of char;

@ Here are some special procedures that are external to Pascal
written in PL6 to support operating system interfacing. They
come from the |tex_lib| library supplied by Carlton University
when they distributed \TeX.

 In order to support random file positioning, we use a PL6
routine to move the file to a particular record. This only
works on files that are blocked, in this case |dvi_file|.
@^system dependencies@>

@f external == end

@<DPS8/CP-6 procedures@>==
procedure CP6_parse_command(var buf_ptr: com_buf_ptr;
               buf_length: integer); external;
procedure CP6_interaction_mode(var interaction:integer;
          batch_mode, error_mode: integer); external;
@z