summaryrefslogtreecommitdiff
path: root/dviware/crudetype/version3/crudetype.web
diff options
context:
space:
mode:
Diffstat (limited to 'dviware/crudetype/version3/crudetype.web')
-rw-r--r--dviware/crudetype/version3/crudetype.web4033
1 files changed, 4033 insertions, 0 deletions
diff --git a/dviware/crudetype/version3/crudetype.web b/dviware/crudetype/version3/crudetype.web
new file mode 100644
index 0000000000..d996a04973
--- /dev/null
+++ b/dviware/crudetype/version3/crudetype.web
@@ -0,0 +1,4033 @@
+% CRUDETYPE.WEB ADAPTED FROM DVITYPE, VERSION 2.6.
+
+% REVISIONS:
+% 9/86: clarify names of global variables, supply hooks for attempted
+% Hewlett-Packard Laserjet version.
+% 1/88: Several bugfixes. Chiefly the noscheme bug (TFM files without coding
+% schemes)
+% Also, added some MATH EXTENSION character codes.
+% 4/88: Unix change file by P. King.
+% 10/88: Version 2. Changes include:
+% Read a command line; additional options; cleaner interface to operating
+% system; bugfixes.
+% 11/90: Version 3.01. Minor bugfixes; a serious attempt to tackle character
+% strings; (from J.Warbrick) screenview; several more coding schemes;
+% additional options.
+
+% Here is TeX material that gets inserted after \input webmac
+\def\hang{\hangindent 3em\indent\ignorespaces}
+\font\ninerm=cmr9
+\let\mc=\ninerm % medium caps for names like PASCAL
+\def\PASCAL{{\mc PASCAL}}
+\def\WEB{{\mc WEB}}
+
+\def\(#1){} % this is used to make section names sort themselves better
+\def\9#1{} % this is used for sort keys in the index
+
+\def\title{Crudetype}
+\def\contentspagenumber{1}
+\def\topofcontents{\null
+ \def\titlepage{F} % include headline on the contents page
+ \def\rheader{\mainfont\hfil \contentspagenumber}
+ \vfill
+ \centerline{\titlefont Crudetype}
+ \vskip 45pt
+ \centerline{An adaptable device driver (Version 3, 1990)}
+ \vskip 45pt
+ \centerline{R.M.Damerell,} \vskip 20pt
+ \centerline{Mathematics Dept.,} \vskip 15pt
+ \centerline{Royal Holloway and Bedford College,} \vskip 15pt
+ \centerline{Egham, Surrey, U.K.} \vskip 15pt
+\vfill}
+\pageno=\contentspagenumber \advance\pageno by 1
+\let\maybe=\iffalse
+
+
+% These macros for verbatim scanning are copied from MANMAC.TEX. But we cant
+% use the vertical bar for a temporary escape character as WEAVE catches it.
+% So we will use ! instead and hope for the best
+\chardef\other=12
+\def\ttverbatim{\begingroup
+ \catcode`\\=\other \catcode`\{=\other \catcode`\}=\other \catcode`\$=\other
+ \catcode`\&=\other \catcode`\#=\other \catcode`\%=\other \catcode`\~=\other
+ \catcode`\_=\other \catcode`\^=\other
+ \obeyspaces \obeylines \tt}
+
+\def\begintt{$$\let\par=\endgraf \ttverbatim \parskip=0pt
+ \catcode`\!=0 \rightskip-5pc \ttfinish}
+{\catcode`\!=0 !catcode`!\=\other % ! is temporary escape character
+ !obeylines !obeyspaces % end of line is active
+ !gdef!ttfinish#1^^M#2\endtt{#1!vbox{#2}!endgroup$$}}
+
+\def\up{\hbox{\tt{\char'013}}}
+\def\markarrow#1{\vtop{\hbox{#1}\up}}
+
+@* Introduction.
+
+COPYRIGHT ( C ) R.M.Damerell, 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.
+
+This is an experimental version and no guarantee of performance is given.
+I would like to receive bug reports, same address or electronic mail to
+DAMERELL at UK.AC.NSFNET-RELAY (From the USA, I believe that site is
+NSFNET-RELAY.AC.UK). \par\vskip 0.5in
+
+This program was originally based on D.E.Knuth's program \.{DVItype}, but so
+many changes were needed for various reasons that there is hardly any of the
+original code left. The purpose of this program is to provide a framework for
+users to write \TeX\ device drivers for a variety of `crude' devices. Roughly
+speaking, `crude' means any printer that cannot print the fonts that Metafont
+generates. This would include daisy-wheels and most impact dot-matrix
+printers. Considered as output printers for \TeX, such devices usually have
+some of the following misfeatures: \item
+1. Coarse resolution.\item
+2. Restricted character set. \item
+3. Some printers cannot do reverse line feeds, some can, and tear the paper.
+\item
+4. Slow interface between CPU and printer.\par
+
+Although such printers cannot do justice to \TeX\ output, drivers for them
+are still needed. Some users cannot afford high quality printers. Some can
+only afford to use them for final output; so they need to make proofs on a
+cheaper printer. Also, anybody who has a high quality printer may well need
+to refer to various \.{WEB} files while writing a driver for it. These can
+become illegible in critical places. Here is a sample from \.{DVItype}:
+\begintt
+
+A |fix_word| whose respective bytes are $(a,b,c,d)$ represents the number
+$$x=\left\{\vcenter{\halign{$#$,\hfil\qquad&if $#$\hfil\cr
+b\cdot2^{-4}+c\cdot2^{-12}+d\cdot2^{-20}&a=0;\cr
+-16+b\cdot2^{-4}+c\cdot2^{-12}+d\cdot2^{-20}&a=255.\cr}}\right.$$
+\endtt
+
+Using the basic (line printer) version of \.{Crudetype}, we can get a copy of
+these formulae which is at least legible, even though the result may not be at
+all pleasant to look at. A further difficulty with conventional drivers is
+that most of these use the algorithm `paint a page of pixels, send it down the
+line'. This places a heavy load on both the host computer and the link to the
+printer. Of course, one can try to reduce this load by various optimisations,
+(e.g. by writing critical bits of code in machine language) but this makes the
+program non-portable, and often introduces bugs. \.{Crudetype} is written
+entirely in \PASCAL, without any attempt at optimisation. When compiled on a
+VAX 780 with the NO-OPTIMISE, CHECK and DEBUG qualifiers it runs at about 2--3
+seconds a page. These times are highly variable, and the VMS optimiser reduces
+them by about 10-15\%.
+
+@ Printers vary enormously both in their capabilities and in the commands that
+drive them. The behaviour of \.{Crudetype} is controlled by a large number of
+constants, which supposedly describe how the target printer does things. This
+does have the disadvantage that the user must compile a separate copy of the
+program for each different printer, and also devise some way to ensure that he
+uses the right version for the intended printer. But the only alternative seemed
+to be that \.{Crudetype} should read and parse a file describing the printer and
+this appeared to be unbearably messy. In Version 3, many of these constants are
+now variables. This means that you can (to a limited extent) support different
+printers by flags in the command line. Ideally, these constants should be so
+designed that:
+
+\item
+1. Any decent printer can be driven by assigning the right values to these
+constants and recompiling. \item
+2. If the printer is properly documented, it should be immediately obvious
+what are the correct values for all these constants.
+
+At present I do not have enough experience of different printers to come near
+this ideal. In particular, some printers can download characters. The
+problems of writing a program to support this facility in proper generality
+are horrible and ghastly. I have not made any serious attempt yet to tackle
+them. There are just a few places where a hook appears, and I hope eventually
+to attach actual routines for downloading.
+
+Some of the more obvious problems of downloading are: when can you download?
+At any time? start of page? or only at start of document? Can you load one
+character, or must you load a whole font at a time? How much memory does the
+printer provide for downloading? How efficiently does it use its memory? What
+does it do when it runs out? Can you clear out old fonts to make more space?
+What is the format of a down-load command? What parameters does it need, in
+what order, with what punctuation? In what order must pixels be sent? Should
+they be compressed, and how?
+
+@ Implementation.
+
+The original version of \.{Crudetype} was aimed at a line printer, (because
+everybody has these) and was written on the VAX-VMS operating system. The
+intention is that this program should be easily adaptable both to other
+systems and to other printers. So most of it is written in Standard \PASCAL.
+(It is not possible to tell exactly how much of it is Standard, as we do not
+have a certified compiler.) But in some places, it is necessary to use
+extensions. In particular, \.{Crudetype} must read the font files, whose names
+are dynamically specified. That would be impossible in pure \PASCAL.
+\.{Crudetype} also uses non-Standard code in order to talk to the user's
+terminal. It asks for the name of the \.{DVI} file, and for the first page and
+the number of pages to print. Alternatively, it can read a `command line'
+and do simple-minded parsing. If an operating system forbids terminal
+interaction, the installer will have to find another way to give the program
+this information. As file handling is inevitably system-dependent, I have here
+allowed myself a lot of latitude in using VMS-specific procedures. If
+\.{Crudetype} cannot find a file, it will ask the user for another name. On
+the other hand, all files are read and written sequentially, and I have got
+rid of all uses of the default |case| statement. The intention is that all the
+system-dependent stuff goes near the top of the file, and all
+printer-dependent stuff at the end. Then with any luck you can merely
+concatenate Change files for the local system and the local printer, instead
+of having to merge them. All the code that is known to be non-Standard has
+been carefully segregated from the rest of the program. It amounts to about 20
+lines out of 750.
+@^System dependencies@>
+
+It is clearly impossible to predict what difficulties will appear in trying
+to install \.{Crudetype} on other systems, it would seem to be advisable to
+get the line printer version working before trying to adapt it for any other
+printer. To try to ease the process, I propose to distribute several test
+files with the program. These are of the form SAMPLE.TEX, SAMPLE.DVI and
+SAMPLE.PRI (the line printer output).
+
+Although `crude' printers differ very much in their capacities, one thing
+they nearly all have in common is that they cannot feed the paper backwards.
+Some printers cant |Backfeed| at all; some tear the paper, and others let the
+paper slip and so lose position. Therefore it seems to be essential to process
+each page as follows: first copy the page into a suitable structure, then sort
+it by vertical and horizontal position, then print it.
+
+Change files have been written for other systems: Unix (by P.King), NOS/VE
+(G-H.Knauf and M.Rawohl), and Primos (J.Warbrick). Many of the changes that
+these authors made are not system dependencies but improvements to the basic
+program. I have tried to incorporate these into the current version, and I
+want to thank them for their contributions.
+
+@* Main Program.
+
+@d banner=='This is Crudetype, Version 3.01, copyright, experimental'
+{printed when the program starts}
+
+@p program crudetype
+ @<Declarations@>
+ begin
+ @<Initialize@>;
+ repeat
+ @<For each page of \.{DVI}, print it if desired@>
+ until time_to_stop ;
+ @<Clean up afterwards@>;
+ exit: end.
+
+@ Now here are some of the messy things we must do to satisfy the rules of
+\PASCAL.
+
+@<Declarations@>=
+ (@<Files@>) ;
+ label exit ;
+ const @<Constants in the outer block@>
+ type @<Types in the outer block@>
+ var @<Globals in the outer block@>
+ @<Forward and external declarations@>
+ @<Lowest level procedures@>
+ @<Medium level procedures@>
+ @<Top level procedures@>
+
+@ @<Initialize@>=
+ @<Set |blank|@>
+ @<Set initial values@>
+ @<Open terminal channels@>
+ @<Determine operating parameters@>
+ @<Assign character codes@>
+ @<Set up for the printer@>
+ if not quiet then
+ display_ln(banner, ' --- ', device_ID) ;
+ @<Open |printfile|@>;
+ @<Read \.{DVI} preamble@>
+
+@ @<Glob...@>=
+ in_i, in_j :integer; {loop index for initializations}
+
+@ Next, here are some macros for common programming idioms.
+
+@d incr(#) == #:=#+1 {increase a variable by unity}
+@d decr(#) == #:=#-1 {decrease a variable by unity}
+@d do_nothing == {empty statement}
+@d exit == 732
+@d return == goto exit
+ {Go here when a loop ends abnormally}
+
+@ The next two procedures are very primitive debugging aids. All internally
+detected errors call |error|. Then they can be caught by suitable debugger
+commands. When \TeX\ sees a fatal error, it calls a procedure |jump_out| which
+jumps to a label at the ``|end.|'' of the program. This makes debugging much
+more difficult, because the program has ended normally, so it is impossible to
+interrogate variables, etc. So the earlier versions of \.{Crudetype} were
+designed to crash on a fatal error. This action is unpopular; I hope that fatal
+errors are now rare enough that we do not need to crash any longer.
+
+@<Forward...@>=
+procedure error ; begin end;
+@#
+procedure crash;
+var u: real;
+begin
+ u := -1 ;
+ error;
+ if ( u<0) then goto exit ;
+end;
+
+@* Interface to Operating System, 1: System dependent code.
+
+The purpose of these sections is to try to give a reasonable interface between
+the operating system and the rest of the program, which is supposed to be
+Standard \PASCAL. Nearly all the non-Standard code is concerned with file
+handling and the lowest level of I/O. This is an area where Standard \PASCAL\
+seems to be particularly weak. \.{Crudetype} was originally written for VMS,
+but as change files have started to appear, it has become clear that all the
+most VMS-specific code really ought to be put into a Change file. So this
+section contains a lot of dummy declarations. The actual declarations are
+expected to be found in Change files. It is hoped that most of the later
+sections will work on a wide range of machines. Everything here is system
+dependent, so there is no point in indexing each module separately.
+ @^System dependencies@>
+
+@ Here are some system-dependent types and constants. |integer| should be
+32-bits, and |real_number| should probably be 64. Normally, I use |integer|
+whenever the bit length is unimportant, but I use subranges in the
+|page_record| type, as this allows packing and may improve the program's
+performance.
+
+@d real_number == real
+@d make_real( #) == #
+ {convert an integer to a |real_number|. Usually automatic}
+@d max_half = 32767
+
+@<Types...@>=
+ byte = 0..255 ;
+ i_word = -max_half-1 .. max_half ;
+
+@ Characters and strings. I have here deleted all the code from \.{DVItype}
+that translates from characters to small integers and back. This is because
+we have to do a quite different translation anyway. If it is necessary to put
+that code back in, then it will probably be necessary to insert \begintt
+ define zchr(#) == xchr[#] \endtt
+because of the different brackets.
+
+Strings are represented internally by the |var_string| type and nearly all the
+code that uses these is Standard. There are 2 non-Standard things we need to do
+with strings: (1) convert a quoted string to a |var_string|. (2) convert a
+|var_string| into whatever type the local \PASCAL\ accepts as a file name.
+Because Standard \PASCAL\ has no decent mechanism to deal with quoted strings,
+every manufacturer has had to make non-Standard extensions to get a useful
+compiler. The main alternatives are: conformant arrays, blank-padding, and
+variable-length. The \WEB\ adopts conformant arrays because these are a ``level
+one'' feature of the Standard. But you can adopt other mechanisms by altering
+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
+
+@<Forw...@>=
+ procedure set_string(
+ ss: Q_string; var result: var_string ) ; forward;
+
+@ These constants affect the way character strings get handled. They are
+described under ``character strings''.
+
+@<Const...@>=
+ padded = true ;
+ pad_char = ' ' ;
+ amp_and = '&' ;
+ ctrl_flag = '^' ;
+
+@ Now consider file names. As in \TeX, we assume that these have 3 parts:
+(directory)(name)(extension). The change file must define a procedure
+|@!parse_file| which chops a filename |name| into its components, called |dir|,
+|nam|, and |ex|. The procedure |name_of| must convert a |var_string| into
+whatever type the local \PASCAL\ accepts as a file name.
+
+@d filename == fix_string
+@d n_len == max_string
+
+@<Lowest...@>=
+ {Declare |parse_file|}
+
+@#
+ procedure name_of( var result: filename; name: var_string) ;
+ var n, i: integer;
+ begin
+ n := name.len ;
+ if ( n > n_len) then n := n_len ;
+ for i := 1 to n do result[ i] := name.data[ i] ;
+ for i := n+1 to n_len do result[ i] := ' ' ;
+ end;
+
+@ In this section we generate a name for the printed file, unless the user
+specified one. Essentially, this involves deleting the extension part of the
+\.{DVI} filename and adding a new one (in |@!print_ex|). If |@!same_dir|, put
+the file into the \.{DVI} file's directory.
+
+@<Open |printfile|@>=
+ if ( print_name.len = 0) then begin
+ parse_file( dvi_name, p_d, p_n, p_ex);
+ if same_dir then print_name := p_d
+ else print_name := blank ;
+ append( print_name, p_n );
+ append( print_name, print_ex) ;
+ end;
+
+@ The next few sections contain the lowest level code for file handling. These
+macros describe how we use the terminal.
+
+In V3, we have tried to implement a screen view version. To work this,
+we have to pause the output at times. on Unix and on VMS we had to do
+peculiar things to synchronise the terminal and printer streams. The
+macro |@!flush_out| works on VMS; see also the Unix changefile, under
+|inspection|.
+
+@d flush_out == begin print_ln ; display_ln(' '); end
+@#
+@d term_in==input {the terminal, considered as an input file}
+@d term_out==output {and output}
+@#
+@d can_interact == true
+@d i_reset_terminal == do_nothing {Switch terminal to input}
+@d o_rewrite_terminal == do_nothing {and back to output}
+@#
+@d display(#)==write(term_out, #)
+@d display_ln(#)==write_ln(term_out, # )
+@d print(#)==write(printfile, #)
+@d print_ln ==write_ln(printfile )
+@d string_show( #) == print_string( term_out, #, ' ')
+@d string_print( #) == print_string( printfile, #, ctrl_flag )
+@#
+@d warn (#)==begin display_ln('Error: ', #); error; end
+@d abort(#)==begin display_ln('Fatal: ', #); crash; end
+@d bad_dvi(#)==abort('Bad DVI file: ',# )
+
+@<Open terminal channels@>= do_nothing
+
+@ As an initial attempt at downloading, we declare a |@!raster_file|.
+
+@<Files@>= term_in, term_out, printfile, dvi_file, tfm_file, raster_file
+
+@ Here we define some system-dependent properties of files. \.{Crudetype}
+tries to search for files in a sensible way by using default names. Note that
+the default names should not contain wild cards for their missing bits.
+Several different patterns have been invented for raster file names. The
+default name |raster_def| contains the substring |'&D'|. This is put in to
+be replaced by the calculated magnification when we try to open the file.
+
+@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 ;
+
+@ |@!open_binary| is the lowest-level procedure for opening binary files. If
+possible, it must try to open a file called |name| and not crash if the file
+cannot be opened. Return true or false to indicate success.
+
+@<Lowest...@>=
+ {Declare |open_binary|}
+
+@ @<Open |printfile|@>=
+ rewrite(printfile) ;
+
+@ \.{Crudetype} tries to read a ``command line''. |@!read_command_line| should
+be the procedure that actually reads the line, and these macros extract pieces
+of it. The code below should work on systems that cannot read command lines.
+
+@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;
+
+@ Here are macros for the adaptable merge sort. See the section on sorting for
+explanation.
+
+@d image(#) == pool[#]
+@d create == incr(cell)
+@d link_type == page_i
+@d first_cell == cell := 0
+@d wipe_out(#) ==
+@d declare_pool == pool: array [page_i] of page_record;
+@d garbage == cell := zzz ;
+
+@* Interface to Operating System, 2: Dialog with Environment.
+
+In this section, \.{Crudetype} will determine what it is supposed to be doing.
+It might be called either interactively, by a command like this: \begintt
+(RUN) crudetype \endtt
+ or in batchmode by a command like this:\begintt
+(RUN) crudetype (parameters)\endtt
+ In the first case, \.{Crudetype} must ask the user for all its operating
+parameters. In the second, it must read the parameters from the command line
+and supply defaults for all the missing ones. If the local operating system
+does not allow either of these methods, the installer will have to devise some
+other way to supply the data.
+
+If there is a command line, the system-dependent procedure |@!get_command|
+should fetch it and put it into |command|; then |parse_command| will read it.
+
+@<Determine operating parameters@>=
+ command := blank ; get_command ;
+ dvi_name := blank ;
+ if got_cl then parse_command ;
+ @<Get \.{DVI} file name and open it@> ;
+ if not got_cl then @<Ask the user@> ;
+
+@ The main argument is the input (\.{DVI}) file name. All other arguments are
+optional, and have the form (prefix)(key)(value). The |@!prefix| can be any
+character reserved for that purpose (`/' in VMS, `-' in Unix, etc). The
+keyword is one letter, in upper or lower case. The value is usually an
+integer. The permitted keys are:
+\item {\tt /p} |printfilename| to redirect output,
+\item {\tt /q} to suppress the information messages,
+\item {\tt /r} to suppress form feeds in the output,
+\item {\tt /s} to suppress blank lines,
+\item {\tt /i} attempts a screen view, (i stands for `|inspection|')
+\item {\tt /b} attempts a `batch' view version. The difference between these
+is that {\tt /i} tries to give immediate output on the terminal and {\tt /b}
+puts it in a file to be examined later.
+\item {\tt /m} (number) to give the magnification,
+\item {\tt /x} (number) to give a horizontal magnification,
+\item {\tt /y} (number) to give a vertical magnification,
+\item {\tt /d} (directory) specifies an alternative font directory,
+\item {\tt /f} (number) to give the first page number,
+\item {\tt /c} (number) to give the maximum number of pages to print.
+\item {\tt /e}, {\tt /o, /l } are reserved for use by certain changefiles.
+
+Here are the defaults:
+
+@<Set init...@>=
+ quiet := false ;
+ run_on := false ;
+ squash := false ;
+ magnify := 100 ;
+ h_mag := 100 ;
+ v_mag := 100 ;
+ batch_view := false ;
+ first_page := -1000000 ;
+ count_pages := 1000000 ;
+ print_name := blank ;
+
+@ @<Glob...@>=
+ command: var_string ;
+ squash, run_on, quiet, batch_view: boolean;
+ magnify, h_mag, v_mag, first_page, count_pages : integer ;
+
+@ If either {\tt /x} or {\tt /y} is present as well as {\tt /m}, they
+both take effect. Note these numbers are percents; default = 100
+means use the mag. specified in the \.{DVI} file. {\tt /v} implies
+{\tt /s} and {\tt /r}, and it also alters the vertical magnification
+and suppresses overstriking.
+
+@<If the |key| is valid, do the corresponding command@>=
+ if ( key = "Q") then quiet := true
+ else if ( key = "S") then squash := true
+ else if ( key = "R") then run_on := true
+ else if ( key = "P") then get_name( print_name)
+ else if ( key = "D") then get_name( tfm_def)
+ else if ( key = "F") then get_val( first_page)
+ else if ( key = "C") then get_val( count_pages)
+ else if ( key = "M") then get_val( magnify)
+ else if ( key = "X") then get_val( h_mag)
+ else if ( key = "Y") then get_val( v_mag)
+
+@ 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@>
+
+@ 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) ;
+
+@ Nobody enjoys filling in forms; so we only ask a few parameters in
+interactive mode. Most characters in \TeX\ fonts are narrower than
+line-printer characters. So we must spread them out to make them fit.
+Originally, this was done by multiplying \.{DVI} distances by a constant
+factor |h_fudge|. This is all right for one size of type but it tends to fail
+for other sizes because if the predominant type size is larger than expected,
+then rounding with a constant factor makes everything\qquad\ very\qquad\
+badly\qquad\ spread\qquad\ out. It seemed that the least bad way to tackle
+this is to allow the user to specify an extra magnification factor.
+@^magnification@>
+
+@<Ask the user@>=
+ if can_interact then begin
+ buffer := blank ;
+ ask_prompt('First page? (default = print ALL pages) ' );
+ if ( buffer.len > 0) then get_val( first_page) ;
+ ask_prompt('Maximum no. of pages? (default = 1000000) ' ) ;
+ if ( buffer.len > 0) then get_val( count_pages) ;
+ ask_prompt (
+ 'What magnification? (integer, percent, default=100%=DVI file mag)1') ;
+ if ( buffer.len > 0) then get_val( magnify) ;
+ end;
+ @.First page?@>@.Max. no. of pages?@>@.What magnification?@>
+
+@ Since the terminal is being used for both input and output, some systems
+need a special routine to make sure that the user can see a prompt message
+before waiting for input based on that message. (Otherwise the message may
+just be sitting in a hidden buffer somewhere, and the user will have no idea
+what the program is waiting for.) Here, we assume that the system-dependent
+macros |@!i_reset_terminal| and |@!o_rewrite_terminal| (defined above) will do
+whatever is necessary to switch the terminal from output to input and back. We
+assume that the terminal is normally in output mode, and call these macros
+when we want input. If the system does not allow this, then |@!can_interact|
+should be set false.
+
+Here is how the program prompts for input: the argument of |ask_prompt| is the
+prompt text. Because of the anomalous behaviour of |write|, this ought to work
+with arguments of any length, even on versions of \PASCAL\ that only allow
+fixed length strings.
+
+@d ask_prompt(#) == begin
+ display_ln(#) ; read_terminal ; end;
+
+@<Lowest...@>=
+ procedure read_terminal;
+ var k: byte ;
+ begin i_reset_terminal;
+ buffer := blank ;
+ if not eof(term_in ) then begin
+ if eoln(term_in) then read_ln(term_in);
+ k:=0;
+ while( not eoln(term_in)) do
+ begin incr(k); buffer.data[k]:=term_in^; get(term_in);
+ end;
+ buffer.len := k ;
+ finger := 0 ; get_char ;
+ end;
+ o_rewrite_terminal ;
+ end;
+
+@ If the printer is actually a VDU, then possibly the user will want to pause
+at intervals.
+
+@<Check pause@>=
+ if do_pause then begin
+ incr(pause_i) ;
+ if (pause_i >= pause_steps) then begin
+ flush_out ;
+ display(pause_ask);
+ i_reset_terminal;
+ read_ln (term_in );
+ o_rewrite_terminal ;
+ string_show(pause_after);
+ pause_i := 0 ;
+ end;
+ end;
+
+@ @<Const...@>=
+ pause_ask = 'PAUSED. Type <return> to continue' ;
+
+@* Interface to Operating System, 3: Input from binary files.
+
+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).
+@^Fuchs, D.R.@>
+
+@<Types...@>=
+ @!byte_block=packed array [0..block_length-1] of byte ;
+ @!byte_file= packed file of byte_block;
+
+@ @<Glob...@>=
+ dvi_file, tfm_file, raster_file: byte_file ;
+ dvi_indx, tfm_indx, raster_indx: integer ; {Block pointers}
+ dvi_name, tfm_name, raster_name, print_name, {File names}
+ dvi_def, tfm_def, raster_def, print_ex : var_string ; {and default names}
+ font_name, p_n, p_d, p_ex : var_string ;
+ {Scratch variables for assembling names}
+ printfile: text ;
+
+@ Here is the procedure that actually opens binary files. It searches for a
+file called |name|, supplying missing bits from the default file-specification
+in |other_name|. |f_f| is the file being opened, and |f_c| is its counter.
+
+@<Medium...@>=
+ function open_and_ask
+ (var f_f: byte_file; var f_c: integer; var name,
+ default: var_string; ask: boolean) : boolean ;
+ var success, fail: boolean;
+ def_dir, def_nam, def_ex, try_dir, try_nam, try_ex: var_string ;
+ begin
+ success := false; fail := false ;
+ repeat
+ @<Assemble the |name|@> ;
+ success := open_binary(f_f, name ) ;
+ if success then f_c := 0
+ else @<Try another name@>
+ until success or fail ;
+ open_and_ask:= success ;
+ end;
+
+@ @<Assemble the |name|@>=
+ parse_file( default, def_dir, def_nam, def_ex) ;
+ parse_file( name, try_dir, try_nam, try_ex) ;
+ if ( try_dir.len = 0) then name := def_dir
+ else name := try_dir ;
+ append ( name , try_nam);
+ if ( try_ex.len = 0) then append ( name , def_ex)
+ else append ( name, try_ex) ;
+
+@ If this fails, then ask the user for another name. If the operating system
+forbids this, or if the user refuses, then indicate a failure.
+
+@<Try another name@>=
+ if ask then begin
+ display('Couldnt open file: ' );
+ string_show(name) ;
+ display_ln (' ') ;
+ if can_interact then begin
+ ask_prompt('Please type a replacement or NO to abandon search' ) ;
+ name := buffer ;
+ if ( (name.len = 2) and
+ ( (name.data[1] = 'N') or (name.data[1] = 'n'))
+ and ( (name.data[2] = 'O') or (name.data[2] = 'o')))
+ then fail := true;
+ end else fail := true;
+ end else fail := true;
+ @.Couldnt open file@>@.Please type...@>
+
+@ \.{DVItype} has seven functions for reading integers from the \.{DVI} file
+and two more for the \.{TFM} file. I have condensed these. In order for
+these procedures to work, they must all have as parameters both the file and
+its attached counter. These macros generate the procedure calls.
+
+@d read_end(#) == # @=)@>
+@d skip(#) == skip_bytes @=(@> # @& file, # @& indx, read_end
+@d get_integer(#) == read_integer @=(@> # @& file, # @& indx, read_end
+@d get_byte(#) == read_byte(# @& file, # @& indx)
+@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...@>
+
+@ The next function reads an integer from a file. |k| specifies the type.
+|abs(k)| is the number of bytes, and the integer will be signed if |k<0|.
+
+@<Lowest...@>=
+ function read_integer
+ (var f_file: byte_file; var f_indx: integer; k: integer): integer;
+ var a, i : byte; n: integer;
+ begin n := get_byte(f );
+ if (k < 0) and (n > 127) then n := n-256 ;
+ for i := 1 to abs(k) - 1 do
+ begin
+ a := get_byte(f ) ;
+ n := n*256 + a ;
+ end ;
+ read_integer := n ;
+ end;
+
+@ A real number is stored in the file as 2 integers, numerator first.
+
+@<Medium...@>=
+ function read_real(var f_file: byte_file; var f_indx: integer ): real_number;
+ var a, b: integer;
+ begin a := get_integer(f )(-4);
+ b := get_integer(f )(-4);
+ if b <= 0 then
+ begin
+ warn('Denominator <= 0! '); read_real:= 1;
+ end
+ else read_real:= make_real(a)/make_real(b) ;
+ end;
+ @.Error: Denominator...@>
+
+@* Page selection.
+
+We have now disposed of all the code that is known to be system-dependent, so
+we can resume a proper top-down description of the program. The basic method
+for processing each page is that all printable characters are written onto a
+structure called a `page image'. This is a list of things called `page
+records'. Each page record represents one printable character, and contains
+two fields giving the intended position on the page. Eventually the image will
+be sorted and then copied to the |printfile|. This means that \.{Crudetype}
+has to remember three sets of coordinates. In order to help to keep track of
+many global variables, we use prefixes. \.{DVI} variables are prefixed with
+|D_|, page image variables with |IM_|, and the printer's variables with |PR_|.
+When this module starts, the \.{DVI} file should be positioned at or before a
+BOP.
+
+@<For each page...@>=
+ read_BOP;
+ if (counter[0] >= first_page) then start := true ;
+ if start and (count_pages > 0 )
+ then begin
+ @<Maybe a formfeed@>
+ decr(count_pages);
+ if not quiet then display('[', counter[0]:1 ); {Progress report}
+ Read_one_page ;
+ @<Sort the page@>
+ Send_page ;
+ if not quiet then display( ']' );
+ end
+ else if ( count_pages > 0) then Skip_page
+ else time_to_stop := true;
+
+@ This program only gives a small subset of the page-selection facilities of
+\.{DVItype}. The most you can do is to specify the starting page and the
+maximum number of pages to print. This will be controlled by these variables:
+
+@<Glob...@>=
+ start, time_to_stop, page_gap: boolean;
+ counter: array[0..9] of integer ;
+
+@ @<Set init...@>=
+ start := false ; time_to_stop := false; page_gap := false ;
+ for in_i := 0 to 9 do counter[ in_i ] := 0 ;
+
+@ |@!D_com| is the \.{DVI} command byte, |@!D_par| its first parameter.
+
+@<Top level...@>=
+ procedure Read_one_page ;
+ var D_com: byte; D_par: integer; end_page: boolean ;
+ begin end_page := false;
+ @<Set up an empty page image and |push| the position@>
+ repeat
+ @<Get \.{DVI} command |D_com|, and do it@>
+ until end_page;
+ pop ;
+ end ;
+
+@#procedure Skip_page ;
+ var D_com: byte; D_par: integer; end_page: boolean ;
+ begin
+ end_page := false;
+ repeat
+ @<Skip \.{DVI} command, but we must process any |font_def|@>
+ until end_page;
+ end ;
+
+@* Translating the device-independent file, 1: The big switch.
+
+Refer to \.{DVItype} or to \.{TUG}boat (Vol.3, No.2) for a description of the
+\.{DVI} file format. As in \.{DVItype}, we process each \.{DVI} command via a
+big |case| statement. But 192 of the cases are very similar, so lets dispose
+of them first.
+ @.TUGboat@>
+
+@d id_byte=2 {identifies the kind of \.{DVI} files described here}
+@d move_right ==
+ D_h := D_h + D_dis ;
+ IM_h := IM_h + IM_dis
+
+@<Get \.{DVI} command...@>=
+ D_dis := 0 ; IM_dis := 0 ;
+ D_com := get_byte(dvi);
+ if D_com < 128 then begin
+ set_character(D_com); move_right ;
+ end
+ else if (D_com >= 171) and (D_com <= 234) then
+ change_font(D_com - 171)
+ else
+
+@ @<Skip \.{DVI} command...@>=
+ D_com := get_byte(dvi);
+ if (D_com < 128)
+ or ((D_com <= 234) and (D_com >= 171))
+ then do_nothing
+ else
+
+@ Now we come to the |case| statement proper. This section of the program is
+long and complicated, and I have tried to clean it up. Some commands want an
+unsigned parameter, called |D_par|, to be read from the file. We use
+|four_cases| for those. Others want a signed parameter; they are all
+movements. We use |move_cases| for those.
+
+@d four_case_end(#) == # ; end
+@d four_cases(#)==
+ #,#+1,#+2,#+3: begin D_par := get_integer(dvi)( D_com - # + 1 );
+ four_case_end
+@d move_cases(#)==
+ #,#+1,#+2,#+3: begin D_par := get_integer(dvi)( # - D_com - 1 );
+ four_case_end
+@#
+
+@<Get \.{DVI} command...@>=
+case D_com of
+ four_cases(128) (set_character(D_par); move_right );
+ 132: begin set_rule; move_right ; end;
+ four_cases(133) (set_character(D_par) );
+ 137: set_rule ;
+ 138: do_nothing ;
+@#
+ 140: end_page := true ;
+ 141: push;
+ 142: pop;
+ move_cases(143) (D_h := D_h+D_par);
+ 147:{W0} D_h := D_h+D_w ;
+ move_cases(148) (D_w := D_par; D_h := D_h+D_w );
+ 152:{X0} D_h := D_h+D_x ;
+ move_cases(153) (D_x := D_par; D_h := D_h+D_x );
+ move_cases(157) (move_down(D_par));
+ 161:{Y0} move_down(D_y);
+ move_cases(162) (D_y := D_par; move_down(D_y) );
+ 166:{Z0} move_down(D_z);
+ move_cases(167) (D_z := D_par; move_down(D_z) );
+@#
+ four_cases(235) (change_font(D_par) );
+ four_cases(243) (define_font(D_par) );
+@#
+ @<Fourteen illegal cases: print suitable error messages@>
+end ;
+
+@ When skipping a page, we must throw away parameters instead of using them.
+
+@d four_throw(#) ==
+ #,#+1,#+2,#+3: skip(dvi)(D_com - # + 1 )
+@#
+
+@<Skip \.{DVI} command...@>=
+case D_com of
+ four_throw(128);
+ 132, 137: skip(dvi)(8); {sizes of a rule}
+ four_throw(133);
+ 138: ;
+ 140: end_page := true ;
+ 141,142: ;
+ four_throw(143);
+ 147: ;
+ four_throw(148);
+ 152: ;
+ four_throw(153);
+ four_throw(157);
+ 161: ;
+ four_throw(162);
+ 166: ;
+ four_throw(167);
+@#
+ four_throw(235);
+ four_cases(243) (define_font(D_par) );
+@#
+@<Fourteen illegal...@>
+end ;
+
+@ Finally, there are 14 illegal values of |D_com| that generate various errors.
+
+@<Fourteen illegal...@>=
+ four_cases(239)
+ (warn('Cant do Special commands') ; skip(dvi)(D_par) );
+ 139, 247, 248, 249:
+ bad_dvi('Byte: ', D_com:1 , ' out of context inside page' ) ;
+ 250,251,252,253,254,255:
+ bad_dvi('Illegal command byte, ', D_com ) ;
+ @.Error: Cant do Special@>
+ @.Fatal: Bad DVI: Byte out of context@>
+
+@* Translating the device-independent file, 2: Paging and the stack.
+
+The definition of \.{DVI} files refers to six registers, (|D_h, D_v, D_w,
+D_x, D_y, D_z|), which hold integer values in \.{DVI} units. We shall need
+additional registers in order to calculate a rounded position. From time to
+time, we save the current values of these on a stack, represented by the
+following arrays.
+
+@d max_stack = 200 {\.{DVI} files shouldn't |push| beyond this depth}
+
+@<Glob...@>=
+ D_h,D_v,D_w,D_x,D_y,D_z : integer; {current \.{DVI} state values}
+ D_h_stack, D_v_stack, D_w_stack, D_x_stack, D_y_stack, D_z_stack:
+ array [0..max_stack+2] of integer; {pushed down values }
+ @!stack_ht: 0..max_stack; {current stack depth}
+ just_pushed: boolean;
+
+@ @<Set up an empty page...@>=
+ D_w := 0 ; D_x := 0 ;
+ D_y := 0 ; D_z := 0 ;
+ stack_ht := 0 ;
+ rail_base := 0 ;
+ just_pushed := false ;
+
+@ Here is how \.{DVItype} manipulates the stack: The first |push| on a page
+fills the zeroth place on the stack and sets |stack_ht| = 1. So the used
+places are numbered |0..stack_ht- 1|. Now |push| and |pop| do the obvious
+things.
+
+@<Lowest...@>=
+ procedure push;
+ var x: real_number ;
+ begin if stack_ht=max_stack then
+ abort('Capacity exceeded (stack size=', max_stack:1,')')
+ else begin
+ D_h_stack[stack_ht]:=D_h; D_v_stack[stack_ht]:=D_v;
+ D_w_stack[stack_ht]:=D_w; D_x_stack[stack_ht]:=D_x;
+ D_y_stack[stack_ht]:=D_y; D_z_stack[stack_ht]:=D_z;
+ @<Some adjustments are needed here for rounding@>
+ incr(stack_ht); just_pushed := true ;
+ end;
+ end;
+ @.Fatal: Capacity exceeded...@>
+
+@# procedure pop;
+ begin if stack_ht=0 then warn('POP illegal at level zero')
+ else begin
+ decr(stack_ht);
+ D_h:=D_h_stack[stack_ht]; D_v:=D_v_stack[stack_ht];
+ D_w:=D_w_stack[stack_ht]; D_x:=D_x_stack[stack_ht];
+ D_y:=D_y_stack[stack_ht]; D_z:=D_z_stack[stack_ht];
+ IM_h := IM_h_stack[stack_ht];IM_v := IM_v_stack[stack_ht];
+ @<Set |rail_base|@>
+ end;
+ end;
+ @.Error: POP illegal...@>
+
+@ This procedure gets called when we expect to read a new page. It looks for
+the next |BOP|; if it finds the postamble instead, it sets |count_pages < 0| as
+a signal.
+
+@d POST = 248
+@d NOP = 138
+@d BOP = 139
+
+@<Top level...@>=
+ procedure read_BOP;
+ var k: byte ; D_par:integer ;
+ begin
+ repeat k:= get_byte(dvi);
+ if (k>= 243)and(k <= 246 ) then {a |font_def|}
+ begin D_par:=get_integer(dvi) (k-242 ); define_font(D_par); k:=NOP;
+ end;
+ until k<>NOP;
+ if k=POST then
+ count_pages := -1
+ else if k<>BOP then bad_dvi('Byte is not BOP')
+ @.Fatal: Bad DVI: Byte not BOP@>
+ else begin
+ for k:=0 to 9 do counter[k]:= get_integer(dvi)(-4);
+ skip(dvi)(4);
+ end;
+ end;
+
+@ A \.{DVI}-reading program that reads the postamble first need not look at the
+preamble; but \.{Crudetype} reads the \.{DVI} file sequentially.
+
+@d PRE=247 {preamble}
+
+@<Read \.{DVI} preamble@>=
+ bbb:= get_byte(dvi); {fetch the first byte}
+ if bbb<>PRE then bad_dvi('First byte isn''t start of preamble!');
+ @.Fatal: Bad DVI: First byte...@>
+ bbb:= get_byte(dvi); {fetch the identification byte}
+ if bbb<>id_byte then
+ warn('Identification byte should be ',id_byte:1,', it is actually', bbb:1 );
+ @.Error: Identification...@>
+ @<Compute the conversion factors@>;
+ bbb:= get_byte(dvi); {fetch the length of the introductory comment}
+ if quiet then skip( dvi)( bbb)
+ else begin
+ for nnn := 1 to bbb do
+ display(zchr(get_byte(dvi)));
+ display_ln(' ');
+ end;
+
+@ The conversion factor |h_conv| is figured as follows: There are exactly
+|n/d| decimicrons per \.{DVI} unit and 254000 decimicrons per inch, and
+|h_resolution| |h_steps| per inch.
+
+@<Glob...@>=
+ dvi_factor, h_conv, v_conv, magnification : real_number;
+ D_l_margin, D_top_margin, nnn:integer; {general purpose register}
+ bbb: byte ;
+
+@ @<Compute the conversion factors@>=
+ dvi_factor := get_real(dvi)/254000.0 ;
+ {This converts \.{DVI} units to inches (on an ideal device) }
+ D_l_margin := round( l_margin/dvi_factor) ;
+ D_top_margin := round( top_margin/dvi_factor) ;
+ magnification := get_integer(dvi)(4) / 1000 ;
+ dvi_factor := dvi_factor * magnification ;
+ dvi_factor := dvi_factor * make_real( magnify/ 100.0) ;
+ {Extra magnification specified by user}
+ h_conv:= dvi_factor * h_resolution * h_fudge * make_real( h_mag/ 100.0) ;
+ v_conv:= dvi_factor * v_resolution * v_fudge * make_real( v_mag/ 100.0) ;
+
+@* Translating the device-independent file, 3: Setting a Rule.
+
+|D_p| is the height and |D_q| is the width. A rule has to be assembled from
+the available characters. First: is the rule to be set at all? Second: is it
+horizontal or vertical? (Because of the limited name lengths, we call them
+|Post| and |Rail|.) The test applied here is quite arbitrary.
+
+@<Medium...@>=
+ procedure set_rule;
+ var D_p,D_q: integer;
+ begin
+ D_p:=get_integer(dvi) (-4);
+ D_q:=get_integer(dvi)(-4);
+ if (D_p<=0)or(D_q<=0) then
+ {an invisible rule! Dont ask me why \TeX\ wants to do this}
+ else if (D_p*v_conv <= post_height/2)
+ then do_rail(D_p, D_q)
+ else do_post(D_p, D_q);
+ end;
+
+@ Setting a vertical rule is simple: we just fill all the space with the
+relevant character.
+
+@<Lowest...@>=
+ procedure do_post(D_rul_ht, D_rul_width: integer);
+ var vn, vi, hn, hi, post_v, rule_hp : integer;
+ rule_cod: code_object ;
+ begin
+ @<|Post| set sizes@>;
+ for vi := vn - 1 downto 0 do
+ begin
+ post_v := IM_v - vi * post_height ;
+ for hi := 1 to hn do
+ begin
+ rule_hp := IM_h + (hi - 1) * post_width ;
+ do_set_char(post_v, rule_hp, rule_cod);
+ end;
+ end;
+ end;
+
+@ Note that whereas \.{DVItype} rounds all sizes up, \.{Crudetype} rounds to
+nearest integer. This seems more likely to work on a crude resolution. But we
+force the rounded size to be |>= 1| .
+
+@<|Post| set...@>=
+ round_IM_h ( 0);
+ hn := round(D_rul_width * h_conv / post_width );
+ vn := round(D_rul_ht * v_conv / post_height);
+ if hn <= 0 then hn := 1;
+ if vn <= 0 then vn := 1;
+ rule_cod := post_char;
+
+@ A horizontal rule is more complicated, as there is then a selection of
+characters. This matters if the printer has only a very coarse vertical
+positioning. For example, a line printer has only minus and underscore, but a
+VT-100 has 5 bars at different heights. |@!rail_types| should be set to the
+number of different horizontal bars that the printer can draw within one
+|v_step|. We measure the vertical position of a rule in |rail_steps|,
+which are smaller than |v_steps| in the same ratio.
+
+@<Glob...@>=
+ rail_chars : packed array [1..rail_types] of code_object ;
+ {Number from bottom of page up; so no. 1 might be an underscore}
+ rail_base : integer ;
+ {Position of bottom edge of a rule in |rail_steps|}
+ post_char : code_object ;
+
+@ @<Const...@>=
+ @<Rule setting constants@>
+ {Printer-dependent, so they must go at the end of the file}
+
+@ @<Lowest...@>=
+ procedure do_rail(D_rul_ht, D_rul_width: integer);
+ var vn, vi, hn, hi,
+ rail_v, {Current position in |rail_steps|}
+ char_vp, {Position in |v_steps| where a rule char will be set}
+ rule_hp: integer;
+ rule_cod: code_object ;
+ char_i : 1..rail_types ; {indicates which character to be used}
+ begin
+ @<|Rail| set sizes@>
+ for vi := vn-1 downto 0 do begin
+ rail_v := rail_base - vi ;
+
+@ Now to assign |char_i| and |char_vp|. The easiest way is to consider a simple
+example. Suppose |rail_types = 5| and |rail_v = 50|. This addresses the
+underscore at the bottom edge of a text character at |10 v_steps|.
+So |char_i| wants to be 1 and |char_vp| 10. So...
+
+@<Lowest...@>=
+ char_vp := ((rail_v - 1) div rail_types ) + 1 ;
+ char_i := rail_types - ((rail_v - 1) mod rail_types ) ;
+ rule_cod := rail_chars [ char_i] ;
+ for hi := 1 to hn do begin
+ rule_hp := IM_h + (hi-1) * rail_width ;
+ do_set_char(char_vp, rule_hp, rule_cod) ;
+ end;
+end;
+end;
+
+@ @<|Rail| set...@>=
+ round_IM_h ( 0);
+ hn := round(D_rul_width * h_conv/ rail_width);
+ vn := round(D_rul_ht * v_conv * rail_types/ rail_height );
+ if hn <= 0 then hn := 1;
+ if vn <= 0 then vn := 1;
+
+@ Now consider how to set |rail_base|. Horizontal rules are mostly used for
+underlining text, and then they should be aligned with the underscore
+character on the same line of text. So normally, we just do the following. The
+exception occurs when the \.{DVI} file does an explicit vertical move.
+
+@<Set |rail_base|@>=
+ rail_base := IM_v * rail_types ;
+
+@* Translating the device-independent file, 4: Changing and defining Fonts.
+
+The following tables describe all the \TeX\ fonts that \.{Crudetype} currently
+knows about.
+
+@<Glob...@>=
+ nf: D_font_ptr ;
+ {The number of fonts so far defined. These will be numbered |0..nf-1| }
+ @!font_num, {external font numbers}
+ @!font_space, {boundary between ``small'' and ``large'' spaces}
+ @!scheme, {pointer into |codes|}
+ @!first_ch, {First character in the font}
+ @!last_ch: {and last}
+ array [D_font_ptr] of integer;
+ D_width: array[D_font_ptr, D_char_ptr ] of integer ;
+ {character widths, as given in \.{TFM} file, should be in \.{DVI} units}
+ @!D_check, {the font checksum must be global for HPGF}
+ thin_space, D_font, cur_scheme: integer ; {The current values}
+
+@ @<Type...@>=
+ D_font_ptr = 0..max_D_fonts;
+ D_char_ptr = 0..max_D_char;
+
+@ The size of the tables can be altered at compile time to extend or reduce
+\.{Crudetype}'s capacity.
+
+@<Constants...@>=
+ @!max_D_fonts=100; {maximum number of distinct fonts per \.{DVI} file}
+ @!max_D_char = 255; {max. value of a \TeX\ character in a \TeX\ font}
+
+@ Initially, all these tables are blank.
+
+@<Set init...@>=
+ nf:=0;
+ for in_i := 0 to max_D_fonts do
+ begin
+ font_num[in_i ] := 0 ;
+ scheme[in_i ] := 0 ;
+ first_ch[in_i ] := 0 ;
+ last_ch[in_i ] := 0 ;
+ font_space[in_i]:= 0 ;
+ end;
+
+@ @<Set up an empty page...@>=
+ thin_space := 0 ;
+ D_font := nf ;
+ cur_scheme := 0 ;
+
+@ @<Medium...@>=
+ procedure change_font (D_new: integer);
+ begin
+ D_font := 0 ;
+ font_num[nf]:=D_new;
+ while( font_num[D_font]<>D_new) do incr(D_font);
+ if D_font = nf then
+ warn('Undefined font called for, number ', D_new:1 );
+ @.Error: Undefined font@>
+ cur_scheme := scheme[D_font] ;
+ thin_space := font_space[D_font] ;
+ end;
+
+@ The following procedure is called whenever we read a |font_def| command from
+the \.{DVI} file. In general, any error while defining a font causes a jump to
+label |bad_font|, leaving the new font undefined. |good_font| is a hook for the
+HP change file.
+
+@d bad_font = 9999
+@d good_font = 9998
+@d font_error(#) == begin
+ string_show( font_name) ; display(' ---- ') ;
+ warn( #);
+ goto bad_font ;
+end
+
+@<Medium...@>=
+ procedure define_font (D_new:integer );
+ label bad_font , good_font ;
+ var @<|font_def| vars@>
+ begin
+ @<Read the font parameters from the \.{DVI} file,
+ calculate scaling factors@>;
+ @<Try to load the new font, unless there are problems@>;
+ good_font:
+ @<Final checks; various mild errors which often are symptoms of bugs@>
+ incr(nf) ; {the new font is officially present}
+ bad_font: if font_ok then close_binary(tfm_file);
+ end;
+
+@ First we read the parameters from the \.{DVI} file. Whatever errors are
+found, we must try to do this, or we lose place in the file.
+
+@<|font_def| vars@>=
+ scale_size, design_size, k, f : integer;
+ dir_len, {length of the area/directory spec}
+ nam_len:byte; {length of the font name proper}
+ font_mag: real_number;
+
+@ @<Read the font parameters...@>=
+ @!D_check := get_integer(dvi)(-4) ;
+ scale_size:= get_integer(dvi)( -4) ;
+ design_size:= get_integer(dvi)(-4) ;
+ dir_len:= get_integer(dvi)(1) ;
+ nam_len:= get_integer(dvi)(1) ;
+ nam_len := nam_len + dir_len ;
+ if nam_len = 0 then
+ warn('Null font name! ')
+ @.Error: Null font name@>
+ else if nam_len >= max_string then
+ font_error('Too-long font name! length = ', nam_len:1 ) ;
+ @.Error: Too-long font name@>
+ tfm_name := blank ;
+ for k:=1 to nam_len do begin
+ tfm_name.data[k] := zchr(get_byte(dvi)) ;
+ end;
+ tfm_name.len := nam_len ;
+ font_name := tfm_name ;
+
+@ Next, check that the sizes are reasonable:
+
+@<Read the font parameters...@>=
+ if (scale_size<=0)or(scale_size>=@'1000000000) then
+ font_error('Bad scale (',scale_size:1,')!')
+ @.Error: Bad scale@>
+ else if (design_size<=0)or(design_size>=@'1000000000) then
+ font_error('Bad design size (',design_size:1,')!') ;
+ @.Error: Bad design size@>
+ font_mag := scale_size/design_size ;
+ if (font_mag > 1000) or (font_mag < 0.001) then
+ font_error('Way-out font magnification!!! ', font_mag) ;
+ @.Error: Way-out font mag...@>
+ if nf=max_D_fonts then
+ abort('Capacity exceeded (max fonts=', max_D_fonts:1,')!');
+ @.Fatal: Capacity exceeded...@>
+ font_num[nf]:=D_new; f:=0;
+ while( font_num[f]<>D_new) do incr(f);
+ if f<nf then font_error('Font was already defined!');
+ @.Error: Font already defined@>
+ font_space[nf] := scale_size div 6 ; {a `thin space' }
+
+@* Loading the font file.
+
+See \.{TFTOPL} or \TeX 82 for details of the \.{TFM} file format. The
+description given in \.{TUGboat} (Vol.2, no. 1) is apparently no longer
+accurate. The only difference that I have seen is that all words of the font
+header array after the first 2 are now apparently regarded as optional.
+@.TFTOPL@> @.TeX82@> @.TUGboat@>
+
+@<Try to load...@>=
+ @<Open font file@>
+ if not font_ok then
+ font_error('TFM file can''t be opened!');
+ @.Error: TFM file cant be opened@>
+ @<Read past the header data, leave the file pointer just after the header@>
+ @<Read the character-width indices@>
+ @<Read the widths, copy them into the font array@>
+
+@ @<|font_def| vars@>=
+ @!font_ok: boolean ;
+ @!TFM_check,
+ @!lh, {length of the header data, in four-byte words}
+ @!nw:integer; {number of words in the width table}
+
+@ @<Read past the header...@>=
+ skip(tfm)(2); lh:= get_integer(tfm)(2);
+ first_ch[nf]:=get_integer(tfm)(2); last_ch[nf]:=get_integer(tfm)(2);
+ if (last_ch[nf]<first_ch[nf]) or (last_ch[nf] > max_D_char) then
+ font_error(
+ 'Illegal values for first_char and/or last_char, first_char = ',
+ first_ch[nf]:1 , ' last_char = ', last_ch[nf]:1 );
+ @.Error: Illegal value@>
+ nw:=get_integer(tfm)(2);
+ if (nw=0)or(nw>256) then
+ font_error('Illegal value for nw, nw= ', nw );
+ @.Error: Illegal value@>
+ skip(tfm)(14);
+ TFM_check := get_integer(tfm)(-4);
+ skip(tfm)(4);
+ @<Get coding scheme and re-align file, then see if the printer knows it@>
+
+@ The header contains |4*lh| bytes, of which 8 have been read so far. If it
+conforms to the \.{TUGboat} format, then the next byte (|@!ck|, say) is the
+number of bytes in the coding scheme name. So, first we must try to see if a
+scheme is present; if so, then we will read |ck+1| bytes and chuck the rest.
+If no coding scheme is present, we simply skip the rest of the header.
+Internally, scheme names are represented by |var_string|s.
+
+@<Get cod...@>=
+ tfm_scheme := blank ;
+ if lh < 2 then font_error( 'Header must have at least 2 words')
+ @.Error: Header...@>
+ else if lh = 2 then do_nothing
+ else begin
+ ck := get_byte(tfm);
+ if ( ck >= 40 ) or ( ck > 4*lh - 9) then
+ skip(tfm)(4*lh - 9)
+ {there is something here, but not a coding scheme}
+ else begin
+ tfm_scheme.len := ck ;
+ for k := 1 to ck do
+ tfm_scheme.data[ k] := zchr(get_byte(tfm)) ;
+ skip(tfm)(4*lh - ck - 9);
+ upcase(tfm_scheme) ;
+ end;
+ end;
+
+@ @<|font_def| vars@>=
+ f_n , ck : byte ;
+ try_name, tfm_scheme: var_string ; {coding scheme of current font}
+
+@ Now we can start reading the character widths.
+
+@<|font_def| vars@>=
+ @!in_width:array[byte] of integer; {\.{TFM} width data in \.{DVI} units}
+ @!wid_ptr: array[byte] of byte ; {pointers into |in_width|}
+ b3,b2,b1,b0: byte; {bytes from \.{TFM} file}
+ @!alpha,@!beta, @!z :integer;
+
+@ @<Read the character-width indices...@>=
+ for k:=first_ch[nf] to last_ch[nf] do
+ begin wid_ptr[k] := get_byte(tfm); skip(tfm)(3);
+ if wid_ptr[k] > nw then font_error('Impossible width ' , wid_ptr[k]);
+ end;
+ @.Error: Impossible width@>
+
+@ Here is the width computation. This code is copied from \.{DVItype}. See
+that program for an explanation.
+
+@<Read the font parameters...@>=
+ z := scale_size ;
+ alpha:=16*z; beta:=16;
+ while( z>=@'40000000) do
+ begin z:=z div 2; beta:=beta div 2;
+ end;
+
+@ @<Read the widths...@>=
+ for k:=0 to nw-1 do
+ begin
+ b0 := get_byte(tfm); b1 := get_byte(tfm);
+ b2 := get_byte(tfm); b3 := get_byte(tfm);
+ in_width[k]:=
+ (((((b3*z)div@'400)+(b2*z))div@'400)+(b1*z))div beta;
+ if b0 = 255 then in_width[k]:=in_width[k]-alpha
+ else if b0 <> 0 then
+ font_error('Out-of-bounds value for b0') ;
+ @.Error: Out-of-bounds |b0|@>
+ end ;
+
+@ Rounding widths. This bit of \.{DVItype} is changed, because \.{Crudetype}
+has to calculate rounded positions by a completely different method.
+
+@<Read the widths...@>=
+ if in_width[0]<>0 then font_error('First width should be zero ');
+ @.Error: First width...@>
+ for k:= first_ch[nf] to last_ch[nf] do
+ D_width[nf, k] := in_width[ wid_ptr[k]] ;
+
+@ Then there are various erroneous states that do not necessarily show that
+the font is corrupt, but may indicate bugs in the program. In principle, a
+character might have negative width, but I do not believe it.
+
+@d bad_char = -32766 {Indicates an unprintable character}
+@d foot == 50000000 {about a foot}
+
+@<Final checks...@>=
+ for k:= first_ch[nf] to last_ch[nf] do
+ if (D_width[nf, k] < 0) or (D_width[nf, k] > foot) then begin
+ warn('Way-out width = ', D_width[nf,k]:1,
+ 'DVI units, character number ', k:1 );
+ codes[ scheme[nf], k].breadth := bad_char ;
+ end;
+ if (D_check<>0)and(TFM_check<>0)and(D_check<>TFM_check) then
+ begin warn('Check sums do not agree!');
+ @.Error: Check sums...@>
+ display_ln('DVI check was: ', D_check, ' TFM check was: ', TFM_check);
+ display(' ');
+ end;
+ font_mag := (font_mag -1) * 100.0 ;
+ if not quiet then begin
+ display_ln( ' ');
+ string_show( font_name);
+ display( ' --- loaded at ',scale_size:1,' DVI units');
+ if abs(font_mag) > 1 then
+ display(' ( magnified ', round(font_mag):1,'%)');
+ display_ln(' ');
+ end;
+ @.loaded at ...@>
+ @.magnified...@>@.Error: Way-out width@>
+
+@* Coding schemes.
+
+In this section we describe the mapping from \TeX\ fonts to the printer's
+fonts. These are presumably much fewer because all characters on a crude
+printer are the same size. The mapping is defined in an array called |codes|.
+Each entry of this gives the printer's equivalent for a \TeX\ character.
+
+@<Glob...@>=
+ @!known_schemes: array[code_ptr] of var_string ;
+ @!scheme_map: array [code_ptr] of code_ptr ;
+ @!codes: array[code_ptr, D_char_ptr] of code_object;
+ no_char: code_object ;
+ scheme_top: code_ptr;
+
+@ If |c| is a |code_object|, then |c.breadth| will usually be its printed
+width in |h_steps|. |c.breadth = bad_char| indicates that the character is
+unprintable. |bad_char| can be any large negative value. Other negative values
+of |@!breadth| indicate other types of peculiar characters.
+
+@d down_loaded = -32765
+
+@<Types...@>=
+ 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;
+ code_ptr = 0..max_codes;
+ {0 is a coding scheme the printer doesnt know about}
+
+@ Initially, all these tables are blank.
+
+@<Set init...@>=
+ no_char.breadth := bad_char ;
+ no_char.IM_font := 0 ;
+ no_char.IM_char := 0 ;
+ scheme_top := 0 ;
+ for in_i := 0 to max_codes do begin
+ known_schemes[in_i] := blank ;
+ scheme_map[in_i] := 0 ;
+ for in_j := 0 to max_D_char do begin
+ codes[in_i, in_j] := no_char ;
+ end;
+ end;
+
+@ This procedure sets a character. The character to be set is number |@!c_num|
+in the current font. I have deleted the bit of \.{DVItype} that deals with
+oriental fonts, as I dont believe that crude printers can support them.
+
+@<Medium...@>=
+ procedure set_character(c_num: integer );
+ var cod: code_object;
+ d_i : integer; {Used for downloading}
+ begin
+ if cur_scheme = 0 then
+ else if (c_num < first_ch[D_font] ) or (c_num > last_ch[D_font] )
+ then begin
+ warn('Character ',c_num:1,' invalid in font number ',
+ font_num[ D_font]:1 );
+ @.Error: Character invalid...@>
+ end
+ else begin
+ cod := codes[ cur_scheme, c_num];
+ if cod.breadth <> bad_char then begin
+ round_IM_h( c_num) ;
+ if cod.breadth = down_loaded then
+ @<Enter a download request for |cod| and adjust its |breadth|@> ;
+ do_set_char(IM_v, IM_h, cod ) ;
+ @<Do messy things to adjust the positions |D_h|, |IM_h|, etc@>;
+ end;
+ end;
+ end;
+@#
+ procedure do_set_char ;
+ var k_i, k_k, temp_v, temp_h: i_word ;
+ m_c: code_object ;
+ k_ptr: 1..max_ligs;
+ begin
+ if cod.breadth >= 0 then begin
+ @<Check the position@>
+ @<Add the record to the page image@>
+ end
+ else if cod.breadth = bad_char then do_nothing
+ else @<Set multi-character command@> ;
+ end;
+
+@ @<Forw...@>=
+ procedure do_set_char(Set_v, Set_h: i_word; cod: code_object ); forward;
+
+@ So when a font is read in, we try to find its coding scheme by comparing
+the font with the list of |known_schemes|. If the printer is not absolutely
+crude, then it might have italic or bold fonts. Then we might want a coding
+scheme to correspond to a single \TeX\ font. But if the printer is
+|fixed_width|, then all fonts of the same face are the same size. So first we
+look at the actual font name and see if that matches any of the
+|known_schemes|. If that fails, drop the font size digits off the end of the
+name and try again. Then try again with the scheme given in the \.{TFM} file.
+If the font matches |known_schemes[ s]| then |scheme_map[ s]| will point to
+the relevant row of |codes|.
+
+@<Read the font parameters...@>=
+ try_name := tfm_name ;
+ upcase( try_name) ;
+
+@ @<Get cod...@>=
+ f_n := name_search( try_name) ;
+ if ( f_n = 0) then begin
+ k := try_name.len ;
+ while ((zord(try_name.data[k]) >= "0" ) and
+ (zord(try_name.data[k]) <= "9" )) do begin
+ try_name.data[ k] := ' ' ;
+ decr( k) ;
+ end;
+ try_name.len := k ;
+ f_n := name_search( try_name) ;
+ if ( f_n = 0) then
+ f_n := name_search( tfm_scheme) ;
+ end;
+
+@ If all these tries fail, then try if we can download the font. If that
+fails print a warning and try using the TEX TEXT scheme -- this may have
+some odd effects but it's worth a try.
+
+@<Get cod...@>=
+ if (f_n = 0) and can_dl_font then
+ @<Download a whole font@>
+ else if ( f_n = 0) then begin
+ string_show( font_name) ;
+ display_ln( ':');
+ if ( tfm_scheme.len > 0) then
+ warn( 'Unknown coding scheme, using TEX TEXT instead')
+ else
+ warn( 'No coding scheme, using TEX TEXT instead (examine NOSCHEME.ADD) ') ;
+ scheme [ nf] := scheme_map[ 3] ;
+ end
+ else scheme[ nf] := scheme_map[ f_n];
+ @.Error: Unknown coding scheme@>
+ @.Error: No coding scheme@>
+
+@ @<Lowest...@>=
+ function name_search( ss: var_string): code_ptr;
+ var i: code_ptr;
+ begin i := scheme_top;
+ while (( i > 0) and ( not equals( ss, known_schemes[ i]))) do decr( i) ;
+ if ( i=0) then name_search := 0
+ else name_search := i ;
+ end;
+
+@ This creates a scheme name. It gets used in the combination:
+|be_string( 'QUEER SCHEME' ); set_scheme (123);|
+
+@<Lowest...@>=
+ procedure set_scheme( ix: code_ptr) ;
+ begin
+ incr( scheme_top) ;
+ upcase( buffer);
+ known_schemes[ scheme_top] := buffer ;
+ scheme_map[ scheme_top] := ix ;
+ end;
+
+@* Multiple-character commands.
+
+Several crude printers (e.g. daisy-wheels) have only a limited set of
+characters, which cannot be extended. Sometimes you can generate more
+characters by overstriking. \.{Crudetype} can be programmed to do this, by
+placing suitable entries into a table called |ligatures|. The name is chosen
+by analogy with the |lig_kern| programs in \.{TFM} files, but the data is
+completely different. When one \TeX\ character maps onto several printer
+characters, we call the image a `multi-character' command.
+
+@<Const...@>=
+ max_ligs = 10000 ;
+
+@ @<Glob...@>=
+ ligatures : array[1..max_ligs] of lig_thing;
+ top_of_ligs: 0..max_ligs ; {highest used point in |ligatures|}
+
+@ @<Types...@>=
+ 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;
+
+@ @<Set init...@>=
+ top_of_ligs := 0;
+ for in_i := 1 to max_ligs do ligatures[ in_i].symbol := no_char ;
+
+@ The |code_object| addresses a multiple character when its |breadth| is
+negative, and not one of the special classes defined above. It must then be
+the |false| variant, and its |multi| field (which must be |>0|) points to the
+corresponding entry in |ligatures|. Suppose that field is |c| . Then
+|ligatures[c]| is the last entry of a string of items that defines the
+replacement text of the |code|. It should be of the third variant; The |num|
+field of this entry counts the number of characters that |code| expands into.
+The |guard| field is an arbitrary impossible value called |sentry| to give a
+check on the data in |ligatures| .
+
+@d sentry = -32767
+
+@<Set multi...@>=
+ begin
+ if (cod.multi <= 0) or (cod.multi > top_of_ligs) then
+ warn('Illegal value of char in multi-character command')
+ @.Error: Illegal value@>
+ else begin
+ k_ptr := cod.multi ;
+ if (ligatures[k_ptr].guard <> sentry) then
+ warn('Sentry not found in Kerns ' ) ;
+ @.Error: Sentry ...@>
+ k_i := ligatures[k_ptr].num ;
+ k_ptr := k_ptr - 2*k_i ;
+ if (k_i <= 0) or (k_ptr < 0 ) then
+ warn('Illegal value of k_i in multi-character command');
+ @.Error: illegal value@>
+ for k_k := 1 to k_i do
+ @<Get that character and write it@>;
+ end;
+ end
+
+@ Each character of a multi-character command needs 2 entries in |ligatures|.
+The first defines the position, the second defines the character. |v_move| and
+|h_move| are relative to the current (rounded) position |Set_v, Set_h| and use
+the same units. A multi-character command can call another one recursively.
+
+@<Get that character ...@>=
+ begin
+ temp_v := Set_v + ligatures[k_ptr].v_move ;
+ temp_h := Set_h + ligatures[k_ptr].h_move ;
+ incr(k_ptr);
+ m_c := ligatures[k_ptr].symbol ;
+ do_set_char(temp_v, temp_h, m_c ) ;
+ incr(k_ptr);
+ end;
+
+@* Getting data into the |codes| array.
+
+This is clearly a very long and error-prone job, so the next procedures are put
+in to reduce this. First suppose that: in the \TeX\ coding scheme with number
+|s|, a run of |length| characters starting from |start| maps onto a run of
+consecutive characters in printer font |PR_font|, starting at |PR_first|. This
+procedure will enter the whole run at one go.
+
+@<Lowest...@>=
+ procedure alphabet
+ (start, length: byte; s: code_ptr ; PR_font, PR_first : byte );
+ var i:integer; ccc:code_object;
+ begin @<Check alphabet data@>;
+ ccc.IM_font := PR_font ;
+ ccc.breadth := char_width ;
+ for i := 0 to length-1 do begin
+ ccc.IM_char := PR_first +i;
+ codes[s, start+i] := ccc ;
+ end; end;
+
+@ @<Check alph...@>=
+ if (s < 1) then abort('Alphabet: scheme < 1 ')
+ else if (s > max_codes) then abort('Alphabet: scheme too large')
+ else if (PR_first < 0) then abort('Alphabet: negative first')
+ else if (start < 0) then abort('Alphabet: negative start')
+ else if (length < 0) then abort('Alphabet: negative length')
+ else if (start + length -1 > max_D_char) then abort('Alphabet: overflow')
+ @.Fatal: Alphabet...@>
+
+@ Clearly, |alphabet| will only cover a very small part of the problem. The
+next procedure enters data into a subset of the |codes| array corresponding to
+a single row of a \TeX\ font. In the standard font tables, row number |m| is
+the subrange |8*m..8*m+7| of a font. We hope that when the calls of |row| are
+written out in a program, the result will be (just about) legible, whereas a
+flood of statements like \begintt
+ codes[i,j].IM_font := 121; \endtt
+is certainly not legible.
+
+Because \PASCAL\ has no decent string handling, we cannot call |row|
+in any sensible way. It must be used in combination:
+| be_string( 'row-spec') ; row( scheme, row_num, first_font);|
+The |@!row_spec| is a character string that specifies what characters
+are to go into the row; the |be_string| is needed to turn the
+|row_spec| into a |var_string|. |@!scheme | is the number assigned to
+the \TeX\ coding scheme within the program. |@!row_num | is the number
+of the row in that scheme (starting from 0). |@!first_font| is the
+initial printer font. The diagnostics of |row| are known to be poor,
+but they are really intended for the installer rather than the
+end-user; so I have not tried to improve them.
+
+@<Top...@>=
+ procedure row ( scheme, row_num: integer; first_font: i_word );
+ label exit ;
+ var n :integer; codd: code_object;
+ begin
+ row_font := first_font ;
+ finger := 0 ;
+ for n := 8*row_num to 8*row_num + 7 do begin
+ row_char (0 ,codd);
+ if ( codd.breadth = bad_char) then do_nothing
+ else codes[ scheme, n ] := codd ;
+ end;
+ exit:
+ end;
+
+@ @<Glob...@>=
+ row_font: i_word; {printer font being addressed during the |row| procedure}
+
+@ The overall format of the |row_spec| is a set of 8 character specifiers
+separated by one or more spaces. The procedure |row_char| reads one character
+specifier from the |row_string|, and constructs the specified |code_object|.
+Logically, |row_char| should be a function and return that |code_object| as
+its value. \PASCAL\ does not permit this. So we assemble the result in the
+variable parameter |value|.
+
+@<Medium...@>=
+ procedure row_char(context: integer; var value: code_object);
+ label exit ;
+ const @<|Row_char| constants@>
+ var @<Row locals@>
+ begin
+ value.breadth := char_width ; {default}
+ value.IM_font := row_font ; {default font}
+ get_char ;
+ if ( context=0) and ( ch <> " " ) and ( ch <> "Z" ) then
+ string_warn('Character specifiers must start with at least one space') ;
+ while (inside and space) do get_char;
+ if not inside then string_warn ( 'Fallen off row') ;
+ @<Escape sequences in the |row_spec|@>
+ else value.IM_char := ch ;
+ exit:
+ end;
+ @.Error: Character spec...@>@.Error: Fallen off row@>
+
+@ There are several escape sequences that need to go into the |rowstring|.
+Since all the PLAIN.TEX coding schemes (except the math extension one) have
+the upper case Roman characters in their ASCII positions, these characters
+will surely be inserted into |codes| by the |alphabet| procedure. So they are
+available as flag characters. But the brackets are also used as flags, as they
+are so much more perspicuous than anything else. Here is a list of the
+characters currently used as escapes: \begintt
+
+A C D E F K L M N S Q U W Z \endtt
+
+This list should be updated if other escapes are added .
+@^Escape sequences@>@.ASCII@>
+
+@ Some characters, called `bad', have most undesirable effects when used in
+\.{WEB} strings. So the following upper-case letters stand for them. The
+actual characters may not be used, so they generate errors.
+
+@<Esc...@>=
+ if ( ch = "A") then value.IM_char := 64 {at sign}
+ else if ( ch = "S") then value.IM_char := 32 {a space}
+ else if ( ch = "Q") then value.IM_char := 39 { a single quote char}
+ else if ( ch = "W") then value.IM_char := 34 { a double quote char }
+ else if ( ch = "E") then value.IM_char := 127 { a delete char }
+ else if (ch = "'") or (ch = """") or (ch = "@@") or (ch = 127)
+ then string_warn( 'Bad character---Rejected' )
+ else if (ch = " ")
+ then string_warn('Space found out of context')
+ @.Error: Bad character@>@.Error: Space found...@>
+
+@ Then the `Z' escape is provided to generate a do-nothing code. This would
+be used if a previous call (say, of |alphabet|) had left a row partly
+incorrect. Then you might issue a call of |row| to change that row. Typing `Z'
+at the positions occupied by correct characters would leave them alone.
+
+@<Esc...@>=
+ else if ( ch = "Z") then value.breadth := bad_char
+
+@ Since many letters and brackets are used as escapes, the `L' escape is
+needed to enable them to be used Literally. `LL' generates `L'.
+
+@<Esc...@>=
+ else if ( ch = "L") then begin
+ get_char; value.IM_char := ch ; end
+
+@ In order to address printer characters in the range 0..32, where ASCII has
+no graphics, here is a Control escape. This simply reads the next character
+from the |row_spec| and reduces it modulo 32. It is best to use the lower case
+alphabet (the range 95..126) as this avoids all the `bad' characters (and
+their escapes). So control-A should be typed `Ca' , not `CA' .
+
+Then the Meta escape addresses meta-characters, i.e. those in the range
+128..255. We cannot just read a character and add 128, as we might want to
+Mutate the ASCII controls, or the `bad' characters. So `M' must read a complete
+|code_object| (respecting the escapes given above) and add 128 to its |IM_char|
+field. So we must say `MS' for `meta-space' = 160 , and `MLS' for `meta-S'
+= 211 .
+@.ASCII@>
+
+@d M_con == 250
+ {Context while reading a Meta character}
+
+@<Esc...@>=
+ else if ( ch = "C") then begin
+ get_char; value.IM_char := ch mod 32 ; end
+ else if ( context >= M_con) then value.IM_char := ch
+ {During a Meta, forbid any of the later escapes}
+ else if ( ch = "M") then
+ begin
+ row_char(M_con , value ) ;
+ value.IM_char := value.IM_char + 128 ;
+ end
+
+@ A |narrow| character is one with zero width. To generate one, precede it
+with an `N' . To mark a character as down-loadable, precede it with `D'. A
+character cannot be both narrow and down-loadable.
+
+@d N_con == 230
+ {Context while reading a Narrow or |down_loaded| character}
+
+@<Esc...@>=
+ else if ((ch = "N" ) or (ch = "D" )) and (context >= N_con) then
+ string_warn('Narrow or Down escape out of context')
+ @.Error: Narrow escape...@>
+ else if ( ch = "N") then
+ begin
+ row_char(N_con, value ) ;
+ value.breadth := 0 ;
+ end
+ else if ( ch = "D") then
+ begin
+ row_char(N_con, value ) ;
+ value.breadth := down_loaded ;
+ end
+
+@ Changing printer fonts in the middle of a |row| is done by inserting an `F'
+character, followed by an integer. This is the printer font to be used, from
+now on till the next `F' . Note that the initial font was passed as the 3rd
+parameter to |row|.
+
+@<Esc...@>=
+ else if ( ch = "F") then begin
+ row_font := s_to_i ( 0, true);
+ if ( context = 0) then row_char(1, value)
+ else row_char(context, value);
+ end
+
+@* Assembling a multi-character in |row|.
+
+Now we come to the difficult part, which is assembling a multiple-character
+command into the |ligatures| array. For this purpose, we use brackets. Curly
+brackets mean that the characters inside are to be overstruck, square brackets
+mean they are to be typed horizontally, and angle brackets mean that they are
+to be typed vertically above each other. Finally the `U' escape (which must
+come immediately after a |<| ) means to raise the (logical) cursor before
+starting the vertical list.
+
+ Warning!! I use the numerical (\.{ASCII}) values of these chars
+@^System dependencies@>@.ASCII@>
+
+@<|Row_char| const...@>=
+ o_bra = "{" ; o_ket = "}" ;
+ h_bra = "[" ; h_ket = "]" ;
+ v_bra = "<" ; v_ket = ">" ;
+ {`o' means overstrike, `h' means horizontal, and `v' vertical}
+
+@ So if we want to generate a Macsyma style summation sign, which looks like
+this: \begintt
+. ====
+. \
+. >
+. /
+. ====
+\endtt
+we have to insert the following mess into the |row_spec| string: \begintt
+ <S[====]\[SL>]/[====]>
+\endtt
+The `S' is needed to get correct vertical alignment. The `L' is needed to
+prevent the following |>| being taken as a |ket|. See the end of this file
+for examples.
+
+@ In order to keep some control over all these escape sequences, I have made a
+special rule of syntax. The escape sequences in |row_char| may only be nested
+in a definite order. That order is: (bad characters or Control or Literal)
+inside Meta inside (Narrow or Down-loadable) inside Font inside |o-list|s
+inside |h_list|s inside |v_list|s. The parameter |context| keeps track of
+this. The innermost constructions have the highest values of |context|. If
+these rules are broken the user should get an error message.
+
+@<Esc...@>=
+ else if (ch = o_bra) or (ch = h_bra) or (ch = v_bra)
+ then begin
+ if ( context >= ch) then
+ string_warn('Illegal nesting of brackets in row_spec');
+ @.Error: Illegal nesting@>
+ @<Assemble characters into |lig_buff| until we read the matching |ket|@>;
+ @<Copy |lig_buff| into |ligatures| and return a pointer to it@>;
+ end
+
+@ |hoister| and |ender| are arbitrarily selected impossible classes for a
+character, indicating respectively that a |v_list| has to be raised one
+|char_ht| or that a |ket| has been read.
+
+@d hoister = -32764
+@d ender = -32763
+
+@<Assemble char...@>=
+ for i := 1 to max_buf do lig_buff[ i].symbol := no_char ;
+ buf_len := 0; delta_h := 0; delta_v := 0;
+ bra := ch ;
+ repeat
+ row_char( bra, row_cod ) ;
+ @<Do suitable action if |row_cod| is peculiar@>
+ else begin
+ incr(buf_len);
+ lig_buff[buf_len].v_move := delta_v ;
+ lig_buff[buf_len].h_move := delta_h ;
+ incr(buf_len);
+ lig_buff[buf_len].symbol := row_cod ;
+ if ( bra = v_bra) then delta_v := delta_v + char_ht;
+ if ( ( bra = h_bra) or ( batch_view and ( bra = o_bra)))
+ then delta_h := delta_h + char_width ;
+ end;
+ until ( row_cod.breadth = ender) or not inside;
+
+@ @<Row loc...@>=
+ lig_buff: array[1..max_buf] of lig_thing ;
+ buf_num: 0..max_buf ;
+ {Number of characters (or multi-characters) in current list}
+ buf_len: 0..max_buf ;
+ {Number of used locations in |lig_buff|: should be |2*buf_num|}
+ delta_h, delta_v: i_word;
+ ch, bra: byte;
+ i: integer;
+ row_cod: code_object ;
+
+@ @<Const...@>=
+ max_buf = 201;
+
+@ @<Do suitable action...@>=
+ if ( row_cod.breadth = hoister) then delta_v := delta_v - char_ht
+ else if ( row_cod.breadth = ender) then
+ else if ( buf_len + 3 > max_buf) then
+ abort('Overflowed lig_buff array')
+ @.Fatal: Overflowed |lig_buff|@>
+
+@ @<Esc...@>=
+ else if (ch = "U" ) and (context = v_bra) then value.breadth := hoister
+ else if (ch = "U" ) then
+ string_warn('U escape out of context')
+ @.Error: U escape...@>
+ else if ((ch = o_ket) or (ch = h_ket) or (ch = v_ket)) and (context = ch-2)
+ then value.breadth := ender
+ else if (ch = o_ket) or (ch = h_ket) or (ch = v_ket)
+ then string_warn('Mismatching brackets ')
+ @.Error: Mismatching brackets@>
+
+@ Yet another escape is the |kern| escape. If the printer has reasonable
+positioning resolution, we may want to move the parts of a multi-character
+about to make them fit together better. So a |kern| takes an integer parameter
+and moves the next component of the current list by that many |steps| against
+the current direction. The reason for going back is that one can easily move
+forwards by setting a blank space.
+
+@d h_kern = -32762
+@d v_kern = -32761
+
+@<Esc...@>=
+ else if (ch = "K") and (context = h_bra) then value.breadth := h_kern
+ else if (ch = "K") and (context = v_bra) then value.breadth := v_kern
+ else if (ch = "K")
+ then string_warn('Kern escape out of context' )
+ @.Error: Kern escape@>
+
+@ @<Do suitable action...@>=
+ else if ( row_cod.breadth = h_kern)
+ then delta_h := delta_h - s_to_i ( 0, true)
+ else if ( row_cod.breadth = v_kern)
+ then delta_v := delta_v - s_to_i ( 0, true)
+
+@ @<Copy...@>=
+ buf_num := 0 ;
+ if ( buf_len = 0) then value.breadth := bad_char
+ else if ( top_of_ligs + buf_len + 1 >= max_ligs) then
+ abort ('Ligature array overflowed, must recompile with larger array')
+ @.Fatal: Ligature array overflowed@>
+ else begin
+ for i := 1 to buf_len do
+ ligatures[ top_of_ligs + i ] := lig_buff[i] ;
+ top_of_ligs := top_of_ligs + buf_len + 1 ;
+ buf_num := buf_len div 2 ;
+ ligatures[top_of_ligs].num:= buf_num ;
+ ligatures[top_of_ligs].guard := sentry ;
+ value.multi := top_of_ligs ;
+ value.breadth := -20000 ;
+ {Provisional: a nonsense value to make sure the correct value does get
+ inserted later}
+ end;
+
+@* Character strings.
+
+In this section I have tried to provide some tolerable string-handling
+facilities in despite of the restrictions of \PASCAL. This does not seem to
+belong in any particular place in the program, but in view of the horrible
+gruesome things that will happen in the next section, it seemed a good idea to
+give some light relief. That is why this section is inserted here.
+
+The |var_string| type is principally used for file names and to send command
+sequences to the printer. Logically, these procedures should all be functions
+and return the results, but stupid \PASCAL\ does not allow this. It would of
+course be much cleaner to use the VMS |varying| type, but that would make the
+program non-portable.
+
+@<Const...@>= max_string = 100 ; {a guess, of course}
+
+@ @<Types...@>=
+ s_ptr = 0..max_string ;
+ fix_string = packed array[ 1..max_string ] of char ;
+ var_string= packed record
+ len: byte;
+ data: fix_string ;
+ end ;
+
+@ |@!blank| is used for initialising strings. It should not be altered
+anywhere but here. |buffer| is used for terminal input, etc.
+
+@<Set |blank|@>=
+ blank.len := 0 ;
+ for in_i := 1 to max_string do
+ blank.data[in_i] := pad_char ;
+
+@ @<Glob...@>=
+ ch: byte ;
+ hack: fix_string ;
+ buffer, blank: var_string ;
+ thumb, finger: s_ptr ;
+
+@ This procedure converts an explicit quoted string into a |var_string|.
+
+@<Lowest...@>=
+ procedure set_string ;
+ var i, j: byte ;
+ begin
+ result := blank ;
+ set_j_to_length ;
+ if padded then begin
+ while (( j > first ) and ( ss[j] = pad_char)) do decr(j) ;
+ if ( j = first ) and ( ss[j] = pad_char) then decr(j) ;
+ end;
+ j := j - first + 1 ;
+ if ( j >max_string) then
+ warn( 'String too long')
+ else begin
+ result.len := j ;
+ for i := 1 to j do
+ result.data[i] := ss[ first + i - 1 ] ;
+ end;
+ end;
+ @.Error: String too long@>
+
+@ @<Forw...@>=
+ procedure substring( var result: var_string;
+ ss:var_string; start, length: integer); forward;
+ procedure append( var head: var_string; tail: var_string); forward;
+ procedure add_char(var s: var_string; c: char) ; forward;
+ function equals( s, t: var_string): boolean; forward ;
+ procedure splice (
+ var out: var_string; source: var_string; nn: integer); forward ;
+ procedure print_string( var f: text; ss: var_string; control: char); forward;
+ procedure int_string(
+ var result: var_string; n: integer; cc: char ) ; forward ;
+ procedure int_base(
+ var result: var_string; nn: integer; s: byte) ; forward ;
+ function s_search( s: var_string;
+ target: char; go: integer): s_ptr; forward;
+ procedure upcase( var ss: var_string); forward;
+ function s_to_i( default: integer; insist: boolean): integer; forward ;
+ procedure get_name( var val: var_string); forward;
+
+@ @<Low...@>=
+ procedure substring ;
+ var i : s_ptr ;
+ begin
+ result := blank ;
+ if ((start <= 0) or ( length < 0) or ( start + length > ss.len+1 )) then
+ warn( 'Impossible substring')
+ else begin
+ result.len := length ;
+ for i := 1 to length do
+ result.data[ i] := ss.data[ i - 1 + start] ;
+ end;
+ end;
+ @.Error: Impossible substring@>
+@#
+ procedure append ;
+ var k: integer;
+ begin
+ if (head.len + tail.len > max_string )
+ then warn('string too long')
+ else begin
+ for k := 1 to tail.len do
+ head.data[ k + head.len] := tail.data[ k] ;
+ head.len := head.len + tail.len ;
+ end;
+ end;
+ @.Error: string too long@>
+
+@#
+ procedure add_char ;
+ begin
+ if s.len >= max_string then warn('string too long')
+ else begin
+ incr(s.len) ;
+ s.data[s.len] := c ;
+ end;
+ end;
+ @.Error: String too long@>
+
+@#
+ function equals ;
+ begin if ( s.len <> t.len ) then equals := false
+ else equals := ( s.data = t.data) ;
+ end;
+
+@ Printer commands usually have the format (prefix)(parameter)(suffix). In
+order to generate these in a clean fashion, the next procedure |splice| puts
+the value into the marked position in the |source| string. The position is
+marked by the |@!amp_and| character, and the next character |cc| indicates what
+type of number is to be inserted. If there is no |amp_and|, the number is
+ignored.
+
+@<Lowest...@>=
+ procedure print_command(
+ pattern: var_string; val: integer; control: char) ;
+ var ss: var_string;
+ begin
+ splice( ss, pattern, val);
+ print_string( printfile, ss, control) ;
+ end;
+
+@ Also, printer commands usually contain unprintable characters. In my
+experience, these are always ASCII controls, i.e. in the range |0..31|. So
+|print_string| has a |control| escape character passed to it. Normally this is
+|@!ctrl_mark|, which is |'^'|. This replaces the next character by its control
+character, (i.e. reduced modulo 32) except: if |control| is a space, nothing is
+changed; and 2 consecutive |control|s get replaced by one.
+
+@<Lowest...@>=
+ procedure print_string ;
+ var i: s_ptr ; is_con: boolean ; cc: char ;
+ begin
+ is_con := false ;
+ for i := 1 to ss.len do
+ begin
+ cc := ss.data[ i] ;
+ if is_con then begin
+ if ( cc <> control) then
+ cc := zchr( zord( cc) mod 32) ;
+ is_con := false ;
+ write( f, cc) ;
+ end
+ else if (( cc = control) and ( control <> ' ' )) then
+ is_con := true
+ else write( f, cc) ;
+ end;
+ end;
+
+@ This procedure inserts a parameter.
+
+@<Lowest...@>=
+ procedure splice ;
+ var i: integer; cc: char ;
+ tail: var_string;
+ begin
+ i := s_search( source, amp_and, 1);
+ if ( i=0) then out := source
+ else begin
+ substring( out, source, 1, i-1);
+ substring( tail, source, i+2, source.len - i - 1 );
+ cc := source.data[ i+1] ;
+ int_string( out, nn, cc);
+ append( out, tail);
+ end;
+ end;
+
+@ |cc| (as above) is one character, and may have the values
+`B'(yte), `D'(ecimal), `H'(exadecimal), `O'(ctal), or `W' (a 16-bit signed
+word, in twos-complement notation).
+
+@<Lowest...@>=
+ procedure int_string ;
+ var nn: integer ;
+ begin if (cc = 'O') then int_base( result, n, 8)
+ else if (cc = 'H') then int_base( result, n, 16)
+ else if (cc = 'D') then int_base( result, n, 10 )
+ else if (cc = 'B') and (n >= 0) and (n <= 255)
+ then add_char( result, zchr(n))
+ else if (cc = 'B') then warn('Out-of-range byte')
+ else if (cc='W') then begin
+ if (n>= 0) and (n <= 32767) then begin
+ add_char( result, zchr(n div 256));
+ add_char( result, zchr(n mod 256));
+ end
+ else if (n<0 ) and (n> -32768) then begin
+ nn := n + 65536 ;
+ add_char( result, zchr(nn div 256));
+ add_char( result, zchr(nn mod 256));
+ end
+ else warn('Out-of-range word') ;
+ end
+ @<Hook for weird parameter types@>
+ else warn('Int_string called with illegal type') ;
+ end;
+ @.Error: Out-of-range...@> @.Error: Int_string called...@>
+
+@#
+ procedure int_base ;
+ var nh : integer ;
+ begin
+ nh := nn ;
+ if nh < 0 then begin add_char( result, '-'); nh := - nh ; end ;
+ if nh >= s then begin
+ int_base( result, nh div s, s) ;
+ nh := nh mod s ;
+ end ;
+ if nh >= 10 then add_char( result, zchr(nh - 10 + "A" ))
+ else add_char( result, zchr(nh + "0" )) ;
+ end;
+
+@ @<Hook for weird ...@>=
+
+@ The next macros and routines are for parsing strings. In these, the string
+being parsed is called |buffer|. |finger| points to the next character that
+is due to be read, and |ch| is the ordinal of this character. When an error
+is found, |thumb| should point to the first wrong character.
+
+@d get_char == begin incr( finger); ch := zord( buffer.data[finger]) ; end
+@d inside == ( finger <= buffer.len)
+@d digit == (( ch >= "0") and (ch <= "9" ))
+@d lo == (( ch >= "a") and (ch <= "z" ))
+@d cap == (( ch >= "A") and (ch <= "Z" ))
+@d equal_sign == ( ch = "=")
+@d is_prefix == ( ch = prefix )
+@d space == ( ch = " " )
+@d letter == lo or cap
+@d up(#) == # + "A" - "a"
+@d small(#) == # - "A" + "a"
+
+@d string_warn(#) == begin
+ warn(#);
+ string_show( buffer) ;
+ display_ln(' ');
+ display_ln('^' : thumb) ;
+ return;
+end
+
+@<Lowest...@>=
+ procedure upcase ;
+ var i: s_ptr; ch: byte;
+ begin
+ for i := 1 to ss.len do begin
+ ch:= zord( ss.data[i]) ;
+ if lo then
+ ss.data[i] := zchr( up( ch )) ;
+ end;
+ end;
+
+@ This function tries to read an integer from the |buffer|, starting at
+position |finger+1|. The integer may be signed and may be preceded by spaces.
+If there is no integer, return the |default|; error if |insist| is true.
+
+V3: A rather crude addition. In Unix the |prefix| is `{\tt -}', and the
+{\tt /i} key wants an optional integer arg. So the system will tend to confuse
+a prefix `{\tt -}' with a negative arg. So in suitable cases |s_to_i| will
+backspace.
+
+@d prev_char == if (finger > 1) then
+ begin decr( finger); ch := zord( buffer.data[finger]) ; end
+
+@<Low...@>=
+ function s_to_i ;
+ label exit ;
+ var value, sig : integer;
+ begin
+ value := default ;
+ sig := 1;
+ while (inside and space) do get_char;
+ if ( ch = "+" ) then get_char
+ else if ( ch = "-" ) then begin
+ sig := -1; get_char; end;
+ thumb := finger ;
+ if inside and digit then begin
+ value := 0 ;
+ while (inside and digit) do begin
+ value := value * 10 + ( zord( ch) - "0") ; get_char; end;
+ value := value * sig ;
+ end
+ else if insist then string_warn( 'Integer expected ')
+ else if ((sig = -1) and (prefix = "-")) then prev_char ;
+ exit: s_to_i := value;
+ end;
+ @.Error: Integer expected@>
+
+@ When parsing a command string, this procedure tries to read a filename
+starting from |finger|. Various things might go wrong: |finger| might be
+pointing at nothing; a qualifier; an integer argument; or a valid name
+mis-spelled. I dont see any plausible way to distinguish these; so I continue
+regardless.
+
+@<Low...@>=
+ procedure get_name ;
+ begin
+ while (inside and (space or equal_sign)) do get_char;
+ thumb := finger ;
+ while (inside and not (space or is_prefix)) do get_char;
+ substring( val, buffer, thumb, finger - thumb ) ;
+ end;
+
+@ This function searches for character |target| in a string, starting from
+position |go|. Return 0 if not found. If |go < 0| search backwards from |-go|.
+Error if |go = 0| or if |go| is out-of-bounds.
+
+@<Lowest...@>=
+ function s_search ;
+ label exit ;
+ var nn, gg: integer;
+ begin
+ gg := abs( go);
+ nn := 0 ;
+ if (gg > s.len ) or (go =0 ) then warn ( 'Impossible search')
+ else begin
+ if ( go > 0 ) then begin
+ for nn := gg to s.len do if ( s.data[ nn] = target) then return ; end
+ else begin
+ for nn := gg downto 1 do if ( s.data[ nn] = target) then return ; end ;
+ nn := 0 ;
+ end;
+ exit: s_search := nn ;
+ end;
+ @.Error: Impossible search@>
+
+@ This is the Standard part of the procedure that parses a command line. When
+a |key| requires a value, some people will probably be used to typing {\tt
+key = value} or perhaps {\tt key <space> value} so |parse_command| must allow
+these constructions.
+
+@<Med...@>=
+ procedure parse_command;
+ label exit ;
+ var key: byte;
+ begin
+ buffer := command ; finger := 0 ; get_char;
+ while inside do begin
+ while (inside and space) do get_char ;
+ if inside and ( ch = prefix) then begin
+ get_char ; thumb := finger ;
+ if lo then ch := up( ch) ; key := ch ; get_char ;
+ while (inside and ( space or equal_sign)) do get_char ;
+ @<If the |key| is valid, do the corresponding command@>
+ else string_warn( 'Unknown command ') ;
+ end
+ else if inside then begin
+ if ( dvi_name.len > 0) then begin
+ warn( 'Two filenames. Previous name will be ignored, it was:' ) ;
+ string_show( dvi_name) ;
+ display_ln(' ') ;
+ end;
+ get_name( dvi_name) ;
+ end;
+ exit: end;
+ end;
+ @.Error: Unknown command@>
+ @.Error: Two filenames...@>
+
+@* Translating the device-independent file, 5: Movements.
+
+This section considers the problem of deciding where each character has to be
+printed on the printer's page. This is by far and away the most difficult (and
+unsatisfactory) part of \.{Crudetype}. The current version is not a properly
+designed algorithm; it is merely a bodge, obtained by a lot of trial and
+error. It does seem to give tolerable results on \.{WEB} files, lineprinter,
+and VMS. The main variables are: |@!D_h| is `\TeX's cursor'. It gives the
+`exact' horizontal position (in \.{DVI} units) generated by \.{DVI} commands.
+This is always updated exactly as in \.{DVItype}. |@!IM_h| is the `page
+image's cursor'. It marks the position (in |h_steps|) where the next character
+will be set.
+
+The procedure |round_IM_h| is called immediately before we set a character or
+a rule. We have to take account of all the movements that occurred since the
+last previous character was set.
+
+@<Forw...@>= procedure round_IM_h( code: byte); forward ;
+
+@ @<Lowest...@>=
+ procedure round_IM_h ;
+ var
+ s_top, diff, n, m,
+ delta, new_IM_h, rounded_h : integer ;
+ begin
+ @<Find the new position |new_IM_h|@>
+ IM_h := new_IM_h ;
+ end;
+
+@ The obvious method is to multiply |D_h| by a factor |h_conv| and round to
+nearest integer. This gives extremely bad results, because the characters in
+\TeX\ fonts vary enormously in width, while many crude printers have
+|fixed_width| characters. If |h_conv| is too large, then you get spaces in the
+middle of words. If |h_conv| is too small, then successive characters in a
+word get printed on top of each other. With an intermediate value of |h_conv|,
+you get both effects at once; in other words, the characters in \TeX\ fonts
+vary so much in width that the `too large' and `too small' values of |h_conv|
+overlap. In this situation, a great deal of jiggery-pokery is needed to get a
+tolerable result (sometimes! I have not been able to make this code work in
+general.)
+ For a start, here is the algorithm used in \.{DVItype}. |D_h_right| and
+|IM_h_right| give the latest value of |D_h| and |IM_h| after the latest
+previous character or rule was set. If the horizontal motion is small, like a
+kern, |IM_h| changes by rounding the kern; but when the motion is large,
+|IM_h| changes by rounding the true position |D_h| so that accumulated
+rounding errors disappear. Also, we insist that the total amount of drift is
+bounded.
+
+@d h_step_round(#) == round(h_conv*( # ))
+@d max_drift == 2
+
+@<Find the new position |new_IM_h|@>=
+ rounded_h := h_step_round(D_h + D_l_margin) ;
+ delta := D_h - D_h_right ;
+ if (delta > thin_space) or (delta <= -4*thin_space) then
+ new_IM_h := rounded_h
+ else new_IM_h := IM_h_right + h_step_round(delta);
+ if not fixed_width then begin
+ if (new_IM_h > rounded_h + max_drift)
+ then new_IM_h := rounded_h + max_drift
+ else if (new_IM_h < rounded_h - max_drift)
+ then new_IM_h := rounded_h - max_drift ;
+ end else
+
+@ Calculating |IM_h| on a |fixed_width| printer is very hairy. If we are not
+careful, then the spaces between words will sometimes get rounded to 0. Since
+we round `large' movements by rounding |D_h|, the space may even get rounded to
+a negative value, if there was previously a lot of drift. So we must re-round
+|new_IM_h|. The next idea is that whenever \TeX\ moves right by an amount that
+seems large enough to be a space between words, we force |IM_h| to increase.
+
+@<Find the new position |new_IM_h|@>=
+ if (delta > thin_space) and (new_IM_h < IM_h_right + gap_width)
+ @<Except in some special cases@>
+ then new_IM_h := IM_h_right + gap_width
+ else if (delta > - 2*thin_space) then begin
+ if (new_IM_h < IM_h_right)
+ then new_IM_h := IM_h_right; end
+ else
+
+@ Here are two little fudges which improve the result. First, when \TeX\ puts
+out a thin space, it sometimes is a bit too small to be recognised as such. So
+we reduce the |font_space| when a font is defined.
+
+@<Read the font parameters...@>=
+ font_space[nf] := round(font_space[nf] * 0.99 ) ;
+
+@ The next fudge is needed to handle tables of contents. \TeX\ prints these by
+putting out long streams of dots with small spaces in between. If these spaces
+all get expanded to a whole character width, the right hand columns get thrown
+right off the paper. So dont expand if the next character is a stop or comma.
+
+@<Except in some special cases@>=
+ and not ( ( ( code = ".") or ( code = ",") ) and
+ ( ( cur_scheme > 0) and ( cur_scheme <= max_plain )))
+
+@ When these alternatives fail, we have lost contact between |D_h| and
+|D_h_right|. This happens when \TeX\ makes a large backspace; in fact \TeX\
+seems nearly always to do large backspaces by |pop| rather than an explicit
+move left. \TeX\ often expresses boxes by a sequence like this:
+
+\centerline{\tt{
+PUS\markarrow{H} Move right ------------>
+\markarrow{[}set characters] \markarrow{P}OP }}
+
+followed by zero or more |push|es, then by a move either to one of the
+positions marked by the arrows, or close by. I try to deal with this by
+dropping markers at each of the arrowed positions. The markers are labelled
+|D_h_right|, etc, and each marker has a corresponding value of |IM_h|
+attached.
+
+@<Glob...@>=
+ D_h_left, IM_h_left, D_h_mid, IM_h_mid, D_h_right, IM_h_right, {the markers}
+ IM_h, IM_v, D_dis, IM_dis, H_shunt: integer;
+ IM_h_stack, IM_v_stack:
+ array [0..max_stack+2] of integer; {pushed down values }
+
+@ Suppose that we are about to set a character, and |D_h-D_h_right| is large
+and negative. Then we compare the current value of |D_h| with all the markers.
+Let |m| be the closest of these, and |mm| the corresponding rounded value.
+Then we re-round |new_IM_h| to force it to lie on the `correct' side of |mm|.
+This seems to work fairly often, but it does sometimes slip. First put the
+markers on top of the stack...
+
+@<Find the new position |new_IM_h|@>=
+ begin s_top := stack_ht ;
+ D_h_stack[s_top] := D_h_left;
+ IM_h_stack[s_top] := IM_h_left;
+ incr(s_top) ;
+ D_h_stack[s_top] := D_h_mid;
+ IM_h_stack[s_top] := IM_h_mid;
+ incr(s_top) ;
+ D_h_stack[s_top] := D_h_right;
+ IM_h_stack[s_top] := IM_h_right;
+
+@ ...then look for the stacked value closest to |D_h|...
+
+@<Find the new position |new_IM_h|@>=
+ m := s_top ;
+ for n := s_top downto 1 do begin
+ diff := D_h - D_h_stack[n] ;
+ if abs(diff) <= abs(delta) then
+ begin m := n ; delta := diff; end ;
+ end;
+
+@ ...then adjust |new_IM_h| by reference to this point on the stack.
+
+@<Find the new position |new_IM_h|@>=
+ if (delta > thin_space ) and ( new_IM_h < IM_h_stack[m] + gap_width) then
+ new_IM_h := IM_h_stack[m] + gap_width
+ else if (delta < -thin_space )
+ and ( new_IM_h > IM_h_stack[m] - gap_width)
+ then new_IM_h := IM_h_stack[m] - gap_width
+ else if abs(delta) <= thin_space then new_IM_h := IM_h_stack[m];
+end;
+
+@ We must assign values to these markers. When we start a page, all the
+markers that were left over from the previous page are irrelevant. So we reset
+them. This is a good place to consider margins. The standard arrangement given
+in the \TeX book (Chapter 23) is that \.{DVI} point $(0,0)$ is about an inch
+in from the top and left edges of the paper. But a negative {\tt \BS hoffset}
+allows \.{DVI} to address points with negative coordinates, which should still
+be on the paper. It seems that the least messy way to implement this is by
+adding |l_margin| to |IM_h|, whenever this is set to an absolute value.
+
+Least messy, but wrong. It seems that first: we must alter not the scaled units
+but the \.{DVI} units before scaling. Also to overcome the confusion of a
+negative {\tt \BS hoffset} we must start each page by pushing a position
+corresponding to the edge of the paper. |@!l_margin| is the assumed margin in
+inches. |@!D_l_margin| is the equivalent in \.{DVI} units.
+@^\TeX book@>@^Margins@>
+
+@<Set up an empty page...@>=
+ D_h := - D_l_margin ; D_v := - D_top_margin ;
+ IM_h := 0 ; IM_v := 0 ;
+ D_h_left := - D_l_margin ; IM_h_left := 0 ;
+ D_h_mid := - D_l_margin; IM_h_mid := 0 ;
+ D_h_right := - D_l_margin ; IM_h_right := 0 ;
+ push ;
+ D_h := 0 ; D_v := 0 ;
+ H_shunt := 100000000 ; {any absurd value}
+
+@ Unfortunately the various fudge factors we have introduced expand this
+inch of margin to about 3 inches; this will probably push some printed
+characters off the right hand edge of the paper. So we must shift all
+printed chars left by an amount |@!H_shunt|, defined as $-3 +$ the least value
+of |IM_h| for any character set on the page.
+
+@<Add the record...@>=
+ if H_shunt > (Set_h - 3)
+ then H_shunt := (Set_h - 3) ;
+
+@ So now we consider the three arrows in turn. The left hand arrow will be
+marked by |@!D_h_left|. It records the latest horizontal position to be
+|push|ed. There might have been a |pop| since then, so it is not necessarily
+the value at the top of the stack. If we just record |IM_h| whenever we
+|push|, that would give a wrong value whenever there was a sequence
+|push..move_right..push|. So we must rectify the pushed value of |IM_h|.
+
+@<Some adjustments...@>=
+ IM_h_stack[stack_ht]:=IM_h;
+ IM_v_stack[stack_ht]:=IM_v;
+ if just_pushed and (stack_ht > 0) then begin
+ x := h_conv*(D_h_stack[stack_ht] - D_h_stack[stack_ht - 1] );
+ if abs(x) > 1.5 {a guess!} then
+ IM_h_stack[stack_ht] := IM_h_stack[stack_ht] + round(x) ;
+ end;
+ D_h_left := D_h ;
+ IM_h_left := IM_h_stack[stack_ht] ;
+
+@ The centre arrow will be marked by |@!D_h_mid|. This is defined as the value
+of |D_h| just before setting the first character after the latest |push|.
+
+@<Find the new position |new_IM_h|@>=
+ if just_pushed then begin
+ D_h_mid := D_h ;
+ IM_h_mid := new_IM_h;
+ just_pushed := false;
+ end;
+
+@ The right hand arrow is marked by |@!D_h_right|. At any time, this is
+defined as the right hand edge of the latest previous character (or rule) that
+has just been set. This equals |D_h + D_dis|, where |D_dis| is the \TeX\ width
+of the character. Usually there will follow a |move_right| that updates |D_h|,
+but |D_h_right| must be updated even if there is no |move_right|. Now
+|@!IM_h_right| must be aligned with the right hand edge of the printed
+representation of the character. The idea is that this will usually be the
+exact place where the next character has to be set. We hope that all the
+characters in each word will be correctly placed next to one another and the
+accumulated drift will appear in spaces between the words. So whenever a
+character is set, we must assign values to |D_dis| and |IM_dis|. The character
+is described by |cod|, and its printed width is written into its |breadth|
+field; but if it is a multiple character, then the |breadth| is the negative
+of the width.
+
+@<Do messy things...@>=
+ D_dis := D_width[D_font, c_num] ;
+ if cod.breadth = bad_char then IM_dis := 0
+ else IM_dis := abs(cod.breadth) ;
+ @<Set |rail_base|@>
+ D_h_right := D_h + D_dis ;
+ IM_h_right := IM_h + IM_dis ;
+
+@ So the procedure |row| must give the |breadth| field the right value when
+assembling a |multi| character. Recall that that character can be either an
+|o_list| or an |h_list| or a |v_list|, and |bra| tells us which it is. An
+|o_list| is assumed to have a width of one |char_width| and the width of a
+|v_list| is the width of its widest component. The width of a |h_list| gets
+accumulated in |delta_h| as the list is assembled.
+
+@<Copy |lig_buff|...@>=
+ if ( bra = o_bra) then print_width := char_width
+ else if ( bra = h_bra) then print_width := delta_h
+ else begin
+ print_width := char_width ;
+ for i := 1 to buf_num do
+ with lig_buff[2*i].symbol do
+ if (print_width < -breadth ) and (breadth > -30000 )
+ then print_width := -breadth ;
+ end;
+ value.breadth := - print_width ;
+
+@ @<Row locals...@>=
+ print_width: integer ;
+
+@ We must do the same thing when setting a rule.
+
+@<|Post| set...@>=
+ D_dis := D_rul_width ;
+ IM_dis := hn * post_width ;
+ D_h_right := D_h + D_dis ;
+ IM_h_right := IM_h + IM_dis ;
+
+@ @<|Rail| set...@>=
+ D_dis := D_rul_width ;
+ IM_dis := hn * rail_width ;
+ D_h_right := D_h + D_dis ;
+ IM_h_right := IM_h + IM_dis ;
+
+@ \.{DVItype} handles vertical motion in the same sort of way as horizontal.
+
+@d v_step_round(#) == round(v_conv*( # ))
+
+@<Medium...@>=
+ procedure move_down(ddd: integer);
+ var new_IM_v , delta : integer;
+ begin
+ D_v:=D_v+ddd;
+ delta := v_step_round(ddd) ;
+ @<Find a vertical position |new_IM_v|@>
+ end;
+
+@ @<Find a vert...@>=
+ if delta >= big_drop then begin
+ new_IM_v := v_step_round(D_v + D_top_margin) ;
+ if (new_IM_v < IM_v + big_drop) then
+ IM_v := IM_v + big_drop
+ else IM_v := new_IM_v ;
+ rail_base := IM_v * rail_types ;
+ end
+ else if (delta <= -big_drop) then begin
+ new_IM_v := v_step_round(D_v + D_top_margin) ;
+ if (new_IM_v > IM_v - big_drop) then
+ IM_v := IM_v - big_drop
+ else IM_v := new_IM_v ;
+ rail_base := IM_v * rail_types ;
+ end else
+
+@ The above calculation fails for small motions. Because \TeX\ expects
+subscripts to be about half the size of the main line, it drops them by only a
+small amount; with a crude printer, this small amount gets rounded to zero. If
+the move is smaller than |@!tiny_drop| \.{DVI} units, we ignore it. If not,
+then we force the new value of |IM_v| to be different from the old.
+
+@<Find a vert...@>=
+ begin
+ IM_v := IM_v + delta ;
+ rail_base := rail_base + v_step_round(ddd * rail_types) ;
+ if (ddd > tiny_drop) and ( delta = 0) then IM_v := IM_v + 1
+ else if (ddd < -tiny_drop) and ( delta = 0) then IM_v := IM_v - 1
+ else rail_base := IM_v * rail_types ;
+ end;
+
+@ The next bit is put in to help catch bugs. Sometimes the \.{DVI} file really
+does try to address an absurd position; for example, I contrived to make \TeX\
+generate a {\tt \BS hbox} that was 9000 points wide. More often, nonsense
+positions are created by bugs. If we do nothing about this, \.{Crudetype} will
+probably crash with an arithmetic error, which is unacceptable. So any
+character falling outside the limits |h_min..h_max| and |v_min..v_max| will
+generate an error report.
+
+@<Check the position@>=
+ if (Set_h < h_min)
+ then begin
+ warn('Out of bounds --left') ;
+ Set_h := 0 ;
+ {Chuck the character somewhere, hopefully out of the way}
+ end else if ( Set_h > h_max )
+ then begin
+ warn('Out of bounds --right') ;
+ Set_h := h_max ;
+ {Chuck the character somewhere, hopefully out of the way}
+ end ;
+ if (Set_v < v_min) or ( Set_v > v_max )
+ then begin
+ warn('Out of bounds -- vertical ') ;
+ Set_v := v_max ;
+ end;
+ @.Error: Out of bounds@>
+
+@ @<Set init...@>=
+ h_max := h_resolution * 100 ;
+ v_max := v_resolution * 100 ;
+ h_min := 0 ;
+ v_min := 0 ;
+
+@ Note that since the position fields of a |page_record| are subranges,
+|h_max| etc. must be of the same type.
+
+@<Glob...@>= h_max, v_max , h_min, v_min : i_word ;
+
+@* Sorting the page.
+
+Once we have assembled the complete page image, we must sort it. The method
+used here is a merge sort based on the country dance called Grand March.
+
+@<Sort the page@>=
+ @<The dancers form a long line up the middle of the hall and march
+ up towards the Presence@>
+ repeat
+ @<At the top they split, and alternate groups go to the left and right and
+ march down the sides@>
+ @<At the bottom of the hall, each group coming from the right hand side
+ merges with a group from the left side, and they go up again@>
+ until sorted;
+
+@ Since the data being sorted is of unpredictable size and sequentially
+processed, it logically ought to be a |file|. But this turned out to make the
+program spectacularly slow. So I use linked lists instead--- a sacrifice of
+logic to economy. But I continue to use file-like language.
+
+@d send_one_set_to( #)==
+ copy_from( mid ) ( # )
+
+@<At the top...@>=
+ L_reset( mid) ;
+ L_rewrite( left) ;
+ L_rewrite( right) ;
+ repeat
+ send_one_set_to( left) ;
+ if not L_eof( mid) then
+ send_one_set_to( right) ;
+ until L_eof( mid);
+
+@ Eventually everybody comes together in one enormous set and the dance is
+finished. The easiest way to detect this is to let it go round one more time.
+Then the left side of the hall will be full and the right hand side empty.
+
+ @<At the bottom...@>=
+ L_rewrite( mid) ;
+ L_reset( left) ;
+ L_reset( right) ;
+ sorted := L_eof( right) ;
+ if sorted then
+ cur_pge_ptr := son( next( left))
+ else repeat
+ if L_eof( right) then copy_from( left) ( mid)
+ else if L_eof( left) then copy_from( right) ( mid)
+ else @<Merge one group from each side@>
+ until L_eof( left) and L_eof( right) ;
+
+@ The natural way to assemble the page image is to throw everything into one
+huge list, then start sorting. But the code for merging two simple lists was
+horribly complicated. (The code given here merely merges two runs.) So the
+page image is a list of lists (another sacrifice of logic to economy). Each
+top-level entry has a |son|, which points to a sub-list. This is a sorted
+subset (a ``run'') of the data. One advantage of the list-of-lists structure
+is that we can take advantage of the fact that \TeX\ output is very ``runny''.
+I found that this made \.{Crudetype} run at least 3 times faster than before.
+
+@d Add_run == new_tail( mid_ptr) ; son( mid_ptr) := run_ptr ;
+
+@<Merge one group...@>=
+ begin
+ L_rewrite( run) ;
+ L_run_ptr := son( left_ptr) ;
+ R_run_ptr := son( right_ptr) ;
+ repeat
+ if @<The person on the left is more eligible@>
+ then copy_from( L_run) ( run)
+ else copy_from( R_run) ( run) ;
+ until L_eof( R_run) and L_eof( L_run) ;
+ step_wipe( left_ptr) ;
+ step_wipe( right_ptr) ;
+ L_reset( run) ;
+ Add_run ;
+ end;
+
+@ So while the page image is being assembled, it must be divided into runs.
+
+@<Add the record...@>=
+ begin
+ if out_of_sequence then begin {create a new run}
+ L_reset( run) ;
+ Add_run ;
+ L_rewrite( run) ;
+ end;
+ new_tail( run_ptr ) ;
+ 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;
+ incr(page_size) ;
+ if page_size >= page_max then abort(
+ 'Overflowed page: either a bug, or recompile with larger page_max' ) ;
+ end
+ @.Fatal: Overflowed page@>
+
+@ Once the lists are all assembled, we must |reset| them before sorting.
+
+@<The dancers...@>=
+ sorted := false;
+ L_reset( run) ;
+ Add_run ;
+
+@ Now we must specify the desired order!! That is: increasing |vpos| and
+|hpos|, |vpos| is more significant.
+
+@d out_of_sequence ==
+ ( ( Old_v > Set_v) or ( ( Old_v = Set_v) and ( Old_h > Set_h)))
+
+@<The person on the left is more eligible@>=
+ ( ( image( L_run_ptr).vpos < image( R_run_ptr).vpos) or
+ ( ( image( L_run_ptr).vpos = image( R_run_ptr).vpos)
+ and ( image( L_run_ptr).hpos <= image( R_run_ptr).hpos)))
+
+@ And here we get it all started. Since |garbage| wipes out everything in the
+|pool| array above |zzz|, the following code effectively makes |mid..run|
+permanent.
+
+@<Set init...@>=
+ first_cell ;
+ make_new( mid );
+ make_new( left );
+ make_new( right );
+ make_new( run );
+ make_new( zzz );
+ image(zzz).vpos := max_half;
+ next(zzz) := zzz ;
+ mid_ptr := zzz ;
+ run_ptr := zzz ;
+
+@ @<Set up an empty page...@>=
+ garbage ;
+ L_rewrite( mid) ;
+ L_rewrite( run) ;
+ page_size := 0 ;
+ Old_v := -max_half ;
+
+@ @<Glob...@>=
+ zzz, cell, tempp, cur_pge_ptr,
+ mid, mid_ptr, run, run_ptr,
+ left, left_ptr, L_run_ptr ,
+ right, right_ptr, R_run_ptr : link;
+ page_size: page_i ;
+ Old_v, Old_h : i_word ;
+ sorted: boolean ;
+ declare_pool
+
+@ Now we must define lots of machinery for handling lists. We could represent
+a list by either a big array or dynamic storage. Neither is ideal, because an
+array is bound to be either too big or too small; and some \PASCAL s
+apparently do not implement pointers. So I have expressed everything in terms
+of certain macros, defined in the system dependent part of the program. In
+theory, you can switch \.{Crudetype} from array to heap merely by redefining
+these as follows:
+\begintt
+ define image(#) == #^
+ define create == new(cell)
+ define first_cell == do_nothing
+ define link_type == ^page_record
+ define wipe_out(#) == dispose(#) ; { release data piecemeal}
+ define garbage == do_nothing
+ define declare_pool == do_nothing
+\endtt
+
+Both array and heap seem to work in VMS. I prefer to use an array because in
+VMS, there seems to be no shortage of store, and an array is easier to debug.
+Assuming these lowest-level macros, here is some machinery for handling lists.
+We must deallocate cells after use. When using arrays, the |garbage| command
+does it all in one go. Pointers must be |dispose|d one at a time, and the
+obvious time is just after the data was used.
+
+@d next(#) == image(#).prox
+@d advance(#) == # := next(#)
+@d make_new( #) == create; # := cell ;
+@d new_tail( #) ==
+ create; next( #) := cell; # := cell ;
+@d step_wipe( #) ==
+ tempp := # ; advance( #) ; wipe_out( tempp)
+
+@ Suppose |L| is a list; then the actual variable |L| points to a permanently-
+allocated cell which in turn points to the head of the list. |L_ptr| points to
+the active end. After the list has been assembled, we first mark the tail, by
+attaching a special element called |zzz|. Then we move the |L_ptr| round to
+the head. |copy_from| must be used in the combination
+{\tt copy\_from(A)(B)}. It copies one element from the head of |A| to the
+tail of |B|.
+
+@d L_rewrite( #) ==
+ #@&ptr := # ; next( #) := zzz
+@d L_reset( #) ==
+ next ( # @& ptr) := zzz ; #@&ptr := next( #)
+@d L_eof( #) ==
+ ( # @& ptr = zzz)
+@d copy_end( #) ==
+ next( #@&ptr) := tempp ; advance( #@&ptr) ; end
+@d copy_from( #)==
+begin
+ tempp := #@&ptr ;
+ advance( #@&ptr ) ;
+ copy_end
+
+@ Each top-level entry has the |false| type below; the |prox| field points to
+the next top-level entry and the |down| field to a sub-list.
+
+@d son(#) == image(#).down
+
+@<Types...@>=
+ page_i = 0..page_max ;
+ link = link_type ;
+ page_record = packed record
+ prox: link ;
+ case boolean of
+ true: ( hpos : i_word;
+ vpos: i_word;
+ symbol: code_object ) ;
+ false: ( down : link) ;
+ end;
+
+@* Processing a page of output.
+
+The output of \.{Crudetype} is done by the procedure |Send_page|, which takes
+the page and translates it for the printer. We shall process it a `line' at a
+time, meaning all |page_records| with the same |vpos|. Initially |PR_font|
+gets an impossible value so as to force an explicit |set_PR_font|.
+
+@<Top level...@>=
+ procedure Send_page;
+ var line: link ;
+ begin
+ PR_font := sentry;
+ PR_h := 0;
+ PR_v := 0;
+ while (not L_eof( cur_pge))
+ do begin
+ line := read_line ;
+ do_line( line, 0);
+ end ;
+ end;
+
+@ The function |read_line| runs along the page image until the vertical
+position changes. It returns a pointer to a sublist which is the next line on
+the page. As side effects, it advances |cur_pge_ptr| to the first record of
+the next line, and updates |PR_v_next|.
+
+@<Medium...@>=
+ function read_line : link ;
+ var head, tail: link ; size: integer;
+ begin
+ head := cur_pge_ptr ;
+ size := 0 ;
+ PR_v_next := image(cur_pge_ptr).vpos ;
+ repeat
+ tail := cur_pge_ptr ;
+ advance(cur_pge_ptr) ;
+ incr(size) ;
+ if size = max_line_size then
+ warn('Excessively long line ') ;
+ @.Error: Excessively long line@>
+ until ( ( L_eof( cur_pge) )
+ or (PR_v_next <> image(cur_pge_ptr).vpos ) ) ;
+ next(tail) := zzz ;
+ read_line := head ;
+ end;
+
+@ These bounds are put in to catch runaway arguments.
+
+@<Const...@>=
+ page_max = 30000 ;
+ max_line_size = 1000;
+ left_stop = 0 ;
+ deepest = 10 ;
+
+@ These variables all denote the printer fonts, etc.
+
+@<Glob...@>=
+ PR_v, PR_v_next,
+ PR_h, PR_h_next,
+ PR_font : i_word ;
+
+@ This procedure tries to print a line. The main difficulties are: we dont
+want to |Backfeed| unless absolutely necessary; and we may have to deal with
+overstruck characters. One possible way is to shunt them aside somewhere, then
+print the |overflow| after the main line has been printed.
+
+@<Medium...@>=
+ procedure do_line (line_ptr: link; depth: integer);
+ var overflow : link;
+ begin
+ @<Move printer vertically to |PR_v_next|, update |PR_v|@>;
+ overflow := zzz ;
+ while (line_ptr<>zzz) do
+ @<Process the character that |line_ptr| points to, and |advance| to
+ the next@>;
+ if ( overflow = zzz) then
+ begin @<End the line, trying very hard not to over-feed the paper@> end
+ else begin @<Print the |overflow|@> end;
+ @<Reset printer at end of line, if necessary@>
+ end;
+
+@ We are actually getting almost in sight of the printer!!! Before we can
+actually print a character, we must first check if it has to go to the
+|overflow|...
+
+@<Process the char...@>=
+ 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@>
+
+@ If the |overflow| is non-empty, we print it by calling |do_line| recursively
+on it. But sometimes |do_line| tries to recurse to infinite depth (this is a
+bug), so we perform a check first.
+
+@<Print the |overflow|@>=
+ @<Return@> ;
+ if (depth < deepest) then begin
+ next(overflow) := zzz ;
+ overflow := next(zzz) ;
+ do_line( overflow, depth + 1);
+ end else warn( 'I am out of my depth') ;
+ @.Error: I am out of my depth@>
+
+@* Downloading. Not started yet.
+
+@<Download a whole font@>= do_nothing
+
+@ @<Enter a download...@>=
+
+@* Carriage control.
+
+Once the superior software has decided where the printer has to move to next,
+this section has the job of translating the desired position into elementary
+printer commands. Clearly this mapping depends very much on the range of
+functions that the printer can perform. So this section is controlled by
+several booleans; each asserts that the printer can do the
+corresponding action. Here is a list of the most important ones:\item
+|@!cr_feed_dist| is the distance in |v_steps| by which a carriage-return
+feeds the paper.\item
+|@!wl_feed_dist| ditto, |write_ln|. Similarly for the other |dist|
+values.\item
+|@!feed_absolute| says the printer has an absolute position command that takes
+a parameter |IM_y|, say, and moves to position |IM_y v_steps| down the
+page.\item
+|@!b_feed_absolute| ditto, backfeeding.\item
+|@!b_feed_by_string| says the printer has a |Backfeed| character that moves it
+back by a fixed number |b_feed_dist| of |v_steps|. These booleans should not
+be set true unless the printer can backfeed reliably.\item
+|@!space_absolute| etc., Ditto, horizontal moves.\item
+|@!abs_is_incr| says that in the absolute position commands, the parameter is
+actually an incremental move.\item
+|@!wl_does_cr| says that |write_ln| forces a carriage return.
+
+In Version 3, I have changed all these constants into variables. I
+hope this will make it easier to support devices that closely resemble
+lineprinters without a lot of messy recompilation. As mentioned
+above, it is essential to avoid premature line feeds as much as
+possible. Also, many operating systems will choke if the output record
+gets too long, so we must do a |print_ln| at intervals. This program
+tries to accommodate various types of carriage control, some of which
+are not in use at our site. This means that several pieces of
+code have not been tested. Installers must expect to find that the procedures
+defined here will need to be carefully studied in conjunction with the
+I/O section of their \PASCAL\ manual.
+
+Now consider what happens at the end of each line. We will want to do a
+subset of the following things: carriage-return, print the |overflow|, line
+feed, split output records. We must keep a clear separation between these
+tasks, and we want to do them in the stated order (but not if |fortran|). This
+order puts most of the carriage controls to the ends of the output records,
+and (on our machine) makes it easier to examine the output file with an editor.
+So first: do we want to do carriage-return? If so, then the natural way is to
+print a carriage-return, but not if it will over-feed the paper.
+
+@<End the line...@>=
+ if( (not wl_does_cr) {Return is compulsory}
+ or feed_absolute
+ or ((not want_split) {We can choose C-R or W-L}
+ and (b_space_absolute
+ or ( cr_feed_dist < wl_feed_dist)) {and C-R is preferable}))
+ then begin @<Return@> end;
+
+@ @<Reset printer...@>= {hook}
+
+@ Now we decide whether to do any |line_feed|s. But first, we may have to
+attempt to |Backfeed|. Sometimes the program will fail; it should not do so
+unless the \.{DVI} file calls for overstruck characters and the printer
+genuinely cannot do them. If |b_feed_scream|, then print an error message.
+
+@<Move printer...@>=
+ if (PR_v_next < PR_v) then begin
+ if b_feed_absolute then set_v_abs(PR_v_next)
+ else if b_feed_by_string then
+ while (PR_v_next < PR_v) do @<Backfeed@>
+ else if b_feed_scream then begin
+ warn('Printer cant feed backwards');
+ @.Error: Printer cant...@>
+ display_ln('approximate vertical position is: ', PR_v_next);
+ display_ln(' printing over-fed line on line below');
+ display_ln(' ');
+ PR_v := PR_v_next;
+ end;
+ end;
+
+@ If we avoided over-feeding, we may want to feed forwards.
+
+@<Move printer...@>=
+ if list or fortran or (wl_feed_dist > 0 ) then
+ while (PR_v + wl_feed_dist <= PR_v_next) do
+ begin print_ln;
+ @<Check pause@>
+ if fortran then print( feed_char) ;
+ if wl_does_cr then PR_h := 0 ;
+ PR_v := PR_v + wl_feed_dist ;
+ if squash then PR_v := PR_v_next ;
+ end
+ else if feed_absolute then set_v_abs(PR_v_next)
+ else begin
+ while (PR_v_next >= PR_v + feed_dist) do @<Line feed@>;
+ print_ln ;
+ if wl_does_cr then PR_h := 0 ;
+ end;
+ while (PR_v_next > PR_v) do @<Tiny feed@> ;
+
+@ We set the horizontal position in a similar way, but we do not need to be so
+paranoid about backspacing as about back-feeding.
+
+@<Set horiz...@>=
+ if PR_h_next = PR_h then
+ else begin
+ if (PR_h_next < PR_h) then begin
+ if b_space_absolute then set_h_abs(PR_h_next)
+ else if b_space_by_string then
+ while (PR_h_next < PR_h) do @<Backspace@>;
+ end;
+ if space_absolute and (PR_h_next > PR_h )
+ then set_h_abs(PR_h_next)
+ else begin
+ while (PR_h_next >= PR_h + space_dist) do @<Space@>;
+ while (PR_h_next > PR_h) do @<Tiny space@> ;
+ end;
+ end;
+
+@* Low level modules for printer control.
+
+Now we have to translate these elementary printer commands into actual strings
+of characters to be put into |printfile|. Here is the command for setting a
+new printer's font.
+
+@<Lowest...@>=
+ procedure set_PR_font(new_font:integer) ;
+ begin
+ if (new_font = PR_font) or only_one_font then
+ else
+ begin
+ print_command( font_command, new_font, ctrl_flag) ;
+ PR_font := new_font ;
+ end;
+ end;
+
+@ Now for |absolute| movements, if the printer can do them. The procedure
+|set_v_abs| moves the printer to position |mm h_steps| below the top of the
+paper. If |abs_is_incr| then the printers `absolute' command is actually an
+incremental command. So the parameter sent to the printer must be decreased by
+|PR_v|.
+
+@<Forward...@>=
+ procedure set_v_abs(mm: integer) ; forward ;
+ procedure set_h_abs(mm: integer) ; forward ;
+
+@ @<Lowest...@>=
+ procedure set_v_abs;
+ var new_pos :integer ;
+ begin
+ if abs_is_incr then
+ new_pos := mm - PR_v
+ else new_pos := mm ;
+ print_command( v_abs_com, new_pos, ctrl_flag) ;
+ PR_v := mm ;
+ end;
+
+@#
+ procedure set_h_abs;
+ var new_pos :integer ;
+ begin
+ if abs_is_incr then
+ new_pos := mm - PR_h
+ else new_pos := mm ;
+ print_command( h_abs_com, new_pos, ctrl_flag) ;
+ PR_h := mm ;
+ end;
+
+@ Now consider commands for printers that can only do simple movements. A
+|tiny| movement is usually a movement of one |h_step| or |v_step|. All these
+modules should be protected, so they cannot be called unless the printer can
+actually do the stated movement. Normally, the command strings for these are
+only simple characters, so we can just |print| them.
+
+If |run_on| is false, we want a formfeed between two pages. |@!page_gap| will
+be true after the end of the first printed page.
+
+@<Maybe a formfeed@>=
+ if run_on then begin
+ write_ln(printfile);
+ write(printfile,'------ PAGE ', counter[0]:1,' ');
+ write(printfile,'----------------------------------');
+ write(printfile,'----------------------------------');
+ write_ln(printfile);
+ end
+ else if page_gap then
+ page(printfile)
+ else page_gap := true ;
+ if is_header then
+ string_print (page_top);
+
+@ @<Backfeed@>=
+ begin string_print(b_feed_string);
+ PR_v:=PR_v - b_feed_dist;
+ end
+
+@ @<Line feed@>=
+ begin
+ print(feed_char);
+ if squash then PR_v := PR_v_next
+ else PR_v:=PR_v+feed_dist;
+ end;
+
+@ @<Tiny feed@>=
+ begin print(t_feed_char); PR_v:=PR_v+t_feed_dist; end;
+
+@ @<Return@>=
+ if fortran then begin
+ print_ln ; print( cr_char) ; PR_h := 0;
+ PR_v := PR_v + cr_feed_dist ; end
+ else if (b_space_absolute and
+ ((cr_feed_dist > 0) or (l_margin > 0)) )
+ then set_h_abs(0)
+ else begin
+ print(cr_char);
+ PR_h := 0;
+ PR_v := PR_v + cr_feed_dist ;
+ end ;
+
+@ @<Backspace@>=
+ begin print (b_space_char); PR_h:=PR_h - b_space_dist; end;
+
+@ @<Space@>=
+ begin print (space_char); PR_h:=PR_h+space_dist; end;
+
+@ @<Tiny space@>=
+ begin print (t_space_char); PR_h:=PR_h+t_space_dist; end;
+
+@* Default declarations for printer.
+
+This section defines masses of data to describe how the printer behaves.
+Previously this was all in the lineprinter change file. However most Change
+files are for lineprinters, so I moved this stuff into the main program. In V3 I
+changed most of these constants into variables. The assumed characteristics of
+a lineprinter are as follows:
+
+1. A lineprinter can print all the printable ASCII characters, and no others.
+
+2. Each character is one |step| high and one |step| wide.
+
+3. Printer will act correctly if it receives the following ASCII controls:
+line feed, carriage return, space, and form feed. More precisely, the Standard
+specifies that the \PASCAL\ procedure |page| does something that advances
+the printer by one page.
+
+4. Backspacing and backfeeding are assumed impossible ; also we do not use
+tabs.
+
+The first lot of data describes the printer's overall style of carriage control.
+|fortran| means that the carriage control character gets put at the start of the
+line, and it is here assumed that it must be inserted explicitly. |feed| means
+a vertical movement and |space| horizontal. Each |thing_char| is the character
+needed to make the printer do the named action. Owing to the rules of
+\.{TANGLE}, the words |back| and |tiny| have to be abbreviated (to avoid
+identifier clashes).
+@.ASCII@>
+
+@<Glob...@>=
+ @!device_ID : packed array[1..12] of char ; {Name of device}
+@#
+ list, fortran, b_feed_absolute, b_feed_by_string, feed_absolute,
+ b_feed_scream, b_space_absolute, b_space_by_string, space_absolute,
+ abs_is_incr, wl_does_cr, want_split, is_header, do_pause, inspection: boolean ;
+ {These say whether the printer can do the named action}
+@#
+ wl_feed_dist, cr_feed_dist, feed_dist, t_feed_dist, b_feed_dist,
+ tiny_drop, big_drop, space_dist, t_space_dist, b_space_dist,
+ pause_i, pause_steps: integer ;
+ {Distances that various actions move}
+@#
+ feed_char, t_feed_char, cr_char, space_char, t_space_char,
+ b_space_char : char ;
+ start_stuff, stop_stuff, page_top, b_feed_string, font_command,
+ v_abs_com, h_abs_com, pause_after: var_string ;
+ {Command chars and strings}
+
+@ So here are their default values. We believe they are all appropriate for
+lineprinters on VMS machines. Note that the program makes no attempt to check
+these values for consistency.
+
+@<Set init...@>=
+ device_ID := 'Lineprinter '; {Pad to 12 chars}
+ list := false ;
+ fortran := false ;
+ b_feed_absolute := false ;
+ b_feed_by_string := false ;
+ feed_absolute := false ;
+ b_feed_scream := true ;
+ b_space_absolute := false ;
+ b_space_by_string := false ;
+ space_absolute := false ;
+ abs_is_incr := false ;
+ wl_does_cr := false ;
+ want_split := true ;
+ is_header := false ; {each page needs a header}
+ do_pause := false ;
+ inspection := false ;
+@#
+ wl_feed_dist := 0 ;
+ cr_feed_dist := 0 ;
+ feed_dist := 1 ;
+ t_feed_dist := 1;
+ b_feed_dist := 0;
+ tiny_drop := 50000 ; {slightly less than a point}
+ big_drop := 4 ;
+ space_dist := 1;
+ t_space_dist := 1;
+ b_space_dist := 1;
+ pause_i:=0 ;
+ pause_steps := 20 ;
+@#
+ feed_char := chr(10) ;
+ t_feed_char := chr(10);
+ cr_char := chr(13);
+ space_char := chr(32) ;
+ t_space_char := chr(32) ;
+ b_space_char := chr(8);
+@#
+ start_stuff := blank ;
+ stop_stuff := blank ;
+ page_top := blank ;
+ b_feed_string := blank ;
+ font_command:= blank ;
+ v_abs_com:= blank ;
+ h_abs_com:= blank ;
+ pause_after := blank ;
+
+@ The general run of \TeX\ characters are narrower than line-printer chars. So
+we spread them out to make them fit.
+
+@<Set init...@>=
+ l_margin := 1.0 ; {Normal left margin, in inches}
+ top_margin := 1.0 ; {Top ditto}
+ h_fudge := 7.227 {number of points per |h_step|}
+ / 5.25 ; {A typical design width}
+ v_fudge := 2.0 ;
+ { Force double-spacing, in hope that suffixes will come out right}
+
+@ @<Glob...@>=
+ h_fudge, v_fudge, l_margin, top_margin: real_number ;
+
+@ Of course, these will have to be changed if |fortran|, or on a system
+that does not use ASCII codes.
+ @.ASCII@>
+
+@<Set up for...@>=
+ if inspection then begin
+ batch_view := true ;
+ quiet := true ;
+ do_pause := (pause_steps > 0) ;
+ end;
+ if batch_view then begin
+ device_ID := 'screenview '; {Pad to 12 chars}
+ run_on := true ;
+ fortran := false ;
+ list := true ;
+ end;
+ if fortran then begin
+ wl_does_cr := true ;
+ wl_feed_dist := 1;
+ feed_char := ' ' ;
+ t_feed_char := ' ' ;
+ cr_char := '+' ;
+ end;
+ if list then begin
+ wl_feed_dist := 1;
+ cr_feed_dist := 1 ;
+ cr_char := ' ' ;
+ wl_does_cr := true ;
+ l_margin := 0 ;
+ top_margin := 0 ;
+ end ;
+
+@ |start_stuff| and |stop_stuff| get written into the start and end of
+|printfile|. They are intended to: set printer into correct state for \TeX\
+output, and reset printer to standard state afterwards. If the printer needs
+to be re-initialised in any way at the top of each page, then set |@!page_top|
+to the necessary data and set |is_header| to |true|.
+
+@<Open |printfile|@>=
+ string_print(start_stuff) ;
+ print_ln ;
+
+@ @<Clean up afterwards@>=
+ string_print(stop_stuff);
+ print_ln ;
+ if not quiet then begin
+ display ('Output written to file: ');
+ string_show(print_name);
+ end;
+ display_ln(' ') ;
+ @.Output written...@>
+
+@ This batch is concerned with distances and resolutions.
+
+@<Const...@>=
+ h_resolution = 10 ; {|h_steps| per inch}
+ v_resolution = 6 ; {|v_steps| per inch}
+ fixed_width = true ; {printers characters are fixed width}
+ char_width = 1 ;
+ {all printer characters are this width, in units of |h_step|. Normally,
+ |space_dist| will be equal to this, but some printers are not normal!}
+ gap_width = 1 ; {Intended minimum space between words}
+ char_ht = 1 ;
+
+@ Next, some constants for rule-setting.
+
+@<Rule setting const...@>=
+ rail_width = 1 ; {Height and width of rule chars, in steps}
+ rail_height = 1 ;
+ post_width = 1 ;
+ post_height = 1 ;
+ rail_types = 2 ;
+
+@ @<Set rule characters@>=
+ rail_chars[1] := codes[ 1, 95 ] ;
+ rail_chars[2] := codes[ 1, 45 ] ;
+ post_char := codes[ 1, 124] ;
+
+
+@ The next batch are concerned with fonts.
+
+@<Const...@>=
+ min_font = 1 ;
+ {smallest and largest number of printers resident fonts}
+ max_font = 1 ;
+ only_one_font = true ;
+ can_dl_font = false ;
+ min_dl_font = 0 ;
+ max_dl_font = 0 ; {printers down-loadable fonts}
+ max_codes = 60 ; {no. of known \TeX\ coding schemes}
+ max_plain = 4 ; {Max number of a plain text font}
+
+@ Here is a first attempt at a screenview version based on code by J. Warbrick,
+A. Trevorrow and others. In principle this shows how to switch \.{Crudetype}
+between different devices by flags in the command line.
+
+@<If the |key| is valid, do the corresponding command@>=
+ else if ( key = "B") then @!batch_view := true
+ else if ( key = "I") then begin
+ @!inspection := true ;
+ pause_i := s_to_i( pause_steps, false) ;
+ if ((pause_i < 0) or (pause_i > 200) ) then
+ string_warn ('Illegal value for I flag')
+ else pause_steps := pause_i ;
+ pause_i:=0 ;
+ end
+ @.Error: Illegal value@>
+
+@* Character code data for the printer.
+
+Here we actually put data into the |codes| array. In general, I have merely
+replaced each character in the PLAIN.TEX coding schemes by the nearest
+equivalent in ASCII, when a reasonable one exists. For each scheme in turn,
+first give the scheme names, then the character codes. Scheme 1 is EXTENDED
+ASCII.
+
+@<Define Lineprinter codes@>=
+ be_string('TEX EXTENDED ASCII' ); set_scheme(1) ;
+ alphabet( 32, 95, 1, 1, 32) ;
+ be_string( ' . {|v} Z Z & ~ {LC-} Z ') ;
+ row( 1,0,1) ;
+ be_string( ' Z Z Z {^|} {+_} {LO+} Z Z ') ;
+ row( 1,1,1) ;
+ be_string( ' Z Z Z Z Z Z {LOx} Z ') ;
+ row( 1,2,1) ;
+ be_string( ' [{L<-}-] [-{-L>}] {=/} Z {L<_} {L>_} {=_} [or] ') ;
+ row( 1,3,1) ;
+
+@ Now do scheme 2 = TYPEWRITER. Unfortunately, \.{TANGLE} imposes a limit of 69
+on the length of quoted strings. This causes difficulty because several multi-
+character commands are too long for 8 of them to fit neatly into a string of
+that length. So I use the Z command to ( effectively) split any complicated
+|row_spec| into two.
+
+@<Define Lineprinter codes@>=
+ be_string('TEX TYPEWRITER TEXT' ); set_scheme(2) ;
+ alphabet( 32, 95, 2, 1, 32) ;
+ codes[2, 127].IM_char:= 34 ;
+ be_string( ' Z [{/_}{_\}] {0-} [/\] Z Z Z Z ') ;
+ row( 2,0,1) ;
+ {first half row}
+ be_string( ' Z Z Z Z <U_{-_}> <U[__][||]> <U_{L>_}> LY ') ;
+ row( 2,0,1) ;
+ {and second}
+ be_string( ' {oI} {u|} Z {^|} {v|} Q ! ? ') ;
+ row( 2,1,1) ;
+ be_string( ' i j ` Q Z Z <U_> <U.> ') ;
+ row( 2,2,1) ;
+ be_string( ' , {LB_} [ae] [oe] {o/} [LALE] [LOLE] {LO/} ') ;
+ row( 2,3,1) ;
+
+@ The TEX TEXT scheme is nearly the same, so we start by copying it.
+
+@<Define Lineprinter codes@>=
+ be_string('TEX TEXT' ); set_scheme(3) ;
+ for in_i := 0 to 127 do codes [3, in_i] := codes [2, in_i] ;
+ be_string( ' Z Z Z [ff] [fi] [fl] [ffi] [ffl] ') ;
+ row( 3,1,1) ;
+ be_string( ' Z Z Z Z ! Z ? Z ') ;
+ row( 3,7,1) ;
+ be_string( ' Z Z Z Z W Z Z <U.> ') ;
+ row( 3,11,1) ;
+ be_string( ' Z Z Z - [--] W ~ W ') ;
+ row( 3,15,1) ;
+
+@ Recently there has appeared a scheme, called TEX TEXT WITHOUT F-LIGATURES.
+
+@<Define Lineprinter codes@>=
+ be_string('TEX TEXT WITHOUT F-LIGATURES' ); set_scheme(4) ;
+ for in_i := 0 to 127 do codes [4, in_i] := codes [3, in_i] ;
+ be_string( ' {oI} {u|} Z {^|} {v|} Q ! ? ') ;
+ row( 4,1,1) ;
+
+@ and AEFMNOT ONLY (for the Metafont logo).
+
+@<Define Lineprinter codes@>=
+ be_string('AEFMNOT ONLY' ); set_scheme(5) ;
+ be_string( ' Z LA Z Z Z LE LF Z ') ;
+ row( 5,8,1) ;
+ be_string( ' Z Z Z Z Z LM LN LO ') ;
+ row( 5,9,1) ;
+ be_string( ' Z Z Z Z LT Z Z Z ') ;
+ row( 5,10,1) ;
+
+@ The MATH ITALIC scheme is almost impossible.
+
+@<Define Lineprinter codes@>=
+ be_string('TEX MATH ITALIC' ); set_scheme(6) ;
+ for in_i := 0 to 9 do codes [6, in_i] := codes [2, in_i] ;
+ alphabet( 48, 43, 6, 1, 48) ;
+ alphabet( 97, 26, 6, 1, 97) ;
+ be_string( ' Z Z . , Z / Z * ') ;
+ row( 6,7,1) ;
+
+@ MATH SYMBOLS are messy, and no doubt the results will look unpleasant.
+
+@<Define Lineprinter codes@>=
+ be_string('TEX MATH SYMBOLS' ); set_scheme(7) ;
+ alphabet( 65, 26, 7, 1, 65) ;
+ be_string( ' - . {\/} * {-:} Z {+_} <U_+> ') ;
+ row( 7,0,1) ;
+ be_string( ' {LO+} {LO-} {LOx} {LO/} LO LO o o ') ;
+ row( 7,1,1) ;
+ be_string( ' Z {=_} Z Z {L<_} {L>_} {L<_} {L>_} ') ;
+ row( 7,2,1) ;
+ be_string( ' ~ <U~~> Z Z [L<L<] [L>L>] L< L> ') ;
+ row( 7,3,1) ;
+ be_string( ' [{L<-}-] [-{L>-}] {|^} {|v} Z Z Z Z ') ;
+ row( 7,4,1) ;
+ be_string( ' Z Z Z Z [{L<-}{-L>}] / \ {~_} ') ;
+ row( 7,4,1) ;
+ be_string( ' [{L<=}=] [={L>=}] {|^} {|v} Z Z Z Z ') ;
+ row( 7,5,1) ;
+ be_string( ' Z Z Z Z [{L<=}{=L>}] Z Z Z ') ;
+ row( 7,5,1) ;
+ be_string( ' Q [oo] {L(-} {-L)} Z Z Z Z ') ;
+ row( 7,6,1) ;
+ be_string( ' Z Z Z Z [{/_}{_\}] <U[__][\/]> / Q ') ;
+ row( 7,6,1) ;
+ be_string( ' [{\-}{-/}] <U_[{-_}|]> ~ {0/} LR LT <U_|> {|_}') ;
+ row( 7,7,1) ;
+ be_string( ' Z Z Z LU Z {LU+} & [or] ') ;
+ row( 7,11,1) ;
+ be_string( ' [{|-}-] [-{-|}] Z Z Z Z L{ L} ') ;
+ row( 7,12,1) ;
+ be_string( ' L< L> | [||] {^|v} {^|v} \ Z ') ;
+ row( 7,13,1) ;
+ be_string( ' <[S_]{v/}> [{LI_}{LI_}] <U[__][\/]> <U/|/> Z Z Z Z ') ;
+ row( 7,14,1) ;
+ be_string( ' {LS*} {|-} {|-_} {9|} Z Z Z Z ') ;
+ row( 7,15,1) ;
+
+@ And here is a first attempt at the MATH EXTENSION scheme. These codes look
+rather peculiar because characters in the Extension font (unlike all others)
+have their reference points at the top. Here the restriction of string length
+to 69 is a real pain. It seemed that the least bad way to arrange these |row|s
+was by splitting each into 2 halves; then most half-rows do fit into one
+|row_string|. Here are the left hand halves.
+
+@<Define Lineprinter codes@>=
+ be_string('TEX MATH EXTENSION' ); set_scheme(8) ;
+ be_string(' <SL(L(> <SL)L)> <SL[L[> <SL]L]> ZZZZ') ;
+ row( 8,0,1);
+ be_string(' <SL{L{> <SL}L}> <S/\> <S\/> ZZZZ') ;
+ row( 8,1,1);
+ be_string(' <SL(L(L(> <SL)L)L)> <SL(L(L(L(> <SL)L)L)L)> ZZZZ') ;
+ row( 8,2,1);
+ be_string(' <SL[|||> <SL]|||> <SL{/\L{> <SL}\/L}> ZZZZ') ;
+ row( 8,3,1);
+ be_string(' <SL(L(L(L(L(> <SL)L)L)L)L)> <SL[|||L[> <SL]|||L]> ZZZZ') ;
+ row( 8,4,1);
+ be_string(' <SL{L|L<|L{> <SL}|L>|L}> <S[S/]/\[S\]> <S\[S\][S/]/> ZZZZ') ;
+ row( 8,5,1);
+ be_string(' <S/||> <S\||> <SL[||> <SL]||> ZZZZ') ;
+ row( 8,6,1);
+ be_string(' <S[S/]|> <S\[S|]> <S|[S\]> <S[S|]/> ZZZZ') ;
+ row( 8,7,1);
+ be_string(' <S||\> <S||/> <S|> <S|> ZZZZ') ;
+ row( 8,8,1);
+ be_string(' <[__]\[{/_}_]> <[__][LILI]> </|/> <S[||][\/]> ZZZZ') ;
+ row( 8,10,1);
+ be_string(' <S[{|_}{|_}]> <S[|S|][{|_}_{_|}]> <U_> <U[__]> ZZZZ') ;
+ row( 8,12,1);
+ be_string(' <SL[L[L[> <SL]L]L]> <S||L[> <S||L]> ZZZZ') ;
+ row( 8,13,1);
+ be_string(' <S{|^}> <S{|v}> / \ ZZZZ') ;
+ row( 8,15,1);
+
+@ Here are the right hand halves.
+
+@<Define Lineprinter codes@>=
+ be_string('ZZZZ <S|L[> <S|L]> <SL[|> <SL]|> ') ;
+ row( 8,0,1);
+ be_string('ZZZZ <S|> <S[||]> <S[S/]/> <Z\[S\]> ') ;
+ row( 8,1,1);
+ be_string('ZZZZ <SL[L[L[L[> <SL]L]L]L]> <S|||L[> <S|||L]> ') ;
+ row( 8,2,1);
+ be_string('ZZZZ <S[S/]/\[S\]> <S\[S\][S/]/> <S[S/][S/]//> <S\\[S\][S\]> ') ;
+ row( 8,3,1);
+ be_string('ZZZZ <S||||L[> <S||||L]> <SL[||||> <SL]||||> ') ;
+ row( 8,4,1);
+ be_string('ZZZZ <S[S/][S/]//> <S\\[S\][S\]> <S[SS/][S/]/> <S\[S\][SS\]> ') ;
+ row( 8,5,1);
+ be_string('ZZZZ <S||L[> <S||L]> <S|> <S|> ') ;
+ row( 8,6,1);
+ be_string('ZZZZ <S[S|]L<[S|]> <S|[SL>]|> <S|> <S|> ') ;
+ row( 8,7,1);
+ be_string('ZZZZ <S[S/]L<[S\]> <S\[SL>]/> <S[{|_}{|_}]> <S[|S|][{|_}S{|_}]> ') ;
+ row( 8,8,1);
+ be_string('ZZZZ <S[/\][||]> <S[|+|][\_/]> <S[/\]> <S[\/]> ') ;
+ row( 8,10,1);
+ be_string('ZZZZ <U[___]> <U~> <U[~~]> <U[~~~]> ') ;
+ row( 8,12,1);
+ be_string('ZZZZ <SL[||> <SL]||> <SL{L{L{> <SL}L}L}> ') ;
+ row( 8,13,1);
+ be_string('ZZZZ \ / <S{|^}> <S{|v}> ') ;
+ row( 8,15,1);
+
+@ And here are the half rows that are so long that even half a row must be
+further split.
+
+@<Define Lineprinter codes@>=
+ be_string(' </{|O}/> <S/{|O}|/> <S[/\][\/]> <S[S_][/.\][\_/]> ZZZZ') ;
+ row( 8,9,1);
+ be_string('ZZZZ <S[{/_}{\_}][\/]> <S[S_][{/_}{|_}{_\}][\{|_}/]> ZZ') ;
+ row( 8,9,1);
+ be_string('ZZZZZZ <S[{\/}{/\}][{\/}{/\}]> <[S_][{\/}S{/\}][|{\/}|][{/\}_{/\}]> ') ;
+ row( 8,9,1);
+
+@#
+ be_string(' <[___]\[SL>][{/_}__]> <[___][|S|][|S|][|S|]> <S/||/> ZZZZZ') ;
+ row( 8,11,1);
+ be_string('ZZZ <S[|S|][|S|][\_/]> <[S_][/S\][|S|][|S|]> ZZZ') ;
+ row( 8,11,1);
+ be_string('ZZZZZ <S[|S|][|+|][\_/]> <SS[S/\][/SS\]> <SS[\SS/][S\/]> ') ;
+ row( 8,11,1);
+
+@#
+ be_string(' <S[_S|][S\|]> <S[SS|][_S|][S\|]> <S[SS|][SS|][_S|][S\|]> ZZZZZ') ;
+ row( 8,14,1);
+ be_string('ZZZ <S[SS|][SS|][SS|][_S|][S\|]> <S[SS|][_S|][S\|]> ZZZ') ;
+ row( 8,14,1);
+ be_string('ZZZZZ <S|> <U_|> <S[||]> ') ;
+ row( 8,14,1);
+
+@ The LATEX SYMBOL and LATEX CIRCLE schemes are really only included to stop
+the silly error messages that appear when processing LaTeX documents if they
+are omitted. But having said that, there are one or two characters that we
+can do: (This LATEX and ADOBE stuff by courtesy of J.Warbrick.)
+
+@<Define Lineprinter codes@>=
+ be_string( 'LATEX SYMBOLS' ); set_scheme(9) ;
+ be_string( 'LATEX CIRCLE' ); set_scheme(10) ;
+ be_string(' Z [L<|] [{L<_}|] [|L>] [|{L>_}] Z Z Z ') ;
+ row( 9, 0,1) ;
+ be_string(' [L<] [L>] Z Z Z Z Z Z ') ;
+ row( 9, 5,1) ;
+ be_string(' Z Z ~ ~ Z Z Z Z ') ;
+ row( 9, 7,1) ;
+
+@ LATEX LINE is much the same, except we can try more of the characters.
+Since the line segments will not line up correctly, the results of using this
+will probably be nasty
+
+@<Define Lineprinter codes@>=
+ be_string( 'LATEX LINE' ); set_scheme( 11) ;
+ be_string(' / | | | | | Z Z ') ;
+ row( 11, 0,1) ;
+ be_string(' / L< / v | v ^ v ') ;
+ row( 11, 1,1) ;
+ be_string(' / / L> / / ^ Z ^ ') ;
+ row( 11, 2,1) ;
+ be_string(' / L< / L< / L< L> Z ') ;
+ row( 11, 3,1) ;
+ be_string(' / / / / Z / Z Z ') ;
+ row( 11, 4,1) ;
+ be_string(' _ L< L> L< / L> Z L< ') ;
+ row( 11, 5,1) ;
+ be_string(' Z L> Z L> Z Z ^ L> ') ;
+ row( 11, 6,1) ;
+ be_string(' Z L< L> Z Z L< L> v ') ;
+ row( 11, 7,1) ;
+ be_string(' \ | | | | | Z Z ') ;
+ row( 11, 8,1) ;
+ be_string(' \ L< \ ^ | ^ v ^ ') ;
+ row( 11, 9,1) ;
+ be_string(' \ \ L> \ \ v Z v ') ;
+ row( 11,10,1) ;
+ be_string(' \ L< \ L< \ L< L> Z ') ;
+ row( 11,11,1) ;
+ be_string(' \ \ \ \ Z \ Z Z ') ;
+ row( 11,12,1) ;
+ be_string(' _ L< L> L< \ L> Z L< ') ;
+ row( 11,13,1) ;
+ be_string(' Z L> Z L> Z Z Z L> ') ;
+ row( 11,14,1) ;
+ be_string(' Z L< L> Z Z L< L> Z ') ;
+ row( 11,15,1) ;
+
+@ Next comes ADOBESTANDARDENCODING for PostScript text fonts. This assumes
+that your PostScript font TFM's use this as the coding scheme name for the
+font. AdobeStandardEncoding is what Adobe call their text encoding, so you
+will be OK if this got copied across.
+
+@<Define Lineprinter codes@>=
+ be_string( 'ADOBESTANDARDENCODING' ); set_scheme( 12) ;
+ alphabet(32,95,12,1,32);
+ be_string(' Z ! {LC/} $ / {Y=} f {LS*} ') ;
+ row( 12,20,1) ;
+ be_string(' * Q W [L<L<] L< L> [fi] [fl] ') ;
+ row( 12,21,1) ;
+ be_string(' Z - {|-} {|-_} . Z {9|} . ') ;
+ row( 12,22,1) ;
+ be_string(' , [,,] W [L>L>] [...] [%.] Z ? ') ;
+ row( 12,23,1) ;
+ be_string(' Z ` Q ^ ~ <U_> Z <U.> ') ;
+ row( 12,24,1) ;
+ be_string(' <U[..]> Z <U.> , Z W , Z ') ;
+ row( 12,25,1) ;
+ be_string(' [--] Z Z Z Z Z Z Z ') ;
+ row( 12,26,1) ;
+ be_string(' Z [LALE] Z <U{a_}> Z Z Z Z ') ;
+ row( 12,28,1) ;
+ be_string(' L {O/} [OLE] <U{o_}> Z Z Z Z ') ;
+ row( 12,29,1) ;
+ be_string(' Z [ae] Z Z Z i Z Z ') ;
+ row( 12,30,1) ;
+ be_string(' l {O/} [oe] {B_} Z Z Z Z ') ;
+ row( 12,31,1) ;
+
+@ And then ADOBESYMBOLENCODING for PostScript symbols. Adobe flag the coding
+scheme for Symbol as FontSpecific, but we can do better than this, so I have
+changed the scheme in the TFM's to this name.
+
+@<Define Lineprinter codes@>=
+ be_string( 'ADOBESYMBOLENCODING' ); set_scheme( 13) ;
+ alphabet(32,48,13,1,32);
+ be_string(' Z Z [{\-}{-/}] Z <U_[{-_}|]> Z Z {)-}$ ') ;
+ row( 13, 4,1) ;
+ be_string(' {~=} Z Z X [{/_}{_\}] Z {oI} S ') ;
+ row( 13, 8,1) ;
+ be_string(' Z Z v Z [/\] Z Z Z ') ;
+ row( 13, 9,1) ;
+ be_string(' <U[__][||]> {O-} P <U_{L>_}> T Y Z Z ') ;
+ row( 13,10,1) ;
+ be_string(' <U_{-_}> {u|} LZ L[ <U[S.][.S.]> L] {|_} _ ') ;
+ row( 13,11,1) ;
+ be_string(' <U[S_]> Z Z Z Z Z Z Z ') ;
+ row( 13,12,1) ;
+ be_string(' Z Z Z L{ | L} ~ Z ') ;
+ row( 13,15,1) ;
+ be_string(' Z Z Q {L<_} / [oo] f Z ') ;
+ row( 13,20,1) ;
+ be_string(' Z Z Z [{L<-}{-L>}] [{L<-}-] {^|} [-{-L>}] {|v} ') ;
+ row( 13,21,1) ;
+ be_string(' o {+_} W {L>_} x Z d o ') ;
+ row( 13,22,1) ;
+ be_string(' {-:} {=/} {=_} <U~~> [...] <U||> [---] Z ') ;
+ row( 13,23,1) ;
+ be_string(' Z Z Z Z {Ox} {O+} {O/} Z ') ;
+ row( 13,24,1) ;
+ be_string(' LU Z Z Z Z Z {(-} {(-/} ') ;
+ row( 13,25,1) ;
+ be_string(' {/_} <U[__][\/]> {Or} {Oc} [TLM] <U[__][||]> <U[S_]{v/}> . ') ;
+ row( 13,26,1) ;
+ be_string(' ~ & [or] [{L<=}{=L>}] [{L<=}=] {^|} [={=L>}] {|v} ') ;
+ row( 13,27,1) ;
+ be_string(' Z <U/\> {Or} {Oc} [TLM] <U_{L>_}> <U[S/]|> <U||> ') ;
+ row( 13,28,1) ;
+ be_string(' <U|[S\]> <UL[|> <U||> <U|L[> <U[S/]|> <U||> <U|[S\]> <U||> ') ;
+ row( 13,29,1) ;
+ be_string(' Z <U\/> <U[S/][S|]/> <U[S/]|> <U||> <U[S|]/> <U\[S|]> <U||> ') ;
+ row( 13,30,1) ;
+ be_string(' <U[S|]/> <UL]|> <U||> <U|L]> <U\[S|]> <U||> <U[S|]/> Z ') ;
+ row( 13,31,1) ;
+
+@ At our site (RHBNC) we have a set of text and symbol fonts. These were clearly
+made by people who didnt understand what a coding scheme was. The text fonts
+have all sorts of coding schemes written in their files, like `HELVETICA BOLD'
+etc., but in fact they nearly all actually use TEX TEXT. Some of the symbol
+fonts have the same scheme written into their files as the Zapf fonts, which are
+entirely different. In order to make some sense out of this mess, we arrange
+that an unknown scheme will default to TEX TEXT. This deals with all the text
+fonts. We will use the actual font names for some of the symbol fonts.
+
+Also our local \TeX\ is V2; it can only handle 128 char fonts. The PSYMML font
+is the first 128 chars of the symbol font; so we just give it the same scheme
+number. But PSYMMU is the other 128 chars offset by -128. (i.e. char 50 of
+PSYMMU = char 178 of SYMBOL).
+
+@<Define Lineprinter codes@>=
+ be_string( 'SYMBOL' ); set_scheme( 13) ;
+ be_string( 'PSSYML' ); set_scheme( 13) ;
+ be_string( 'PSSYMU' ); set_scheme( 14) ;
+ for in_i := 0 to 127 do
+ codes [14, in_i] := codes [13, in_i + 128] ;
+
+@ For the Screenview version we fudge some of these rows:
+
+@<Define Lineprinter codes@>=
+ if batch_view then begin
+ be_string(' Z Z [\=] Z [L<=] [L>=] [==] [or] ') ;
+ row( 1,3,1) ;
+ be_string(' Z [==] Z Z [L<=] [L>=] [L<=] [L>=] ') ;
+ row( 7,2,1) ;
+ end ;
+
+@ This peculiar arrangement is intended to allow the HPGF change file
+to make changes.
+
+@<Assign char...@>=
+ @<Define Lineprinter codes@>
+ @<Set rule characters@>
+
+@* Printer changes can be put here.
+
+*** Attach printer change file here ***
+
+@* Index.
+
+Pointers to error messages appear here under ``error" or ``Fatal" together with
+the section numbers where each identifier is used.