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 @@/ const @@/ type @@/ var @@/ procedure initialize; {this procedure gets things started properly} var i:integer; {loop index for initializations} begin print_ln(banner);@/ @@/ end; @y @p program vutex(dvi_file,bit_file,tfm_file,gen_input,input,output); label @@/ const @@/ type @@/ var @@/ @@/ 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);@/ @@/ 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 @= @!dvi_file:byte_file; {the stuff we are \.{DVI}typing} @!tfm_file:byte_file; {a font metric file} @y @= @!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. @= @!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@> @= @!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} @= @!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; @; @; @; @; 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 @; @; @; @; @; end else @; 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. @== 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 @ ; k := 0 ; @ ; end ; "P","p" : begin @ ; @ ; end ; "W","w" : begin @ ; @ ; 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; @; end @ @== 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 @= 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 @= 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 @ ; @ ; 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 @ ; @ ; 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 @ ; @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 @ ; 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 @== @!block_size=1024; @!bs_minus_1=1023; @!two_8= @'400; @ @== @!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 @== 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