summaryrefslogtreecommitdiff
path: root/dviware/ln03/rose/ln03topp.pli
diff options
context:
space:
mode:
Diffstat (limited to 'dviware/ln03/rose/ln03topp.pli')
-rw-r--r--dviware/ln03/rose/ln03topp.pli1255
1 files changed, 1255 insertions, 0 deletions
diff --git a/dviware/ln03/rose/ln03topp.pli b/dviware/ln03/rose/ln03topp.pli
new file mode 100644
index 0000000000..30ff2bf13d
--- /dev/null
+++ b/dviware/ln03/rose/ln03topp.pli
@@ -0,0 +1,1255 @@
+/*
+
+This program is LN03Topp, which converts the output of DVI2LNG to LN03
+format files. Copyright (c) 1984 by Digital Equipment Corporation. Author:
+Flavio Rose, UHCLEM::ROSE.
+
+This program is UNDER DEVELOPMENT...
+
+Development chronology:
+
+11/26/84: Started coding. Changed filenames.
+11/28/84: New algorithm for allocation of TeX fonts to LN03 font slots
+11/29/84: Extensive changes in TOPPNFT. NBLANKS reduced to 0, perhaps
+ temporarily, to simplify font stuff.
+11/30/84: Fixed opening escape sequences.
+5/6/85: Corrected bug in placement of comma "," inside font load
+5/18/85: Corrected longstanding bugs, which also existed in Topp:
+ xpos and ypos are initialized to 0 rather than to dxof,
+ dyof; and their are not reset on a NEWPAGE.
+
+
+*/
+
+%REPLACE false BY '0'B;
+%REPLACE true BY '1'B;
+
+ln03topp: PROCEDURE OPTIONS(MAIN);
+
+ DCL (strip,frontstrip) EXTERNAL ENTRY (CHAR (*))
+ RETURNS (CHAR (*)),
+ cvis EXTERNAL ENTRY (FIXED) RETURNS (CHAR (*));
+ DCL upcase EXTERNAL ENTRY (CHAR (*)) RETURNS (CHAR (*));
+ DCL add_txf_to_lnf EXTERNAL ENTRY(FIXED,FIXED,CHAR(*),FILE)
+ RETURNS(FIXED);
+
+/* Debugging info */
+
+ DCL debug FILE;
+ DCL debugwid FIXED;
+ DCL debugflag BIT;
+ debugflag = false;
+ debugwid = 0;
+
+/* input file, output file, include file */
+
+ DCL (outf,inf,incfile) FILE;
+ DCL (infnam,outfnam) CHAR(150) VARYING;
+ DCL reading_from_incfile BIT;
+ reading_from_incfile = false;
+
+ ON UNDEFINEDFILE (inf) BEGIN;
+ PUT SKIP LIST('No such file: ' || infnam);
+ GOTO terminal_eof;
+ END;
+
+ ON UNDEFINEDFILE (outf) BEGIN;
+ PUT SKIP LIST('Couldn''t open: ' || outfnam);
+ GOTO terminal_eof;
+ END;
+
+ ON ENDFILE (inf) BEGIN;
+ CLOSE FILE(inf);
+ GOTO end_of_input;
+ END;
+
+/* Define <esc> <tab> as constants. In general this source file should not
+contain any ascii control characters; instead we use byte(). */
+
+ DCL (esc,tab) CHAR(1);
+ esc = byte(27);
+ tab = byte(9);
+
+/* Banner string */
+
+ PUT SKIP LIST ('LN03Topp 2');
+
+/* Get input and output files from command line. */
+
+ %INCLUDE $stsdef;
+ DCL lib$get_foreign ENTRY (CHAR(*) VARYING, CHAR(*) VARYING,
+ FIXED(15),FIXED) OPTIONS(VARIABLE) RETURNS(FIXED);
+ DCL indir CHAR(150) VARYING;
+ DCL (jj,jnam,jext,dxof,dyof) FIXED;
+
+/* Unlike Topp, this driver conforms to the TeX requirement that drivers
+imaging onto 8 1/2 x 11 inch paper place the (0,0) point of the DVI file
+one inch horizontally and vertically offset from the upper left corner of
+the paper. Hence we initialize the following offset variables, which may be
+reset by command line options. */
+
+ dxof = 300;
+ dyof = 300;
+
+/* ilp = input line ptr, illen = input line length, incsave = place to save
+rest of line when {INCLUDE} is encountered. */
+
+ %REPLACE inbufsize BY 2048;
+ DCL inline CHAR(inbufsize) VARYING;
+ DCL incsave CHAR(inbufsize) VARYING;
+ DCL tch CHAR(1);
+ DCL (illen,ilp,i,istart,istart2,zch) FIXED;
+
+ sts$value = lib$get_foreign(inline,,,0);
+
+ IF ^sts$success THEN DO;
+ PUT SKIP EDIT ('Usage: ln03topp <filename> <options>') (A);
+ GOTO terminal_eof;
+ END;
+
+ inline = inline || ' ';
+ illen = length(inline);
+ ilp = 1;
+ CALL skipb;
+ IF ilp > illen THEN DO;
+ PUT SKIP EDIT ('Usage: ln03topp <filename> <options>') (A);
+ GOTO terminal_eof;
+ END;
+ istart = ilp;
+ CALL skipnb;
+ infnam = substr(inline,istart,ilp-istart);
+ OPEN FILE(inf) TITLE(infnam)
+ ENVIRONMENT(Default_file_name('FOO.LNG'));
+
+ jnam = istart;
+ DO jj = ilp-1 TO istart BY -1;
+ IF substr(inline,jj,1) = ':' |
+ substr(inline,jj,1) = ']' |
+ substr(inline,jj,1) = '>'
+ THEN DO;
+ jnam = jj+1;
+ GOTO found_jnam;
+ END;
+ END;
+
+found_jnam:
+
+/* We need to remember the directory of the input filespec, so that we can
+open {INCLUDE} files in the same directory. Thus, we stash that directory
+in INDIR. */
+
+ indir = substr(inline,istart,jnam-istart);
+ jext = ilp;
+ DO jj = jnam TO ilp-1;
+ IF substr(inline,jj,1) = '.' |
+ substr(inline,jj,1) = ';'
+ THEN DO;
+ jext = jj;
+ GOTO found_jext;
+ END;
+ END;
+
+found_jext:
+
+/* The output file is placed in the current default directory; i.e., we get
+rid of the directory part and just use the name part of the input filespec.
+*/
+
+ outfnam = substr(inline,jnam,jext-jnam) || '.LN3';
+
+ OPEN FILE(outf) OUTPUT TITLE(outfnam)
+ ENVIRONMENT(Default_file_name('FOO.LN3'));
+
+/* Read any options from the command line. There are two possible options,
+/H= and /V=, which serve to locate the (0,0) point of the DVI file on the
+paper. */
+
+ CALL skipb;
+ DO WHILE (ilp <= illen-2);
+ IF substr(inline,ilp,3) = '/H=' THEN DO;
+ ilp = ilp+3;
+ jj = -1;
+ CALL getfixnum(jj);
+ dxof = jj;
+ END; ELSE IF substr(inline,ilp,3) = '/V=' THEN DO;
+ jj = -1;
+ ilp = ilp+3;
+ CALL getfixnum(jj);
+ dyof = jj;
+ END; ELSE CALL skipnb;
+ CALL skipb;
+ END;
+
+/* Globals: there are many of these
+
+ font information */
+
+ %REPLACE maxnfonts BY 21; /* so I am told */
+ %REPLACE maxtexfonts BY 100;
+ %REPLACE maxfontnos BY 9;
+ %REPLACE nblanks BY 0;
+ DCL (curf,fsize,totsize,chunkcnt) FIXED;
+ DCL curtxf PTR;
+ DCL lastch(0:maxnfonts) FIXED GLOBALDEF;
+ DCL chw(0:maxnfonts,0:255) FIXED GLOBALDEF;
+ DCL ftime(0:maxnfonts) FIXED;
+
+ fsize = 0;
+ totsize = 0;
+ curf = 0;
+ curtxf = Null();
+ chw = 0;
+ ftime = 0;
+ chunkcnt = 0;
+
+/* An LN03 "font" actually consists of two LN03 font loads, one to be
+placed in character positions 33 to 126, the other in positions 161 to 254.
+There are no raster size limitations on LN03 fonts, other than those
+imposed by this program (those should eventually be removed). */
+
+ %REPLACE leftfirst BY 33;
+ %REPLACE rightfirst BY 161;
+ %REPLACE leftlast BY 126;
+ %REPLACE rightlast BY 254;
+
+/* TXF is a record structure describing a TeX font. TXFA is an array of TXF
+records. TXF2LNF describes the mapping between TeX fonts and LN03 "fonts".
+*/
+
+ DCL 1 txf BASED,
+ 2 nchs FIXED,
+ 2 chu(0:255) CHAR(1);
+ DCL txfa(0:maxtexfonts) PTR GLOBALDEF;
+ DCL txf2lnf(0:maxtexfonts) FIXED;
+
+ txfa = Null();
+ txf2lnf = -1;
+
+/* WHBLANKS identifies the locations of the fixed width blanks in the LN03
+fonts. FNAME is the font file ID of each LN03 font. For the moment,
+however, we do not use WHBLANKS. */
+
+/* DCL whblanks(0:maxnfonts,1:nblanks) FIXED GLOBALDEF; */
+ DCL fname(0:maxnfonts) CHAR(31) GLOBALDEF;
+
+/* whblanks = -1;*/
+ fname = 'U000000002SK00GG0001UZZZZ02F000';
+ DO i = 0 TO MIN(maxnfonts,9);
+ substr(fname(i),7,1) = cvis(i);
+ END;
+ DO i = 10 TO maxnfonts;
+ substr(fname(i),6,2) = cvis(i);
+ END;
+
+/* The LN03 select-graphic-rendition numbers 0-9 have to be allocated among
+the fonts. The USENO array keeps track of which number a font is allowed to
+use, -1 if none is currently allocated. The WHOUSES array says which font
+is using a number. */
+
+ DCL (useno(0:maxnfonts),whouses(0:maxfontnos)) FIXED;
+
+ useno = -1;
+ whouses = -1;
+
+/* The landscape bit is for future reference; currently LN03Topp does not
+support landscape printing */
+
+ DCL landscape BIT;
+
+ landscape = false;
+
+ DCL (maxrmar,maxbmar) FIXED;
+ maxrmar = 2550;
+ maxbmar = 3300;
+
+/* In the following, esc[?27h means "advance the carriage by the character
+width when you set a character", esc[11h and esc[7 I together mean to
+interpret all dimensions in escape sequences as pixel units; esc[?52h means
+our origin of coordinates is the upper left edge of the paper; esc[3300t
+means the "maximum length" of the paper is 3300 pixels. */
+
+ PUT EDIT (esc || 'c') (A) FILE(outf);
+ PUT EDIT (esc || '[?27h' || esc || '[11h' || esc || '[7 I'
+ || esc || '[?52h' || esc || '[3300t')
+ (A) FILE(outf);
+
+/* A count of pages is plotted out on the terminal to give users an
+indication of progress. */
+
+ DCL pageno FIXED;
+ pageno = 1;
+
+/* Current x and y positions: always in pixels. */
+
+ DCL (xpos,ypos) FIXED;
+ xpos = dxof;
+ ypos = dyof;
+
+/* User definable command area: This is left over from the LNF program
+whence Topp and then LN03Topp are derived. This stuff should be taken out.
+*/
+
+ %REPLACE udcsize BY 4096;
+ DCL 1 udcr BASED,
+ 2 (udcname,udcnamelen,udcvalue,udcvaluelen) FIXED,
+ 2 next PTR;
+ DCL udclist PTR;
+ DCL udcarea CHAR(udcsize);
+ DCL udcarray(udcsize) CHAR(1) BASED (addr(udcarea));
+ DCL udcaptr FIXED;
+
+ udclist = Null();
+ udcaptr = 1;
+ /* Predefine some commands */
+ IF define_command('LB','{CHAR123}') THEN;
+ IF define_command('RB','{CHAR125}') THEN;
+
+/* Page storage: we save up a page before outputting it to minimize the
+complexity of the page for the LN03. Since the capacity limitations of the
+LN03, unlike those of the LN01, are nowhere defined, it is unclear whether
+the transformations we perform are actually useful. */
+
+/* The page is stored as a set of characters in the PBUF, plus a collection
+of lists of "chunks". The lists are indexed by Y-position, using the array
+CHLS. Each chunk is a sequence of characters that can be written without
+backspacing or changing vertical position. */
+
+ %REPLACE pbufsize BY 65536;
+ DCL pbuf(0:pbufsize) CHAR(1);
+ DCL chls(0:3300) PTR; /* 3300 is maximum value of maxbmar */
+
+/* The CHUNK record keeps track of a chunk, giving the X position at which
+it starts and ends (XS, XE), the index of where its characters start and
+end in PBUF (IS, IE), plus the TeX font in which it is set (FS). */
+
+ DCL 1 chunk BASED,
+ 2 (xs,xe,is,ie,fs) FIXED,
+ 2 next PTR;
+
+/* Chunk records are allocated from a free list. PBUFI keeps track of how
+much of PBUF is being used. CHUNKMAX is a count of how many chunks are
+allocated (not used for anything). */
+
+ DCL (free_chunk_list,curchunk) PTR;
+ DCL (pbufi,chunkmax) FIXED;
+ DCL top_of_page BIT;
+
+ pbufi = 0;
+ chunkmax = 0;
+ free_chunk_list = Null();
+ chls = Null();
+ curchunk = Null();
+ top_of_page = false;
+
+/* This is the main loop: */
+
+ DO WHILE (true);
+ CALL read_inline;
+
+ illen = length(inline);
+ ilp = 1;
+ istart2 = 1;
+
+ DO WHILE (ilp <= illen);
+ tch = substr(inline,ilp,1);
+ IF tch = '{' THEN DO;
+ IF istart2 < ilp THEN CALL ord_text(substr(inline,
+ istart2,ilp-istart2));
+ CALL handle_command;
+ istart2 = ilp;
+ END; ELSE ilp = ilp+1;
+ END;
+ IF istart2 < ilp THEN CALL ord_text(substr(inline,istart2,ilp-
+ istart2));
+ END;
+
+end_of_input:
+ ;
+
+abort_job:
+ PUT EDIT (esc || 'c') (A) FILE(outf);
+ CLOSE FILE(outf);
+
+terminal_eof:
+ RETURN;
+
+/* Decipher command from inline and then execute it */
+
+ handle_command: PROCEDURE;
+ DCL (j,k,fno) FIXED;
+ DCL (command,name) CHAR(16) VARYING;
+
+ ON UNDEFINEDFILE (incfile) BEGIN;
+ PUT SKIP LIST('No such file:' || substr(inline,istart,
+ ilp-istart));
+ GOTO windup_command;
+ END;
+
+ istart = ilp+1;
+ ilp = istart;
+ DO WHILE ('A' <= substr(inline,ilp,1) &
+ substr(inline,ilp,1) <= 'Z');
+ ilp = ilp+1;
+ END;
+ command = substr(inline,istart,ilp-istart);
+ IF command = 'HPA' | command = 'X' THEN DO;
+ k = -1;
+ CALL getfixnum(k);
+ k = k+dxof;
+ xpos = k;
+ END; ELSE IF command = 'VPA' THEN DO;
+ j = 0;
+ CALL getfixnum(j);
+ j = j+dyof;
+ CALL finish_chunk;
+ ypos = j;
+ END; ELSE IF command = 'NOFILL' THEN;
+ /* ignore, always in nofill mode */
+ ELSE IF command = 'DEBUG' THEN debugflag = true;
+ ELSE IF command = 'WLN' THEN CALL process_wln;
+ ELSE IF command = 'NODEBUG' THEN debugflag = false;
+ ELSE IF command = '' THEN DO;
+ CALL findcb2;
+ ilp = ilp+1;
+ END; ELSE IF command = 'NEWPAGE' THEN DO;
+ CALL finish_chunk;
+ CALL finish_page;
+ xpos = dxof;
+ ypos = dyof;
+ END; ELSE IF command = 'FO' THEN DO;
+ CALL getfixnum(fno);
+ IF fno < 0 | fno > maxtexfonts THEN CALL error1
+ ('Bad font number ' || cvis(fno) || ' in FO command.');
+ IF txfa(fno) = Null() THEN CALL error1
+ ('Font number ' || cvis(fno) || ' not present.');
+ CALL finish_chunk;
+ curf = fno;
+ curtxf = txfa(fno);
+ END; ELSE IF command = 'INCLUDE' THEN DO;
+ IF reading_from_incfile THEN CALL
+ error1('{INCLUDE}s can''t be nested.');
+ CALL skipb;
+ istart = ilp;
+ CALL skipnb2;
+ OPEN FILE (incfile) TITLE (substr(inline,istart,ilp-istart))
+ ENVIRONMENT(Default_file_name(indir || 'FOO.LNG'));
+ reading_from_incfile = true;
+ CALL findcb;
+ ilp = ilp+1;
+ IF rest_of_inline_blank() THEN incsave = '';
+ ELSE incsave = substr(inline,ilp,illen-ilp);
+ ilp = illen+1;
+ END; ELSE IF command = 'LMAR' | command = 'RMAR' |
+ command = 'TMAR' | command = 'BMAR' THEN;
+ ELSE IF command = 'RULEA' THEN DO;
+ DCL (x0,y0,x1,y1,temp) FIXED;
+
+ CALL getfixnum(x0);
+ CALL getfixnum(y0);
+ CALL getfixnum(x1);
+ CALL getfixnum(y1);
+ x0 = min(x0+dxof,maxrmar);
+ x1 = min(x1+dxof,maxrmar);
+ x0 = max(x0,0);
+ x1 = max(x1,0);
+ y0 = min(y0+dyof,maxbmar);
+ y1 = min(y1+dyof,maxbmar);
+ y0 = max(y0,0);
+ y1 = max(y1,0);
+ IF x0 > x1 THEN DO; temp = x0; x0 = x1; x1 = temp; END;
+ IF y0 > y1 THEN DO; temp = y0; y0 = y1; y1 = temp; END;
+
+ IF top_of_page THEN DO;
+ top_of_page = false;
+ PUT EDIT (byte(12)) (A) FILE(outf);
+ END;
+
+/* All rules are put at the beginning of the page, a separate line for each
+one. A vertical positioning command is necessary because otherwise the LN03
+would keep on advancing the vertical position as more rules are set, in
+response to the end of line carriage returns. */
+
+ IF y1 ^= y0 & x1 ^= x0 THEN DO;
+ IF landscape
+ THEN PUT SKIP EDIT (esc || '[100d' ||
+ esc || '[0;' || cvis(y0) || ';' ||
+ cvis(x0) || ';' || cvis(y1-y0) || ';' ||
+ cvis(x1-x0) || '!|') (A) FILE(outf);
+ ELSE PUT SKIP EDIT (esc || '[100d' ||
+ esc || '[1;' || cvis(x0) || ';' ||
+ cvis(y0) || ';' || cvis(y1-y0) || ';' ||
+ cvis(x1-x0) || '!|') (A) FILE(outf);
+ END;
+
+ END; ELSE IF command = 'CHAR' THEN DO;
+ j = 0;
+ CALL getfixnum(j);
+ CALL ord_text(byte(j));
+ END; ELSE IF command = 'CU' THEN DO;
+ CALL getfixnum(fno);
+ IF fno < 0 | fno > maxtexfonts THEN CALL error1
+ ('Bad font number ' || cvis(fno) || ' in CU command.');
+ CALL skipb;
+ IF txfa(fno) = Null() THEN
+ ALLOCATE txf SET (txfa(fno));
+ txfa(fno) -> chu = byte(0);
+ j = 0;
+ k = 0;
+ DO WHILE (substr(inline,ilp,1) ^= '}' & substr(inline,ilp,1)
+ ^= ' ');
+ IF substr(inline,ilp,1) = '1' THEN DO;
+ txfa(fno) -> chu(j) = byte(1);
+ k = k+1;
+ END;
+ j = j+1;
+ ilp = ilp+1;
+ END;
+ txfa(fno) -> txf.nchs = k;
+
+ END; ELSE IF command = 'DEF' THEN DO;
+ /* Definition of a user defined command : very delicate */
+
+ CALL skipb;
+ IF ilp > illen THEN CALL error1('DEF has no parameters.');
+ IF substr(inline,ilp,1) ^= '{' THEN DO;
+ CALL findcb2;
+ CALL error1('DEF syntax is {DEF{command}value}.');
+ END;
+ ilp = ilp+1;
+ istart = ilp;
+ DO WHILE ('A' <= substr(inline,ilp,1) & substr(inline,ilp,1)
+ <= 'Z');
+ ilp = ilp+1;
+ END;
+ IF substr(inline,ilp,1) ^= '}' THEN DO;
+ CALL findcb;
+ ilp = ilp+1;
+ CALL findcb2;
+ CALL error1('DEF syntax is {DEF{command}value}.');
+ END;
+ IF ilp = istart | ilp-istart > 16 THEN CALL error1
+ ('DEF ignored, new command name blank or too long.');
+ k = ilp;
+ ilp = ilp+1;
+ CALL findcb2;
+ IF ^define_command(substr(inline,istart,k-istart),
+ substr(inline,k+1,ilp-k-1))
+ THEN CALL bad_error('User command area exhausted.');
+ END; ELSE IF command ^= '' THEN DO;
+ DCL p PTR;
+
+ DO p = udclist REPEAT p -> udcr.next WHILE (p ^= Null());
+ IF command = substr(udcarea,p -> udcname,p -> udcnamelen)
+ THEN DO;
+ CALL findcb;
+ ilp = ilp+1;
+ IF p -> udcvaluelen + illen-ilp+1 > inbufsize THEN
+ CALL error1 ('Input buffer size exceeded, ' ||
+ 'user command ' || command || ' ignored.');
+ /* Put Udc in stream to be executed */
+ inline = substr(udcarea,p -> udcvalue,
+ p -> udcvaluelen) || substr(inline,ilp,
+ illen-ilp+1);
+ illen = length(inline);
+ ilp = 1;
+ RETURN;
+ END;
+ END;
+ CALL error1 ('No such command: ' || command);
+ END;
+
+ windup_command:
+ CALL findcb;
+ ilp = ilp+1;
+ RETURN;
+
+ findcb2: PROCEDURE;
+ DCL cbc FIXED;
+
+ cbc = 0;
+ DO WHILE (ilp <= illen);
+ IF substr(inline,ilp,1) = '{' THEN cbc = cbc+1;
+ ELSE IF substr(inline,ilp,1) = '}' THEN cbc = cbc-1;
+ IF cbc < 0 THEN RETURN;
+ ilp = ilp+1;
+ END;
+
+ END findcb2;
+
+ error1: PROCEDURE(str);
+ DCL str CHAR(*);
+
+ PUT SKIP EDIT (str) (A);
+ GOTO windup_command;
+
+ END error1;
+
+ bad_error: PROCEDURE(str);
+ DCL str CHAR(*);
+
+ PUT SKIP EDIT (str) (A);
+ GOTO abort_job;
+
+ END bad_error;
+
+ END handle_command;
+
+
+ finish_chunk: PROCEDURE;
+
+ curchunk = Null();
+
+ END finish_chunk;
+
+/* skip over blanks in inline */
+
+ skipb: PROCEDURE;
+
+ DO WHILE (ilp <= illen);
+ IF substr(inline,ilp,1) ^= ' ' THEN RETURN;
+ ilp = ilp+1;
+ END;
+
+ END skipb;
+
+/* skip over characters other than ' ' and '}'. */
+
+ skipnb2: PROCEDURE;
+
+ DO WHILE (ilp <= illen);
+ IF substr(inline,ilp,1) = ' '
+ | substr(inline,ilp,1) = '}' THEN RETURN;
+ ilp = ilp+1;
+ END;
+
+ END skipnb2;
+
+ skipnb: PROCEDURE;
+
+ DO WHILE (ilp <= illen);
+ IF substr(inline,ilp,1) = ' ' THEN RETURN;
+ ilp = ilp+1;
+ END;
+
+ END skipnb;
+
+/* Read a fixnum from inline and put it in x. If can't find one then x is
+left unchanged. */
+
+ getfixnum: PROCEDURE (x);
+ DCL (x,x1) FIXED;
+ DCL negative BIT;
+
+ negative = false;
+ IF ilp > illen THEN RETURN;
+ CALL skipb;
+ IF substr(inline,ilp,1) = '-' THEN DO;
+ negative = true;
+ ilp = ilp+1;
+ END;
+
+ IF ilp > illen | substr(inline,ilp,1) < '0'
+ | substr(inline,ilp,1) > '9'
+ THEN RETURN;
+
+ x1 = 0;
+ DO WHILE(substr(inline,ilp,1) >= '0' &
+ substr(inline,ilp,1) <= '9'); /* cheat */
+ x1 = 10*x1 + RANK(substr(inline,ilp,1)) - RANK('0');
+ ilp = ilp+1;
+ IF ilp > illen THEN GOTO gotnum;
+ END;
+
+ gotnum:
+ x = x1;
+ IF negative THEN x = -x;
+ RETURN;
+
+ END getfixnum;
+
+/* find close bracket } */
+
+ findcb: PROCEDURE;
+
+ IF ilp >= illen THEN RETURN;
+ DO WHILE (ilp < illen & substr(inline,ilp,1) ^= '}');
+ ilp = ilp+1;
+ END;
+
+ END findcb;
+
+/* determine if rest of inline is blank */
+
+ rest_of_inline_blank: PROCEDURE RETURNS (BIT);
+ DCL j FIXED;
+
+ IF ilp > illen THEN RETURN (true);
+ j = ilp;
+ DO WHILE (j <= illen);
+ IF (substr(inline,j,1) ^= ' '
+ & substr(inline,j,1) ^= tab) THEN RETURN(false);
+ j = j+1;
+ END;
+ RETURN(true);
+
+ END rest_of_inline_blank;
+
+/* The following procedure is still called 'process_wln', even though the
+file extensions now default to '.nft' rather than '.tln'. Magnified font
+extensions still have to be numeric... */
+
+ process_wln: PROCEDURE;
+ DCL (j,k,l,fno,maxfno,chsize) FIXED;
+ DCL font_selected BIT;
+ DCL (txfns(0:maxtexfonts),txfne(0:maxtexfonts)) FIXED;
+
+/* Destroy all traces of preceding fonts */
+
+ totsize = 0;
+ chsize = 0;
+/* whblanks = -1;*/
+ useno = -1;
+ whouses = -1;
+ txfns = -1;
+ txfne = -1;
+ maxfno = 0;
+ PUT SKIP EDIT(esc || 'P0;1;1y') (A) FILE(outf);
+
+/* Read the font names and numbers from inline. Because LN03 fontnames can
+be very long, this will probably have to be changed to read from more than
+one line. For 100 fonts, 2048 characters in the line is not enough. */
+
+ CALL skipb;
+
+ DO WHILE (substr(inline,ilp,1) ^= '}' & ilp < illen);
+ istart = ilp;
+ CALL skipnb2;
+ j = ilp;
+ fno = 0;
+ CALL getfixnum(fno);
+ IF fno < 0 | fno > maxtexfonts THEN DO;
+ PUT SKIP EDIT ('Bad font no.: ' || cvis(fno)) (A);
+ GOTO abort_job;
+ END;
+ txfns(fno) = istart;
+ txfne(fno) = j;
+ IF fno > maxfno THEN maxfno = fno;
+ IF txfa(fno) = Null() THEN DO;
+ ALLOCATE txf SET(txfa(fno));
+ DO k = 0 TO 127;
+ txfa(fno) -> chu(k) = byte(1);
+ END;
+ DO k = 128 TO 255;
+ txfa(fno) -> chu(k) = byte(0);
+ END;
+
+/* The default assumption, if the input contains no CU command for a given
+font, is that only characters 0-127 are used. For efficiency's sake this is
+not actually checked as the characters are read in and translated. */
+
+ txfa(fno) -> nchs = 128;
+ END;
+ IF txfa(fno) -> nchs > 182 THEN GOTO need_empty_slots;
+ chsize = chsize + txfa(fno) -> nchs;
+ CALL skipb;
+ END;
+
+/* Now we have to allocate TeX fonts (TXFs) to LN03 fonts (LNFs) and
+perform the actual load. The goal is to use as few slots as possible, where
+an LNF with <= 94 characters is one slot, and an LNF with > 94 but <= 188
+characters is two slots.
+
+As in the LN01 case, the allocation problem seems to be some sort of hard
+bin packing problem. (Proof of NP-hardness, anyone?) So we use a best fit
+heuristic:
+
+1. Find the unassigned largest TXF. If none, exit.
+
+2. Allocate an LNF for it.
+
+3. Find the largest TXF that fits in what is left of that LNF.
+
+ 3.1. If none exists, go to 1.
+ 3.2. If one exists, put it in the LNF and go back to 3.
+
+The TXFORD array will contain the TXF numbers in the order that they are
+assigned. TXFCNT keeps track of how many TXFs have been assigned so far. */
+
+ DCL (lnfcnt,txfcnt,the_txf,txf_size,lnfleft) FIXED;
+ DCL txford(0:maxtexfonts) FIXED;
+
+ lnfcnt = 0;
+ txfcnt = 0;
+ txford = -1;
+
+
+
+ DO WHILE (true);
+
+/* Find largest unassigned TXF */
+
+ lnfleft = rightlast-rightfirst+1+leftlast-leftfirst+1-nblanks;
+ txf_size = -1;
+ DO j = 0 TO maxtexfonts;
+ IF txfa(j) ^= Null() & txf2lnf(j) = -1
+ & txfa(j) -> nchs > txf_size THEN DO;
+ txf_size = txfa(j) -> nchs;
+ the_txf = j;
+ END;
+ END;
+ IF txf_size <= 0 THEN GOTO assignment_done;
+ IF lnfcnt > maxnfonts THEN GOTO too_complex;
+ IF txf_size > lnfleft THEN GOTO need_empty_slots;
+
+/* Now allocate new LNF and put TXF in it */
+
+ txf2lnf(the_txf) = lnfcnt;
+ txford(txfcnt) = the_txf;
+ txfcnt = txfcnt+1;
+ k = leftfirst-1;
+ DO j = 0 TO 255;
+ IF txfa(the_txf) -> chu(j) ^= byte(0) THEN DO;
+ k = k+1;
+ IF k = leftlast+1 THEN k = rightfirst;
+ lnfleft = lnfleft-1;
+ txfa(the_txf) -> chu(j) = byte(k);
+ END;
+ END;
+ lastch(lnfcnt) = k;
+
+/* Now try to fill the remaining part of the LNF using other TeX fonts */
+
+ DO WHILE (true);
+
+ txf_size = -1;
+ DO j = 0 TO maxtexfonts;
+ IF txfa(j) ^= Null() & txf2lnf(j) = -1
+ & txfa(j) -> nchs > txf_size
+ & txfa(j) -> nchs <= lnfleft THEN DO;
+ txf_size = txfa(j) -> nchs;
+ the_txf = j;
+ END;
+ END;
+ IF txf_size <= 0 THEN GOTO current_lnf_exhausted;
+
+ txf2lnf(the_txf) = lnfcnt;
+ txford(txfcnt) = the_txf;
+ txfcnt = txfcnt+1;
+ k = lastch(lnfcnt);
+ DO j = 0 TO 255;
+ IF txfa(the_txf) -> chu(j) ^= byte(0) THEN DO;
+ k = k+1;
+ lnfleft = lnfleft-1;
+ IF k = leftlast+1 THEN k = rightfirst;
+ txfa(the_txf) -> chu(j) = byte(k);
+ END;
+ END;
+ lastch(lnfcnt) = k;
+ END;
+
+ current_lnf_exhausted:
+ lnfcnt = lnfcnt+1;
+ END;
+
+assignment_done:
+
+/* At this point the array TXF2LNF is properly initialized, as are LASTCH
+and TXFORD. It remains to actually generate the desired font load. This has
+to be done carefully, since characters may only be added to an LNF in
+ascending order. */
+
+ DO j = 0 TO txfcnt-1;
+ k = txford(j);
+ IF j ^= 0 & txf2lnf(k) ^= txf2lnf(txford(j-1)) THEN PUT SKIP
+ EDIT (',') (A) FILE(outf);
+ totsize = totsize+add_txf_to_lnf(txf2lnf(k),k,
+ substr(inline,txfns(k),
+ txfne(k)-txfns(k)),outf);
+ END;
+
+/* At this point we need to write a message saying how long the font load
+is overall. That comes from TOTSIZE plus an overhead factor that depends on
+how many LNFs there are and whether any of them don't use the right half of
+the code chart. */
+
+ PUT SKIP EDIT (';LN03Topp 2 font load' || esc || '\') (A) FILE(outf);
+ IF landscape THEN DO;
+ maxrmar = 3300;
+ maxbmar = 2550;
+/* PUT EDIT(esc || 'c') (A) FILE(outf);*/
+ PUT EDIT (esc || '[1;3300s' || esc || '[2550t' ||
+ esc || '[1;2550r')
+ (A) FILE(outf);
+ END; ELSE DO;
+ maxbmar = 3300;
+ maxrmar = 2550;
+/* PUT EDIT(esc || 'c') (A) FILE(outf);*/
+ PUT EDIT(esc || '[1;2550s' || esc || '[3300t' ||
+ esc || '[1;3300r')
+ (A) FILE(outf);
+ END;
+ font_selected = false;
+ DO j = 0 TO MIN(maxfontnos,lnfcnt-1);
+ useno(j) = j;
+ whouses(j) = j;
+ PUT EDIT
+ (esc || 'P1;1' || cvis(j) || '}' ||
+ substr(fname(j),1,16) || esc || '\') (A)
+ FILE(outf);
+ IF ^font_selected THEN DO;
+ PUT EDIT (esc || '[1' || cvis(j) || 'm') (A)
+ FILE(outf);
+ font_selected = true;
+ END;
+ END;
+
+ RETURN;
+
+ too_complex:
+ PUT SKIP EDIT ('Can''t construct usable font load: input ' ||
+ 'too complex') (A);
+ GOTO abort_job;
+
+ need_empty_slots:
+ PUT SKIP EDIT ('Font ' || cvis(fno) || ' uses >182 characters.'
+ || ' LN03Topp can''t handle that.') (A);
+ GOTO abort_job;
+
+ rasters_too_large:
+ PUT SKIP EDIT ('The required rasters from font ' || cvis(fno) ||
+ ' are too large for this preliminary LN03Topp to handle.') (A);
+ GOTO abort_job;
+
+ END process_wln;
+
+ /* insert ordinary text into page */
+ ord_text: PROCEDURE (c);
+ DCL c CHAR(*);
+ DCL (c1,c2) CHAR(1);
+ DCL (t,j,zch) FIXED;
+
+ t = length(c);
+ IF t = 0 THEN RETURN;
+ IF xpos < 0 | xpos > maxrmar | ypos < 0 | ypos > 3300 THEN DO;
+ PUT SKIP EDIT ('"') (A);
+ DO j = 1 TO t;
+ IF substr(c,j,1) >= ' ' THEN PUT EDIT
+ (substr(c,j,1)) (A);
+ ELSE PUT EDIT ('.') (A);
+ END;
+ PUT EDIT ('" set off paper ') (A);
+ IF xpos < 0 | xpos > maxrmar THEN PUT EDIT ('(X = ' || cvis(xpos)
+ || ') ') (A);
+ IF ypos < 0 | ypos > 3300 THEN PUT EDIT ('(Y = ' || cvis(ypos)
+ || ') ') (A);
+ IF xpos < 0 THEN xpos = 0; ELSE xpos = maxrmar;
+ IF ypos < 0 THEN ypos = 0; ELSE ypos = 3300;
+ END;
+ IF curchunk = Null() THEN DO;
+ CALL new_chunk;
+ curchunk -> chunk.xs = xpos;
+ curchunk -> chunk.xe = xpos;
+ curchunk -> chunk.is = pbufi;
+ END;
+ IF xpos < curchunk -> chunk.xe THEN DO;
+ CALL finish_chunk;
+ CALL new_chunk;
+ curchunk -> chunk.xs = xpos;
+ curchunk -> chunk.is = pbufi;
+ END; ELSE IF xpos > curchunk -> chunk.xe
+ THEN CALL move_forward(xpos-curchunk -> chunk.xe);
+ IF pbufi+t >= pbufsize THEN DO;
+ PUT SKIP EDIT('Topp capacity exceeded: ' ||
+ 'too much stuff on one page.') (A);
+ GOTO abort_job;
+ END;
+ DO j = 1 TO t;
+ c2 = substr(c,j,1);
+ zch = rank(c2);
+ c1 = curtxf -> chu(zch);
+ zch = rank(c1);
+ pbuf(pbufi+j-1) = c1;
+ xpos = xpos+chw(txf2lnf(curf),zch);
+ END;
+ pbufi = pbufi+t;
+ curchunk -> chunk.xe = xpos;
+ curchunk -> chunk.ie = pbufi;
+
+ END ord_text;
+
+ finish_page: PROCEDURE;
+ %REPLACE maxprch BY 175;
+ %REPLACE maxtotch BY 200;
+ DCL (i,j,xmax,xleft,nprch,ntotch) FIXED;
+ DCL (pt,pt2,pt3,pt4,obufp,lis) PTR;
+ DCL obuf CHAR(400) BASED (obufp);
+ DCL found BIT;
+
+ PUT EDIT ('[' || cvis(pageno) || '] ') (A);
+ IF top_of_page THEN DO;
+ top_of_page = false;
+ PUT EDIT(byte(12)) (A) FILE(outf);
+ END;
+
+ /* Now we have to write out all the chunks */
+ /* For now we will write them in a simple fashion */
+ DO i = 0 TO 3300;
+ IF chls(i) ^= Null() THEN DO;
+ /* MXO stuff has been omitted here */
+ lis = Null();
+ DO WHILE (chls(i) ^= Null());
+ xleft = 1000000000; /* a very high value */
+ /* Make LIS be a list of nonoverlapping chunks */
+ DO WHILE (true);
+ pt2 = Null();
+ pt3 = Null();
+ xmax = -1;
+ DO pt = chls(i) REPEAT pt -> chunk.next
+ WHILE (pt ^= Null());
+ IF pt -> chunk.xe > xmax
+ & pt -> chunk.xe <= xleft THEN DO;
+ xmax = pt -> chunk.xe;
+ pt3 = pt;
+ pt4 = pt2;
+ END;
+ pt2 = pt;
+ END;
+ IF pt3 = Null() THEN GOTO print_lis;
+ IF pt4 = Null() THEN chls(i) = chls(i) -> chunk.next;
+ ELSE pt4 -> chunk.next = pt4 -> chunk.next
+ -> chunk.next;
+ pt3 -> chunk.next = lis;
+ lis = pt3;
+ xleft = pt3 -> chunk.xs;
+ END;
+ print_lis:
+ IF lis = Null() THEN GOTO next_i;
+ DO WHILE (lis ^= Null());
+ /* Print as many chunks from LIS as will fit
+ on one line; split last chunk if necessary */
+ nprch = 0;
+ ntotch = 0;
+ PUT SKIP FILE(outf);
+ CALL escape_seq_outf(esc || '[' || cvis(i) || 'd');
+ pt = lis;
+ pt2 = Null();
+ DO WHILE (pt ^= Null());
+ pt3 = pt;
+ CALL print_pt;
+ IF pt ^= Null() THEN GOTO finished_lis;
+ pt = pt3 -> chunk.next;
+ pt2 = pt3;
+ END;
+ finished_lis:
+ IF pt2 ^= Null() THEN DO;
+ pt2 -> chunk.next = free_chunk_list;
+ free_chunk_list = lis;
+ lis = pt;
+ END;
+ END;
+ END;
+ END;
+ next_i:
+ END;
+ pbufi = 0;
+ PUT EDIT (byte(10)) (A) FILE(outf);
+ top_of_page = true;
+ pageno = pageno+1;
+
+ move_forward_outf: PROCEDURE (dist,font);
+ DCL (dist,font) FIXED;
+ DCL sdist CHAR(12) VARYING;
+
+ sdist = cvis(dist);
+ CALL escape_seq_outf(esc || '[' || sdist || 'a');
+ ntotch = ntotch+3+length(sdist);
+
+ END move_forward_outf;
+
+ escape_seq_outf: PROCEDURE (c);
+ DCL c CHAR(*);
+ DCL t FIXED;
+
+ t = length(c);
+ ntotch = ntotch+t;
+ PUT EDIT (c) (A) FILE(outf);
+
+ END escape_seq_outf;
+
+ print_pt: PROCEDURE;
+
+ DCL (chunklen,escix,uselen,base,i,j,k,font) FIXED;
+
+ /* This procedure prints as much of pt as there
+ is room left on the line for and deletes that
+ piece of pt */
+
+ base = pt -> chunk.is;
+ chunklen = pt -> chunk.ie - pt -> chunk.is;
+ uselen = min(chunklen,maxtotch-ntotch);
+ uselen = min(uselen,maxprch-nprch);
+
+ IF uselen < 1 THEN RETURN; /* shouldn't be, but... */
+
+
+/* We must ensure that PT is not split in the middle of an escape
+sequence */
+
+ IF uselen ^= chunklen THEN DO;
+ escix = -1;
+ DO i = 0 TO uselen-1;
+ IF pbuf(pt -> chunk.is+i) = esc THEN
+ escix = i;
+ END;
+ IF escix ^= -1 & uselen-escix <= 8 THEN DO;
+ DO i = escix TO uselen-1;
+ IF pbuf(pt -> chunk.is+i) = 'a' THEN
+ GOTO no_problem;
+ END;
+ uselen = escix;
+ END;
+ END;
+ no_problem:
+
+ font = txf2lnf(pt -> chunk.fs);
+ IF useno(font) = -1 THEN DO;
+ useno(whouses(maxfontnos)) = -1;
+ useno(font) = maxfontnos;
+ whouses(maxfontnos) = font;
+ CALL escape_seq_outf(esc ||
+ 'P1;1' || cvis(maxfontnos) || '}' ||
+ substr(fname(font),1,16) || esc || '\');
+ END;
+
+ CALL escape_seq_outf(esc || '[1' ||
+ cvis(useno(font)) || 'm');
+ IF pt = lis THEN CALL escape_seq_outf(esc || '['
+ || cvis(pt -> chunk.xs) || '`');
+ ELSE DO;
+ j = pt -> chunk.xs - pt2 -> chunk.xe;
+ IF j ^= 0 THEN CALL move_forward_outf(j,
+ font);
+ END;
+ obufp = addr(pbuf(pt -> chunk.is));
+ PUT EDIT (substr(obuf,1,uselen)) (A) FILE(outf);
+ nprch = nprch+uselen;
+ ntotch = ntotch+uselen;
+ IF uselen = chunklen THEN pt = Null();
+ ELSE DO;
+ k = base;
+ DO WHILE (k <= base+uselen-1);
+ IF pbuf(k) ^= esc THEN pt -> chunk.xs = pt ->
+ chunk.xs+chw(font,rank(pbuf(k)));
+ ELSE DO;
+ i = 0;
+ k = k+2;
+ DO WHILE (pbuf(k) ^= 'a');
+ i = i*10 + rank(pbuf(k))-rank('0');
+ k = k+1;
+ IF k > base+uselen-1 THEN PUT SKIP
+ EDIT ('Topp internal error.') (A);
+ END;
+ pt -> chunk.xs = pt -> chunk.xs+i;
+ END;
+ k = k+1;
+ END;
+ pt -> chunk.is = pt -> chunk.is+uselen;
+ END;
+
+ END print_pt;
+
+ END finish_page;
+
+ define_command: PROCEDURE(name,value) RETURNS(BIT);
+ DCL (name,value) CHAR(*);
+ DCL p PTR;
+ DCL (nl,vl) FIXED;
+
+ nl = length(name);
+ vl = length(value);
+ IF udcaptr+nl+vl > udcsize THEN RETURN(false);
+ DO p = udclist REPEAT p -> udcr.next WHILE (p ^= Null());
+ IF name = substr(udcarea,p -> udcname,p -> udcnamelen)
+ THEN GOTO found;
+ END;
+ ALLOCATE udcr SET (p);
+ p -> udcr.next = udclist;
+ udclist = p;
+ p -> udcname = udcaptr;
+ udcaptr = udcaptr+nl;
+ p -> udcnamelen = nl;
+ substr(udcarea,p -> udcname,p -> udcnamelen) = name;
+ p -> udcvaluelen = 0;
+ p -> udcvalue = udcaptr;
+ found:
+ IF vl = 0 THEN RETURN(true);
+ /* IF possible fit command in existing area */
+ IF vl >= p -> udcvaluelen
+ THEN DO;
+ p -> udcvalue = udcaptr;
+ udcaptr = udcaptr+vl;
+ END;
+ p -> udcvaluelen = vl;
+ substr(udcarea,p -> udcvalue,p -> udcvaluelen) = value;
+ RETURN(true);
+
+ END define_command;
+
+ read_inline: PROCEDURE;
+
+ ON ENDFILE (incfile) BEGIN;
+ CLOSE FILE (incfile);
+ reading_from_incfile = false;
+ IF incsave = '' THEN GOTO once_again;
+ ELSE DO;
+ inline = incsave;
+ GOTO return_label;
+ END;
+ END;
+
+ once_again:
+ IF reading_from_incfile THEN GET EDIT (inline) (A(511))
+ FILE(incfile);
+ ELSE GET EDIT (inline) (A(511)) FILE(inf);
+
+ return_label:
+ RETURN;
+
+ END read_inline;
+
+ move_forward: PROCEDURE (dist);
+ DCL (dist,i) FIXED;
+ DCL sdist CHAR(12) VARYING;
+
+ sdist = esc || '[' || cvis(dist) || 'a';
+
+ IF pbufi+length(sdist) >= pbufsize THEN DO;
+ PUT SKIP EDIT('LN03Topp capacity exceeded: ' ||
+ 'too much stuff on one page.') (A);
+ GOTO abort_job;
+ END;
+ DO i = 1 TO length(sdist);
+ pbuf(pbufi+i-1) = substr(sdist,i,1);
+ END;
+ pbufi = pbufi+length(sdist);
+
+ END move_forward;
+
+ new_chunk: PROCEDURE;
+
+ IF free_chunk_list = Null() THEN DO;
+ ALLOCATE chunk SET (curchunk);
+ chunkmax = chunkmax+1;
+ END; ELSE DO;
+ curchunk = free_chunk_list;
+ free_chunk_list = free_chunk_list -> chunk.next;
+ END;
+ curchunk -> chunk.fs = curf;
+ curchunk -> chunk.next = chls(ypos);
+ chls(ypos) = curchunk;
+ chunkcnt = chunkcnt+1;
+ ftime(txf2lnf(curf)) = chunkcnt;
+
+ END new_chunk;
+
+END ln03topp;