summaryrefslogtreecommitdiff
path: root/dviware/crudetype/version3/unix-c.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/crudetype/version3/unix-c.ch
Initial commit
Diffstat (limited to 'dviware/crudetype/version3/unix-c.ch')
-rw-r--r--dviware/crudetype/version3/unix-c.ch564
1 files changed, 564 insertions, 0 deletions
diff --git a/dviware/crudetype/version3/unix-c.ch b/dviware/crudetype/version3/unix-c.ch
new file mode 100644
index 0000000000..1ae4a3a6f7
--- /dev/null
+++ b/dviware/crudetype/version3/unix-c.ch
@@ -0,0 +1,564 @@
+% unix-c.ch -*-mode: change; webfile: crudetype.web version 3.01;-*-
+% UNIX changes by Peter King for Berkeley Pascal
+% modified by RMD for Crudetype version 2 and 3
+%
+% COPYRIGHT ( C ) P.King, Heriot-Watt University, 1988.
+%
+% Permission is given to any person to make and distribute copies of this
+% software, subject to the following conditions:
+%
+% 1. All copies of the software must carry an exact copy of this notice.
+%
+% 2. This software is distributed free of charge, "AS IS" with absolutely no
+% guarantee of performance. Any persons receiving or using this software must do
+% so entirely at their own risk. Neither the authors nor their institutions
+% accept any liability for any defects of this software, or for any consequential
+% loss or damage however caused.
+%
+% 3. Any person who changes this software must clearly mark it as modified and
+% add a note describing the changes made.
+
+
+% [0] WEAVE: print changes only
+@x Module 0; Lines 42 -- 42
+\pageno=\contentspagenumber \advance\pageno by 1
+@y
+\pageno=\contentspagenumber \advance\pageno by 1
+\def\title{Crudetype for {\mc UNIX } }
+@z
+
+@x Module 4; Lines 213 -- 213
+@d banner=='This is Crudetype, Version 3.01, copyright, experimental'
+@y
+@d banner=='This is Crudetype, Version 3.01, copyright, experimental WEB2C'
+@z
+
+@x Module 6; Lines 242 -- 242
+ @<Set initial values@>
+@y
+ @<Set initial values@>
+ setpaths(TFMFILEPATHBIT+TEXINPUTPATHBIT); { set up the correct search path for fonts }
+ wl_feed_dist := 1 ;
+ wl_does_cr := true ;
+@z
+
+% add variables for runtime arguments, and to suppress all the non-error
+% information messages
+% use_stdin is not yet used, but is a handle for an extension to read from
+% input ( a UNIX pipe )
+% The filenames used by |test_access| are added here.
+@x Module 7; Lines 253 -- 253
+ in_i, in_j :integer; {loop index for initializations}
+@y
+ in_i, in_j :integer; {loop index for initializations}
+ use_stdin : boolean; { read from standard input }
+@z
+
+@x Module 9; Lines 281 -- 281
+ if ( u<0) then goto exit ;
+@y
+ if ( u<0) then @= uexit(1) @> ;
+@z
+
+% Change the types
+@x Module 11; Lines 310 -- 312
+@<Types...@>=
+ byte = 0..255 ;
+ i_word = -max_half-1 .. max_half ;
+@y
+@<Types...@>=
+ byte = 0..255 ;
+ bite = -128..127 ; { signed ! }
+ i_word = -max_half-1..max_half ;
+@z
+
+@x Module 12; Lines 330 -- 336
+the macros and constants defined here. See various change files for examples.
+
+@d zchr == chr
+@d zord == ord
+@d Q_string == packed array[ first..last:integer] of char
+@d be_string(#) == set_string( #, buffer)
+@d set_j_to_length == j := last
+@y
+the macros and constants defined here.
+
+Here we have to allow for the difference between Pascal strings (which start with
+index 1) and C strings (index 0). The argument passed to |set_string| is a quoted
+string constant, so it is a C string.
+
+@d zchr == chr
+@d zord == ord
+@d Q_string == ccharpointer
+@d first = 0
+@d last == max_string
+@d be_string(#) == set_string( #, buffer)
+@d set_j_to_length == j := strlen( ss) -1
+@z
+
+@x Module 14; Lines 361 -- 361
+ {Declare |parse_file|}
+@y
+ procedure parse_file( name: var_string; var dir, nam, ex: var_string) ;
+ var p,r,s: s_ptr ;
+ begin
+ dir := blank; nam := blank; ex := blank;
+ s := name.len ;
+ if ( s>0) then begin
+ p := s_search( name, '/', -s);
+ if ( p>0) then substring( dir, name, 1, p) ;
+ r := s_search( name, '.', -s);
+ if ( r>p) then substring( ex, name, r, s-r+1)
+ else r := s +1 ;
+ substring( nam, name, p+1, r-p-1) ;
+ end;
+ end;
+@z
+
+@x Module 16; Lines 408 -- 408
+@d print_ln ==write_ln(printfile )
+@y
+@d print_ln == write_ln(printfile );
+ if inspection then flush(printfile )
+@z
+
+% Changes to incorporate UNIX conventions
+% lower case file names, default to putting the .lpr file in the
+% same directory as the .dvi file
+@x Module 18; Lines 429 -- 436
+@d block_length = 512
+@d same_dir == false
+
+@<Set init...@>=
+ be_string( '.DVI' ) ; dvi_def := buffer ;
+ be_string( 'TEX$FONTS:.TFM' ) ; tfm_def := buffer ;
+ be_string( 'TEX$GF:.&DGF' ) ; raster_def := buffer ;
+ be_string( '.PRI' ) ; print_ex := buffer ;
+@y
+
+The Unix version of \.{Crudetype} uses ``paths''.
+
+@d block_length = 1
+@d same_dir == true
+
+@<Set init...@>=
+ be_string( '.dvi'); dvi_def := buffer ;
+ be_string( '/tex/fonts/.tfm') ; tfm_def := buffer ;
+ be_string( '/tex/gfdir/.&Dgf' ) ; raster_def := buffer ;
+ be_string ( '.lpr' ) ; print_ex := buffer ;
+@z
+
+% More of the UNIX simple minded view of files.
+% but including the (optional) directory search for .tfm files
+@x Module 19; Lines 442 -- 443
+@<Lowest...@>=
+ {Declare |open_binary|}
+@y
+@d read_access_mode=4 {``read'' mode for |test_access|}
+@d write_access_mode=2 {``write'' mode for |test_access|}
+@d default == xwzdefault {|default| is reserved in C}
+@d fortran == xwzfortran {and apparently so is |fortran|}
+
+@d close_binary(#)== do_nothing ;
+
+@<Lowest...@>=
+ function open_binary (var f_f: byte_file; var name: var_string;
+ search_path: integer ): boolean;
+ var cur_name: ccharpointer ;
+ begin
+ cur_name := name.data ;
+ if test_read_access(cur_name, search_path) then
+ begin
+ reset(f_f, cur_name);
+ open_binary := true
+ end
+ else
+ open_binary := false
+ end;
+@z
+
+@x Module 20; Lines 445 -- 446
+@ @<Open |printfile|@>=
+ rewrite(printfile) ;
+@y
+@ @<Open |printfile|@>=
+ if inspection then begin
+ be_string ('/dev/tty') ;
+ print_name := buffer ;
+ end ;
+ rewrite(printfile, print_name.data ) ;
+@z
+
+@x Module 21; Lines 452 -- 466
+@d get_val( #) == # := s_to_i( #, true)
+@d prefix == "/"
+@d got_cl == ( command.len > 0)
+@d read_command_line( #) == do_nothing
+
+@<Lowest...@>=
+ {Declare |read_command_line| }
+@#
+ procedure get_command ;
+ var ss: fix_string ;
+ begin
+ ss := blank.data ;
+ read_command_line( ss) ;
+ be_string( ss ) ; command := buffer ;
+ end;
+@y
+
+Unix \P\ does not supply a command line; instead it chops it up and supplies
+the pieces using two predeclared procedures |argc| and |argv|. It seemed to me
+that the least messy way to fit this onto the rest of the program is to
+re-assemble the command line.
+
+@d get_val( #) == # := s_to_i( #, true)
+@d prefix == "-"
+@d got_cl == ( argc > 1)
+@d read_command_line( #) == do_nothing
+
+@<Lowest...@>=
+ procedure get_command ;
+ var ss: fix_string ; nn: integer ; tt: var_string ;
+ cc: ccharpointer ;
+ begin
+ command := blank ;
+ for nn := 1 to argc-1 do begin
+ argv( nn, ss) ;
+ cc := ss ;
+ incr(cc);
+ be_string( cc ) ; tt := buffer ;
+ append( command, tt) ;
+ incr( command.len) ;
+ end;
+ end;
+@z
+
+@x Module 27; Lines 560 -- 572
+@ If there was no command line, try to send messages to the user at a
+terminal. This requires nonstandard \PASCAL\ constructions to handle the
+online interaction. So it may be necessary on some systems to omit the dialog.
+First, the \.{DVI} file name.
+
+@<Get \.{DVI} file name and open it@>=
+ if can_interact and ( dvi_name.len = 0) then repeat
+ ask_prompt('DVI file name? ') ;
+ get_name( dvi_name) ;
+ until ( dvi_name.len > 0) ;
+ if not open_and_ask(dvi_file, dvi_indx, dvi_name, dvi_def, true)
+ then abort('Couldnt open DVI file')
+ @.Fatal: Couldnt open@>
+@y
+@ If there was no command line, try to send messages to the user at a
+terminal. This requires nonstandard \PASCAL\ constructions to handle the
+online interaction. So it may be necessary on some systems to omit the dialog.
+First, the (\.{DVI}) file name. This part is altered to use Unix style path
+searching.
+
+@<Get \.{DVI} file name and open it@>=
+ if can_interact and ( dvi_name.len = 0) then repeat
+ ask_prompt('DVI file name? ') ;
+ get_name( dvi_name) ;
+ until ( dvi_name.len > 0) ;
+ dvi_indx := TEX_INPUT_PATH ;
+ if not open_and_ask(dvi_file, dvi_indx, dvi_name, dvi_def, true)
+ then abort('couldnt open DVI file')
+ @.Fatal: couldnt open@> @.Opening DVI file@>
+@z
+
+@x Module 28; Lines 574 -- 577
+@ But when we come to open a font file, we merely report a failure:
+
+@<Open font file@>=
+ font_ok := open_and_ask (tfm_file, tfm_indx, tfm_name, tfm_def, true) ;
+@y
+@ When we try to open a font file, we search the path specified by the user's
+environment variable before we report a failure:
+
+@<Open font file@>=
+ tfm_indx := TFM_FILE_PATH ;
+ font_ok := open_and_ask (tfm_file, tfm_indx, tfm_name, tfm_def, true) ;
+@z
+
+@x Module 30; Lines 631 -- 631
+ begin incr(k); buffer.data[k]:=term_in^; get(term_in);
+@y
+ begin incr(k); read( term_in, buffer.data[k]) ;
+@z
+
+% Binary file handling
+@x Module 33; Lines 661 -- 671
+The main input file is the \.{DVI} file. Logically, this is just a stream of
+8-bit bytes, with no record or block structure. However VMS \PASCAL\
+apparently cannot handle files of this type; so I have adopted the blocking
+scheme (due to D.R.Fuchs) from the VMS \.{DVItype} change file. But a lot of
+the code has been rewritten. Some other operating systems use similar
+blocking schemes; so this code may possibly work without much change. The
+program deals with two binary file variables: |@!dvi_file| is the main input
+file that we are printing, and |@!tfm_file| the current font metric file from
+which character-width information is being read. Each of these has a name and
+a counter, declared here; also a default name (system dependent, and so
+declared previously).
+@y
+The main input file is the \.{DVI} file. Logically, this is just a stream of
+8-bit bytes, with no record or block structure. UNIX \PASCAL\ can happily
+handle these, except that it treats each byte as a signed quantity, so we do
+some fudging to make them unsigned. The program deals with two binary file
+variables: |@!dvi_file| is the main input file that we are printing, and
+|@!tfm_file| the current font metric file from which character-width
+information is being read. Each of these has a name declared here.
+@z
+
+% Binary file types
+@x Module 33; Lines 675 -- 676
+ @!byte_block=packed array [0..block_length-1] of byte ;
+ @!byte_file= packed file of byte_block;
+@y
+ @!byte_file= file of bite;
+@z
+
+% Open_and_ask must pass the search path into open_binary
+@x Module 35; Lines 701 -- 701
+ success := open_binary(f_f, name ) ;
+@y
+ success := open_binary(f_f, name, f_c ) ;
+@z
+
+% P. King deleted all the VMS indx stuff, since all the files are (logically)
+% read one character at a time. I have re-instated it because it is very
+% useful when debugging.
+%
+@x Module 38; Lines 745 -- 776
+@d get_real(#) == read_real(# @& file, # @& indx)
+
+@<Lowest...@>=
+ function read_byte(var f_file: byte_file; var f_indx: integer) : byte;
+ begin
+ if eof(f_file) then
+ warn('End of file' )
+ else begin
+ read_byte := f_file^[f_indx] ;
+ incr(f_indx);
+ if f_indx =block_length then begin
+ get(f_file );
+ f_indx:=0;
+ end;
+ end;
+ end ;
+
+@#
+ procedure skip_bytes(var f_file: byte_file; var f_indx: integer; n:integer);
+ {discard n bytes from |f_file|}
+ begin
+ if n < 0 then abort('Skip_bytes called with negative number');
+ f_indx := f_indx + n;
+ while( f_indx >= block_length) do
+ begin
+ if eof(f_file) then
+ warn('End of file' )
+ else get(f_file );
+ f_indx := f_indx - block_length ;
+ end ;
+ end;
+ @.Error: End of file@> @.Fatal: Skip_bytes...@>
+@y
+@d read_real == rr_read_real {|read_real| is Unix \Pascal\ procedure}
+@d get_real(#) == read_real(# @& file, # @& indx)
+
+@<Lowest...@>=
+ function read_byte(var f_file: byte_file; var f_indx: integer) : byte;
+ var x:bite;
+ begin
+ if eof(f_file) then begin
+ warn('End of file' ) ;
+ read_byte := 0 ; { return some value }
+ end
+ else begin
+ read(f_file,x);
+ if x < 0 then read_byte := x + 256
+ else read_byte := x ;
+ incr(f_indx);
+ end;
+ end;
+
+@#
+ procedure skip_bytes(var f_file: byte_file; var f_indx: integer; n:integer);
+ {discard n bytes from |f_file|}
+ var k:integer;
+ x:bite;
+ begin
+ if n < 0 then abort('skip_bytes called with negative number');
+ f_indx := f_indx + n;
+ for k:=1 to n do
+ begin
+ if eof(f_file) then
+ warn('End of file' )
+ else read(f_file, x );
+ end ;
+ end;
+ @.Error: End of file@> @.Fatal: Skip_bytes...@>
+@z
+
+% SIGH!! variant records
+@x Module 88; Lines 1543 -- 1549
+ code_object = packed record
+ breadth: i_word ;
+ case boolean of
+ true: (IM_font: byte ; IM_char: byte );
+ {Printers font and character}
+ false: (multi: i_word) ;
+ end;
+@y
+ code_object = packed record
+ breadth: i_word ;
+ IM_font: byte ;
+ IM_char: byte;
+ {Printers font and character}
+ multi: i_word ;
+ end;
+@z
+
+@x Module 99; Lines 1701 -- 1709
+ trio = 1..3 ;
+ lig_thing = packed record
+ case trio of
+ 1: (v_move: i_word ;
+ h_move: i_word) ;
+ 2: (symbol: code_object) ;
+ 3: (num : i_word ;
+ guard : i_word) ;
+ end;
+@y
+ trio = 1..3 ;
+ lig_thing = packed record
+ v_move: i_word ;
+ h_move: i_word;
+ symbol: code_object;
+ num : i_word ;
+ guard : i_word;
+ end;
+@z
+
+@x Module 132; Lines 2235 -- 2236
+ begin if ( s.len <> t.len ) then equals := false
+ else equals := ( s.data = t.data) ;
+@y
+ var c, d: ccharpointer ;
+ begin
+ c := s.data; incr(c) ;
+ d := t.data; incr(d) ;
+ if ( s.len <> t.len ) then equals := false
+ else equals := (strncmp(c,d, s.len) = 0) ;
+@z
+
+% SIGH! with statements
+@x Module 158; Lines 2745 -- 2747
+ with lig_buff[2*i].symbol do
+ if (print_width < -breadth ) and (breadth > -30000 )
+ then print_width := -breadth ;
+@y
+ if (print_width < -lig_buff[2*i].symbol.breadth )
+ and (lig_buff[2*i].symbol.breadth > -30000 )
+ then print_width := -lig_buff[2*i].symbol.breadth ;
+@z
+
+@x Module 172; Lines 2937 -- 2941
+ with image( run_ptr) do begin {write the data into it}
+ hpos := Set_h ; Old_h := Set_h ;
+ vpos := Set_v ; Old_v := Set_v ;
+ symbol := cod ;
+ end;
+@y
+ begin {write the data into it}
+ image( run_ptr).hpos := Set_h ; Old_h := Set_h ;
+ image( run_ptr).vpos := Set_v ; Old_v := Set_v ;
+ image( run_ptr).symbol := cod ;
+ end;
+@z
+
+@x Module 180; Lines 3061 -- 3068
+ page_record = packed record
+ prox: link ;
+ case boolean of
+ true: ( hpos : i_word;
+ vpos: i_word;
+ symbol: code_object ) ;
+ false: ( down : link) ;
+ end;
+@y
+ page_record = packed record
+ prox: link ;
+ hpos : i_word;
+ vpos: i_word;
+ symbol: code_object;
+ down : link ;
+ end;
+@z
+
+@x Module 186; Lines 3156 -- 3175
+ with image(line_ptr) do begin
+ PR_h_next := hpos - H_shunt ;
+ if not b_space_absolute and not b_space_by_string and
+ (PR_h_next < PR_h) then
+ begin
+ if (PR_h < left_stop) then warn ('Negative H-pos') ;
+ if not batch_view then begin
+ next(overflow) := line_ptr ;
+ advance(overflow) ;
+ end;
+ advance(line_ptr) ;
+ end
+ else begin
+ @<Set horizontal position for the next character@>;
+ if symbol.IM_font <> PR_font then set_PR_font(symbol.IM_font);
+ print(zchr(symbol.IM_char )) ;
+ PR_h := PR_h + symbol.breadth ;
+ step_wipe(line_ptr ) ;
+ end ; end;
+ @.Error: Negative H-pos@>
+@y
+ begin
+ PR_h_next := image(line_ptr).hpos - H_shunt ;
+ if not b_space_absolute and not b_space_by_string and
+ (PR_h_next < PR_h) then
+ begin
+ if (PR_h < left_stop) then warn ('negative H-pos') ;
+ if not batch_view then begin
+ next(overflow) := line_ptr ;
+ advance(overflow) ;
+ end ;
+ advance(line_ptr) ;
+ end
+ else begin
+ @<Set horizontal position for the next character@>;
+ if image(line_ptr).symbol.IM_font <> PR_font
+ then set_PR_font( image(line_ptr).symbol.IM_font);
+ print(zchr( image(line_ptr).symbol.IM_char )) ;
+ PR_h := PR_h + image(line_ptr).symbol.breadth ;
+ step_wipe(line_ptr ) ;
+ end ; end;
+ @.negative H-pos@>
+@z
+
+% UNIX writeln moves you down a line
+@x Module 207; Lines 3472 -- 3472
+ device_ID := 'Lineprinter '; {Pad to 12 chars}
+@y
+ vstrcpy (device_ID, 'Lineprinter ' ); {Pad to 12 chars}
+@z
+
+@x Module 207; Lines 3489 -- 3489
+ wl_feed_dist := 0 ;
+@y
+ wl_feed_dist := 1 ;
+@z
+
+@x Module 210; Lines 3543 -- 3543
+ device_ID := 'screenview '; {Pad to 12 chars}
+@y
+ vstrcpy (device_ID, 'screenview ' ); {Pad to 12 chars}
+@z
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% END OF FILE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+