diff options
author | Norbert Preining <norbert@preining.info> | 2019-09-02 13:46:59 +0900 |
---|---|---|
committer | Norbert Preining <norbert@preining.info> | 2019-09-02 13:46:59 +0900 |
commit | e0c6872cf40896c7be36b11dcc744620f10adf1d (patch) | |
tree | 60335e10d2f4354b0674ec22d7b53f0f8abee672 /dviware/ln03/rose/ln03topp.pli |
Initial commit
Diffstat (limited to 'dviware/ln03/rose/ln03topp.pli')
-rw-r--r-- | dviware/ln03/rose/ln03topp.pli | 1255 |
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; |