perm filename FILLER.SAI[PUB,TES]2 blob
sn#072561 filedate 1973-11-15 generic text, type T, neo UTF8
00100 ENTRY TEXTLINE ;
00200 BEGIN "FILLER"
00300
00400 DEFINE TERNAL = "EXTERNAL" , PRELOAD = "COMMENT" ;
00500 REQUIRE "PUBDFS.SAI" SOURCE_FILE ;
00600 REQUIRE "PUBMAI.SAI" SOURCE_FILE ;
00700 BEGIN "INNER BLOCK"
00800 REQUIRE "PUBINR.SAI" SOURCE_FILE ;
00900 REQUIRE "PUBPRO.SAI" SOURCE_FILE ;
01000
01100 comment, the following EXTERNAL SIMPLE PROCEDUREs are INTERNAL in PARSER.SAI ;
01200
01300 EXTERNAL STRING SIMPLE PROCEDURE RD(INTEGER BRKTBL) ;
01400
01500 EXTERNAL RECURSIVE STRING PROCEDURE PASS ;
01600
01700 EXTERNAL RECURSIVE STRING PROCEDURE E(STRING DEFAULT, STOPWORD) ;
01800
01900 EXTERNAL STRING SIMPLE PROCEDURE VEVAL ;
02000
02100 EXTERNAL STRING SIMPLE PROCEDURE EVALV(STRING THISWD ; INTEGER IX, TYP) ;
02200
02250 EXTERNAL SIMPLE PROCEDURE SWITCHFONT(INTEGER WHICH) ; TES 11/15/73 ;
02275
02300 FORWARD RECURSIVE PROCEDURE BOUND(INTEGER KIND) ;
00100 COMMENT T H E L I N E F I L L E R
00200
00300 These routines build a first pass output line in string OWL
00400 and then call the line placer (PLACELINE()) to place it in an area.
00500 OWL is kept lengthy enough to hold any first pass output line.
00600 That way, a line can be constructed by IDPB'ing (with APPEND())
00700 inside OWL instead of by numerous concatenations.
00800 Characters in OWL[1 TO OAKS] belong to the current line being
00900 built. However, some of these characters describe FONT changes or
01000 forward label references and others mark word breaks or CR to the
01100 left margin for superimposing. Thus, the line reaches only to
01200 column POSN (relative to the left edge of the area), and FAKE of
01300 these columns are not occupied but are only allocated for forward
01400 references. Furthermore, in FILL mode, the last permissible point
01500 after which the line can be broken by a CrLf is marked by four
01600 variables: BRKPT, BRKPOSN, BRKSPCS, and BRKFAKE, which contain the
01700 values of OAKS, POSN, and FAKE at that point, and the number of
01800 delible spaces right after that point. Though there is normally a
01900 WDBRK character at the breakpoint, there may be none if it is the
02000 first breakpoint on the line or if it was caused by a hyphen.
02100 TEXTLINE sets up the input stream for processing by PROCESS.
02200 PROCESS scans it up to a {, cr, or altmode, obeying all control
02300 characters and EMITting all regular characters. EMIT calls APPEND
02400 after checking for line overflow, etc. Spaces are PROCESSed
02500 differently -- instead of calling EMIT to APPEND them immediately,
02600 EMSPACES is called, which just counts up spaces in SPCS and handles
02700 COMPACTion and punctuation problems. Thus, when EMIT is called, it
02800 must append SPCS spaces before appending its argument. ;
02900
03000 SIMPLE PROCEDURE APPEND(STRING CHARS) ;
03100 IF ON THEN
03200 BEGIN "APPEND"
03300 STRING D ; INTEGER CCT, BALANCE ;
03400 DEFINE SRC="'15", COUNT="'14", DEST="'13", CHAR="'11" ;
03500 CCT ← LENGTH(CHARS) ;
03600 IF (BALANCE ← LENGTH(OWL) - (OAKS+CCT)) < 0 THEN
03700 OWL ← OWL & SPS((1-BALANCE)*2) ;
03800 IF CCT > 0 THEN
03900 BEGIN
04000 LABEL IUD ; COMMENT DEPOSIT LOOP ;
04100 D ← OWL[OAKS+1 FOR 1] ;
04200 START_CODE "APPD"
04300 MOVE SRC, CHARS ;
04400 HRRZ COUNT, CCT ;
04500 ADDM COUNT, OAKS ;
04600 MOVE DEST, D ;
04700 IUD: ILDB CHAR, SRC ;
04800 IDPB CHAR, DEST ;
04900 SOJG COUNT, IUD ;
05000 END "APPD"
05100 END ;
05200 END "APPEND" ;
00100 INTERNAL STRING SIMPLE PROCEDURE LABELREF(INTEGER USYMB, LEN) ;
00200 IF ¬ON THEN RETURN(NULL) ELSE
00300 BEGIN "LABELREF"
00400 INTEGER PTR, PLIGHT, WASSYMB ; STRING S ;
00500 IF NULSTR(THISWD) THEN ie, Generated Label for {PAGE⎇. USYMB=0.;
00600 PTR ← (PLBL ← PUTI(1, PLBL)) LOR TWO(14) ie Add to Linked List ;
00700 ELSE IF BYTEWD ← NUMBER[ PTR ← SYMNUM(THISWD & ":") ] THEN
00800 BEGIN "KNOWN LABEL"
00900 CASE (PLIGHT ← LDB(PLIGHTWD(BYTEWD))) MOD 3 OF
01000 BEGIN COMMENT BY PLIGHT ;
01100 ie 0 or 3 ... Page Label still Uncertain ; WASSYMB ← SYMPAGE ;
01200 ie 1 ... Referenced but not defined ; WASSYMB ← LDB(IXWD(BYTEWD)) ;
01300 ie 2 ... Defined and Certain ;
01400 BEGIN
01500 BREAKSET(LOCAL_TABLE,ALTMODE,"IS");
01600 BREAKSET(LOCAL_TABLE,NULL,"O");
01700 S ← STBL[LDB(IXWD(BYTEWD))] ;
01800 RETURN (SCAN(S,LOCAL_TABLE,DUMMY));
01900 END;
02000 END ; COMMENT BY PLIGHT ;
02100 IF USYMB AND LDB(IXN(USYMB)) ≠ LDB(IXN(WASSYMB)) THEN
02200 BEGIN "DIFFERENT UNIT"
02300 IF WASSYMB THEN WARN("X-REF ERROR","Label "&SYM[PTR]&
02400 " was cross-referenced as a "&SYM[WASSYMB]&
02500 " earlier, but now as a "&SYM[USYMB]) ;
02600 IF PLIGHT = 1 THEN NUMBER[PTR] ← 1 ROT -2 LOR USYMB ;
02700 END "DIFFERENT UNIT" ;
02800 END "KNOWN LABEL"
02900 ELSE NUMBER[PTR] ← 1 ROT -2 LOR USYMB ;
03000 RETURN(RUBOUT & CVS(LEN) & VT & CVS(PTR) & VT) ;
03100 END "LABELREF" ;
03200
03300 SIMPLE PROCEDURE PICKFONT(INTEGER F) ; TES 11/15/73 ;
03400 APPEND(FONTCHAR&"F"&(IF F<10 THEN (F+"0") ELSE (F+("A"-10))));
00100 SIMPLE PROCEDURE OKSP(BOOLEAN EVEN_BEFORE_LMARG) ;
00200 IF LASTWDBRK ≠ OAKS AND ON AND
00300 JUSTIFY AND (POSN<MAXIM OR XCRIBL) AND (EVEN_BEFORE_LMARG OR POSN > 0 MAX INDENT) THEN
00400 BEGIN APPEND(WDBRK) ; LASTWDBRK ← OAKS ; END ;
00500
00600 SIMPLE PROCEDURE OKCR(BOOLEAN EVEN_IN_SUPERSUBSCRIPT) ;
00700 IF BRKPT≠OAKS AND ON AND (SUPERSUB=0 OR EVEN_IN_SUPERSUBSCRIPT) THEN
00800 BEGIN
00900 BRKPT ← OAKS ; BRKPOSN ← POSN ; BRKFAKE ← FAKE ; BRKPLBL ← PLBL ; BRKSPCS ← 0 ;
01000 BRKXPOSN ← XPOSN - FSHORT ;
01100 IF SUPERSUB THEN RETURN ;
01200 BRKABX ← BRKABX MAX ABOVEX ; BRKBLX ← BRKBLX MIN BELOWX ; ABOVEX←BELOWX←0 ;
01300 END "OKCR" ;
01400
01500 INTERNAL INTEGER SIMPLE PROCEDURE XLENGTH(STRING CHARS);
01600 BEGIN "XL"
01700 INTEGER COUNT;
01800 IF NOT XCRIBL THEN RETURN(0); COMMENT IF NOT IN XCRIBL MODE THEN WE DON'T NEED THIS VALUE;
01900 COUNT←0;
02000 WHILE FULSTR(CHARS) DO
02100 COUNT ← COUNT + CW[LOP(CHARS)];
02200 RETURN (COUNT);
02300 END;
02400
02500 INTEGER SIMPLE PROCEDURE XSPLEN(INTEGER N);
02600 RETURN(N * CW[SP]);
02700
02800 RECURSIVE PROCEDURE EMIT(STRING CHARS) ;
02900 IF ON THEN
03000 BEGIN
03100 INTEGER NCHARS, EXCHARS, WASBRC ; STRING EXCESS ; LABEL ADDIT ; comment Sorry about that ;
03200 INTEGER XCHARL,XSPCL,XEXCHARS; RKJ;
03300 NCHARS ← LENGTH(CHARS) ;
03400 XCHARL ← XLENGTH(CHARS); RKJ;
03500 XSPCL ← XSPLEN(SPCS) ; RKJ;
03600 RKJ: OLD LINE IF POSN + SPCS + NCHARS ≤ MAXIM THEN comment, no overfow ;
03700 IF (IF XCRIBL THEN (XPOSN+XSPCL+XCHARL≤(MAXIM*CHARW)) ELSE (POSN+SPCS+NCHARS≤MAXIM)) THEN comment no overflow;
03800 ADDIT:
03900 BEGIN
04000 IF SPCS AND XCRIBL AND (FILL AND ADJUST) AND POSN>INDENT THEN
04100 BEGIN FSHORT←FSHORT+XSPLEN(1); SPCS←SPCS-1 END;
04200 IF SPCS THEN BEGIN APPEND(SPS(SPCS)) ; BRKSPCS ← SPCS END ;
04300 APPEND(CHARS) ; POSN ← POSN + SPCS + NCHARS ; SPCS ← 0 ;
04400 XPOSN ← XPOSN + XSPCL + XCHARL; RKJ;
04500 END
04600 ELSE IF FILL AND (BRKPT>INDENT OR BRKPOSN>INDENT) THEN comment, go back to a break point ;
04700 BEGIN
04800 IF BRKPT=OAKS THEN BEGIN XSPCL ← SPCS ← EXCHARS ← 0 ; EXCESS ← NULL END
04900 ELSE BEGIN EXCESS←OWL[BRKPT+1+BRKSPCS TO OAKS]; COPY(EXCESS);
05000 XEXCHARS ← XPOSN-FSHORT-BRKXPOSN-BRKSPCS*XSPLEN(1);
05100 EXCHARS←POSN-BRKPOSN-BRKSPCS END;
05200 FAKE ← FAKE - BRKFAKE ; NOPGPH ← -1 ; WASBRC ← BRC ;
05300 OAKS ← BRKPT ; BOUND(3) ; COMMENT ADDED 4/14/72 ;
05400 PLACELINE(IF OWL[OAKS FOR 1]=WDBRK ∧ LASTWDBRK=OAKS COMMENT JAN 9 73 ;
05500 THEN OAKS-1 ELSE OAKS, BRKPOSN MIN MAXIM, BRKXPOSN,
05600 BRKFAKE, BRKABX, -BRKBLX, IF FIRST THEN LEADFM ELSE SPREADM-1,
05700 BRKPLBL, ADJUST, SPREADM) ;
05800 FSHORT ← NOPGPH ← OAKS ← TABI ← BRKABX ← BRKBLX ← STARPOSN ← AMPPOSN ← LASTWDBRK ← 0 ; BRC←WASBRC;
05900 IF FIRST THEN BEGIN
06000 INDENT ← RESTIM MAX -LMARG ; FIRST ← FALSE ;
06100 END ;
06120 IF XCRIBL
06140 THEN
06160 BEGIN
06170 PICKFONT(THISFONT) ; TES 11/15/73 ;
06180 IF (LMARG+INDENT)≠0 THEN APPEND(FONTCHAR&"="&CVSR("CHARW*(LMARG+INDENT)"));
06200 XPOSN←CHARW*INDENT;
06220 END
06240 ELSE
06260 BEGIN
06280 APPEND(SPS(LMARG+INDENT));
06300 END;
06320 POSN←INDENT; OKCR(TRUE);
06340 IF UNDERLINING THEN APPEND(FONTCHAR&"_");
06360 APPEND(EXCESS);
06380 POSN←POSN+EXCHARS; XPOSN←XPOSN+XEXCHARS;
06600 IF SPCS THEN BEGIN OKSP(FALSE) ; OKCR(FALSE) END ;
06700 GO TO ADDIT ;
06800 END
06900 ELSE IF POSN≤MAXIM THEN comment, About to overflow right edge of area! ;
07000 BEGIN
07100 APPEND((SPS(SPCS)&CHARS)[1 TO MAXIM - POSN]) ;
07150 IF XCRIBL AND FONTFIL[DEFAULTFONT]=0 THEN TES 11/15/73;
07170 WARN("=", "FONT declaration needed. Start over!")
07190 ELSE
07200 WARN("Line too long","Line too long -- characters lost:"&CHARS[MAXIM-POSN+1 TO ∞]&"...") ;
07300 POSN ← MAXIM+1 ; SPCS ← 0 ;
07400 XPOSN ← XMAXIM + 1; RKJ;
07500 END ;
07600 MIDWORD ← MIDWORD OR FULSTR(CHARS) ; PUNC ← FALSE ;
07700 END "EMIT" ;
00100 INTEGER XLBFAKE; RKJ: FOR FORWARD REFERENCES IN BOUNDED ITEMS ;
00200 RECURSIVE PROCEDURE BOUND(INTEGER KIND) ;
00300 IF ON THEN
00400 BEGIN
00500 INTEGER LB, RB, DEST, FILLIN, XLB, XFILLIN ;
00600 LABEL SLIDEFILL, TABFILL, TABCASE ; STRING FILLER, BOUNDS ;
00700 STRING SEGMENT ;
00800 COMMENT KIND ≤ 0 ... ∞X (The ASCII of X negated)
00900 = 1 ... ←
01000 = 2 ... →
01100 = 3 ... CR or BREAK
01200 = 4 ... Tab (\ or ∂) ;
01300 IF KIND=3 OR KIND=4 AND NULSTR(LBF) THEN SPCS ← 0 ELSE EMIT(NULL) ;
01400 OKCR(TRUE) ; comment added 4/17/72 ;
01500 Comment An earlier BOUND on this line may have set LBK←KIND ;
01600 IF LBK < 3 THEN CASE LBK MAX 0 OF
01700 BEGIN COMMENT BY KIND ;
01800 ie ≤ 0 ... ∞ Only valid if immediately preceding this Bound ;
01900 IF LBO < OAKS ∨ SPCS THEN
02000 BEGIN
02100 WARN("=","∞ needs a right bound") ;
02200 LBF ← NULL ;
02300 END ;
02400 ie = 1 ... ← Center between left bound at POSN=LBP and this TAB to RBOUND, or between margins ;
02500 BEGIN "CENTER"
02600 IF KIND=4 THEN BEGIN XLB←XLBP ; LB←LBP ; RB←RBOUND END
02700 ELSE BEGIN LB←XLB←0 ; RB←RMARG-LMARG END ;
02800 BOUNDS ← CVSR("(LMARG+RB)*(IF XCRIBL THEN CHARW ELSE 1)") & CVSR("(LMARG+LBP-LB)*(IF XCRIBL THEN CHARW ELSE 1)");
02900 FILLIN ← ((RB - POSN) - (LBP - LB)) DIV 2 ; COMMENT UPPER BOUND ESTIMATE ;
03100 SLIDEFILL:
03150 XFILLIN ← XPOSN - XLBP -(FAKE-XLBFAKE) ; COMMENT LENGTH OF PIECE ;
03200 SEGMENT ← OWL[LBO+1 TO OAKS] ; COPY(SEGMENT) ; OAKS ← LBO ; FILLER ← OLBF ;
03300 TABFILL:
03400 APPEND(FONTCHAR & "→") ; APPEND(BOUNDS) ;
03500 IF XCRIBL THEN
03550 BEGIN
03575 RKJ ; APPEND(CVSR(XFILLIN)) ;
03587 TES ; APPEND(CVSR("(FILLIN*CHARW)/XLENGTH(FILLER)")) ;
03593 END ;
03600 APPEND(FILLER & ALTMODE) ;
03700 APPEND(SEGMENT) ; APPEND(FONTCHAR & "←") ;
03800 POSN ← POSN + (FILLIN MAX 0) ;
03900 XPOSN ← XPOSN + (XFILLIN MAX 0) ;
04000 END "CENTER" ;
04100 ie 2 ... → Right flush against TAB to RBOUND or against right margin ;
04200 BEGIN "RIGHT FLUSH"
04300 RB ← IF KIND=4 THEN RBOUND ELSE RMARG-LMARG ;
04400 FILLIN ← RB - POSN ;
04500 BOUNDS ← CVSR("(LMARG+RB)*(IF XCRIBL THEN CHARW ELSE 1)") & CVSR("(IF XCRIBL THEN (-CHARW*1000) ELSE -1000)") ;
04700 GO TO SLIDEFILL ;
04800 END "RIGHT FLUSH" ;
04900 END ; COMMENT BY KIND ;
05000 IF KIND=3 ∧ FULSTR(LBF) THEN BEGIN RBOUND ← RMARG ; GO TO TABCASE END ;
05100 IF KIND=4 THEN
05200 BEGIN "TAB"
05300 IF FULSTR(LBF) THEN
05400 TABCASE: BEGIN
05600 FILLIN ← RBOUND - POSN ; BOUNDS ← CVSR(LMARG+RBOUND) & CVSR(-1000) ;
05700 FILLER ← LBF ; SEGMENT ← NULL ; KIND ← KIND + 2 ; GO TO TABFILL ;
05800 END
05900 ELSE APPEND(FONTCHAR&"="&CVSR("IF XCRIBL THEN CHARW*(RBOUND+LMARG) ELSE RBOUND+LMARG"));
05950 BRKXPOSN←BRKXPOSN+FSHORT; FSHORT←0;
06000 POSN ← RBOUND ; XPOSN ← RBOUND * CHARW ;
06100 END "TAB" ;
06200 IF KIND > 4 THEN KIND ← KIND - 2 ; COMMENT CORRECTS `KIND←KIND+2' ABOVE ↑↑↑↑↑↑↑ ;
06300 IF KIND = 4 AND POSN > MAXIM THEN MAXIM ← NMAXIM+LMARG
06400 ELSE IF FILL THEN MAXIM ← IF KIND ≤ 2 THEN NMAXIM ELSE FMAXIM ;
06500 IF KIND = 3 THEN LBP ← LBO ← 0 ELSE
06600 BEGIN
06700 comment Finally, set Left Bound for a subsequent BOUND ;
06800 LBO ← OAKS ; LBP ← POSN ; XLBP ← XPOSN ; LBK ← KIND ; MIDWORD ← FALSE ;
06900 XLBFAKE ← FAKE ;
07000 CASE ((KIND+1) MAX 0) DIV 2 OF BEGIN LBF←LBF&(-KIND) ; BEGIN OLBF←LBF ; LBF←NULL END ; OLBF←LBF←NULL END ;
07100 END ;
07200 END "BOUND" ;
00100 INTERNAL RECURSIVE PROCEDURE DBREAK ;
00200 IF ON THEN IF NOPGPH THEN NOPGPH ← -1 ELSE
00300 BEGIN INTEGER STTS ;
00400 NOPGPH ← -1 ;
00500 BOUND(3) ;
00600 IF POSN > INDENT OR VERBATIM THEN
00700 BEGIN "A PGPH"
00800 PLACELINE(IF LASTWDBRK=OAKS THEN OAKS-1 ELSE OAKS, POSN MIN MAXIM, MAXIM*CHARW-FSHORT,
00900 FAKE, ABOVEX MAX BRKABX,
01000 -(BELOWX MIN BRKBLX),
01100 IF NOFILL THEN LEADNM ELSE IF FIRST THEN LEADFM ELSE SPREADM-1,
01200 PLBL, IF XCRIBL AND ADJUST THEN TRUE ELSE JUSTJUST, 0) ;
01300 FSHORT ← SINCELFM ← 0 ;
01400 IF ENDCASE=2 THEN BEGIN STTS←STARTS; IF ENDBLOCK THEN WARN("=","Missed END in Response|Footnote");
01500 STARTS ← STARTS + STTS ; END ;
01600 END "A PGPH" ;
01700 END "DBREAK" ;
01800
01900 SIMPLE PROCEDURE EMSPACES(INTEGER N) ;
02000 IF ON THEN BEGIN
02100 IF SPCS=0 THEN BEGIN OKSP(FALSE) ; OKCR(FALSE) END ; MIDWORD ← FALSE ;
02200 SPCS ← IF COMPACT THEN (SPCS+N) MIN (IF PUNC THEN 2 ELSE 1) ELSE SPCS+N ;
02300 END "EMSPACES" ;
02400
02500 RECURSIVE PROCEDURE TABTO(INTEGER POSNO) ;
02600 IF ON THEN
02700 IF FULSTR(LBF) TES 11/1/73; AND (IF XCRIBL THEN (POSNO*CHARW ≤ XPOSN) ELSE (POSNO≤POSN))
02800 THEN WARN("=","Already passed tab column " & CVS(POSNO))
02900 ELSE IF POSNO>NMAXIM+LMARG AND NOT XCRIBL THEN
03000 WARN("=","No such tab column "&(IF POSNO>TWO(15) THEN NULL ELSE CVS(POSNO)))
03100 ELSE
03200 BEGIN
03300 RBOUND ← POSNO-1 ;
03400 IF TRUE COMMENT NOFILL ; THEN BOUND(4)
03500 ELSE BEGIN
03600 APPEND(FONTCHAR&"="&CVSR("IF XCRIBL THEN CHARW*(RBOUND+LMARG) ELSE RBOUND+LMARG"));
03700 POSN←RBOUND;
03800 END ;
03900 END "TABTO" ;
04000
04100 RECURSIVE BOOLEAN PROCEDURE ATLEAD(INTEGER LEADSPACES) ;
04200 BEGIN
04300 IF FINDINSET(LEADSPACES) AND FULSTR("SSTK[BODY(LLTHIS)]")THEN RESPOND(LLTHIS)
04400 ELSE RETURN(FALSE) ;
04500 RETURN(TRUE) ;
04600 END "ATLEAD" ;
04700
04800 BOOLEAN SIMPLE PROCEDURE SIGNA(INTEGER SIGCH1) ;
04900 BEGIN
05000 INTEGER ARG, RIX, ARGS, SEPS ; STRING SEE ;
05100 SEE ← SIGCH1 & INPUTSTR ;
05200 LLSCAN(SIGNALD[SIGCH1], NEXT_RESP, "CVASC(SEE[1 FOR CLUE(LLTHIS)])=SIGNAL(LLTHIS)") ;
05300 IF LLTHIS = 0 THEN RETURN(FALSE) ; RIX ← LLTHIS ; ARGS ← NUMARGS(RIX) ;
05400 INPUTSTR ← INPUTSTR[CLUE(RIX) TO ∞] ;
05500 IF ARGS THEN BEGIN "SCAN ARGS"
05600 SEPS ← RESP_SEP(RIX) ; IF LAST + ARGS > SIZE THEN GROWNESTS ;
05700 FOR ARG ← 1 THRU ARGS DO
05800 BEGIN "SEPBREAK"
05900 SETBREAK(LOCAL_TABLE,
06000 (SEPS LSH ((ARG-ARGS)*7) LAND '177) & CRLF, NULL, "IS") ;
06100 SEE ← NULL ;
06200 DO BEGIN
06300 SEE ← SEE & RD(LOCAL_TABLE) ;
06400 IF BRC = CR THEN
06500 BEGIN
06600 IF FULSTR("RD(TO_NON_SP)") ∨ BRC≠RCBRAK
06700 ∨ INPUTSTR[2 FOR 1]≠VT THEN DONE ;
06800 LOPP(INPUTSTR) ; LOPP(INPUTSTR) ; IF FULSTR(SEE) THEN SEE ← SEE & SP ;
06900 END
07000 ELSE BRC ← -1 ;
07100 END UNTIL BRC < 0 ;
07200 SNEST[LAST + ARG] ← SEE ;
07300 IF BRC > 0 THEN
07400 BEGIN
07500 WARN("=","Missing Signal Separator") ;
07600 FOR ARG ← ARG+1 THRU ARGS DO SNEST[LAST+ARG] ← NULL ;
07700 END ;
07800 END "SEPBREAK" ;
07900 IF ON THEN LAST ← LAST + ARGS ; COMMENT "IF" JAN 9 1973 ;
08000 END "SCAN ARGS" ;
08100 RESPOND(RIX) ; RETURN(TRUE) ;
08200 END "SIGNA" ;
00100 SIMPLE PROCEDURE UNSCRIPT(INTEGER ARROW) ;
00200 BEGIN
00300 INTEGER CHR, PN ; BOOLEAN MORE, WILLRIPT ;
00400 IF ARROW = 0 THEN
00500 BEGIN COMMENT "]" -- find matching "[" ;
00600 ARROW ← SUPERSUB LAND '177 ;
00700 AMPPOSN ← AMPPOSN LSH -9 ; COMMENT 3/28/72 ;
00800 SUPERSUB ← SUPERSUB LSH -9 ;
00900 END ;
01000 IF POSN ≤ MAXIM OR XCRIBL THEN
01100 BEGIN
01200 EMIT(NULL) ;
01300 IF ARROW ≠ "." THEN
01400 BEGIN
01500 APPEND(FONTCHAR & ("↑"+"↓" - ARROW)) ;
01600 HEIGHT ← HEIGHT - (IF ARROW="↑" THEN 1 ELSE -1) ;
01700 END ;
01800 END ;
01900 WILLRIPT ← TRUE ; comment assume that RIPTPOSNS will be updated by SCRIPT if necessary ;
02000 IF LDB(SPCODE(INPUTSTR)) = AMSAND THEN
02100 BEGIN
02200 LOPP(INPUTSTR) ;
02300 MORE ← TRUE ; PN ← RIPTPOSNS LAND '177 - LMARG ; COMMENT 3/28/72: ;
02400 AMPPOSN ← ((AMPPOSN LSH -9) LSH 9) LOR ((AMPPOSN LAND '177) MAX POSN) ;
02500 IF PN<POSN THEN BEGIN APPEND(FONTCHAR&"-"&CVSR(POSN-PN)) ; POSN←PN END ;
02600 IF (CHR ← LDB(SPCODE(INPUTSTR))) = LBRACK THEN
02700 BEGIN
02800 SUPERSUB ← SUPERSUB LSH 9 LOR "." ;
02900 LOPP(INPUTSTR) ; WILLRIPT ← FALSE ; comment not a ript: won't call SCRIPT! ;
03000 END
03100 ELSE IF CHR≠UARROW AND CHR≠DARROW THEN BEGIN EMIT(LOP(INPUTSTR)) ; MORE ← FALSE END ;
03200 END
03300 ELSE MORE ← FALSE ;
03400 IF ¬MORE THEN BEGIN COMMENT 3/28/72: ;
03500 PN ← (AMPPOSN LAND '177) MAX POSN ; AMPPOSN ← (AMPPOSN LSH -9) LSH 9 ;
03600 IF PN>POSN THEN BEGIN APPEND(FONTCHAR&"+"&CVSR(PN-POSN)) ; POSN←PN END END ;
03700 IF WILLRIPT THEN RIPTPOSNS ← RIPTPOSNS LSH -9 ;
03800 END "UNSCRIPT" ;
03900
04000 SIMPLE PROCEDURE SCRIPT(INTEGER ARROW) ;
04100 BEGIN
04200 INTEGER CHR ;
04300 CHR ← LOP(INPUTSTR) ;
04400 HEIGHT ← HEIGHT + (IF ARROW="↑" THEN 1 ELSE -1) ;
04500 ABOVEX ← ABOVEX MAX HEIGHT ; BELOWX ← BELOWX MIN HEIGHT ;
04600 IF POSN ≤ MAXIM OR XCRIBL THEN BEGIN EMIT(NULL) ; APPEND(FONTCHAR&ARROW) ; END ;
04700 RIPTPOSNS ← RIPTPOSNS LSH 9 LOR (POSN+LMARG) ;
04800 IF LDB(SPCODE(CHR))=LBRACK THEN BEGIN SUPERSUB ← SUPERSUB LSH 9 LOR ARROW ;
04900 AMPPOSN ← AMPPOSN LSH 9 ; COMMENT 3/28/72 ; END
05000 ELSE BEGIN EMIT(CHR) ; UNSCRIPT(ARROW) END ;
05100 END "SCRIPT" ;
00100 RECURSIVE PROCEDURE PROCESS ;
00200 BEGIN
00300 INTEGER N, CHR, F, INSET ; BOOLEAN PLUS, DONE ; STRING PIECE ; LABEL ENDERLINE ;
00400 EMPTYTHIS ; INSET ← 0 ;
00500 IF INPUTSTR = VT THEN IF ¬ON THEN LOPP(INPUTSTR) ELSE
00600 BEGIN "NEW INPUT LINE"
00700 LOPP(INPUTSTR) ;
00800 IF VERBATIM THEN BEGIN END
00900 ELSE IF INPUTSTR=CR ∧ (N←SIGNALD[CR]) THEN BEGIN LOPP(INPUTSTR) ; RESPOND(N) ; RETURN END
01000 ELSE IF ATLEAD(INSET ← LENGTH(RD(TO_NON_SP))) THEN INSET←0 ; comment AT NULL , AT <integer> ;
01100 END "NEW INPUT LINE" ;
01200 IF NOPGPH ∧ ON THEN ie, First line of paragraph ;
01300 BEGIN "START PARAGRAPH"
01400 OAKS←SPCS←TABI←PUNC←MIDWORD←SUPERSUB←ABOVEX←BELOWX←HEIGHT←FAKE←BRKABX←BRKBLX←UNDERLINING←0 ;
01500 FIRST ← NOFILL ∨ NOPGPH<0 ; STARPOSN←AMPPOSN←LASTWDBRK←0 ;
01600 INDENT ← IF FLUSHL∨VERBATIM∨CENTER∨FLUSHR THEN 0
01700 ELSE (IF NOFILL OR FIRST THEN FIRSTIM ELSE RESTIM) MAX -LMARG ;
01800 NOPGPH ← 0 ; LBK ← 3 ; LBF ← NULL ;
01810 IF XCRIBL
01820 THEN
01830 BEGIN
01835 PICKFONT(THISFONT) ; TES 11/15/73 ;
01840 IF (LMARG+INDENT)≠0 THEN APPEND(FONTCHAR&"="&CVSR("CHARW*(LMARG+INDENT)"));
01850 XPOSN←CHARW*INDENT;
01860 END
01870 ELSE
01880 BEGIN
01890 APPEND(SPS(LMARG+INDENT));
01900 END;
01910 POSN←INDENT; FSHORT←0; OKCR(TRUE);
02100 IF FLUSHR THEN BOUND(2) ELSE IF CENTER THEN BOUND(1) ;
02200 FMAXIM ← (RMARG-RIGHTIM)-LMARG ;
02300 NMAXIM ← COLWID(IF AREAIXM THEN AREAIXM ELSE IXTEXT) - LMARG ;
02400 MAXIM ← IF FILL THEN FMAXIM ELSE NMAXIM ;
02500 IF VERBATIM THEN BEGIN JUSTIFY←FALSE; EMIT(RD(TO_CR_SKIP)); DBREAK ; RETURN END ;
02600 END "START PARAGRAPH" ;
02700 JUSTIFY ← FILL∧ADJUST ∨ JUSTJUST ; DONE ← FALSE ; IF INSET∧RETAIN∧¬FLUSHL THEN EMSPACES(INSET) ;
02800 DO BEGIN "SCAN TEXT"
02900 IF FULSTR("PIECE ← RD(TEXT_TBL)") THEN EMIT(PIECE) ;
03000 IF BRC≠CR ∧ SIGNALD[BRC] ∧ SIGNA(BRC) THEN BEGIN COMMENT Responded to signal ; END
03100 ELSE CASE CHARTBL[BRC] LAND '77 OF
03200 BEGIN COMMENT BY BRC ;
03300 ie 0 ; EMIT(BRC) ;
03400 ie 1 ... CR ; BEGIN SUPERSUB←HEIGHT←AMPPOSN←RIPTPOSNS←0 ;
03500 IF FILL ∧ CRSPACE THEN EMSPACES(IF SPCS ∨ ¬POSN THEN 0 ELSE IF PUNC THEN 2 ELSE 1)
03600 ELSE IF IMPOSE THEN
03700 BEGIN "SUPERIMPOSE"
03800 IF (N ← SINCELFM+1) > TWEENLFM THEN DBREAK
03900 ELSE BEGIN EMIT(NULL); APPEND(CR & SPS(LMARG+(POSN←INDENT))); SINCELFM ← N ;
04000 TABI←MIDWORD←STARPOSN←FAKE←0 ; LBK←3; LBF←NULL; OKCR(FALSE) END ;
04100 END "SUPERIMPOSE"
04200 ELSE DBREAK ;
04300 DONE ← TRUE ;
04400 END ;
04500 ie 2 ... Altmode or { ; DONE ← TRUE ;
04600 ie 3 ... Rubout;IF ON THEN
04700 BEGIN "LABEL REF"
04800 N ← CVD(SCAN(INPUTSTR,TO_VT_SKIP,F)) ;
04810 IF XCRIBL THEN
04820 BEGIN
04830 EMIT(S←"01234567890123456789012345678901234567890123456789"[1 FOR N]);
04840 FAKE←FAKE+XLENGTH(S);
04850 END
04860 ELSE
04870 BEGIN
04880 EMIT(SPS(N)); FAKE←FAKE+N;
04890 END;
04895 OAKS←OAKS-N;
04900 APPEND(VT&SCAN(INPUTSTR, TO_VT_SKIP, F)&ALTMODE) ;
05000 END "LABEL REF"
05100 ELSE FOR N ← 1,2 DO SCAN(INPUTSTR, TO_VT_SKIP, F) ;
05200 ie 4 ... α ; IF INPUTSTR≠ALTMODE THEN IF (N←LOP(INPUTSTR))=CR THEN DONE←TRUE
05300 ELSE BEGIN "CHKXGP"
05400 IF XCRIBL THEN
05500 IF (F←LDB(SPCODE(N))) = XCMDCHR
05600 THEN BEGIN EMIT(N); APPEND(N) END
05700 ELSE EMIT(N)
05800 ELSE EMIT(N);
05900 END "CHKXGP";
06000 ie 5 ... β ; IF FILL THEN OKCR(FALSE) ELSE EMIT(BRC) ;
06100 ie 6 ... # ; EMIT(SP) ;
00100 ie 7 ... \ ; IF ON THEN BEGIN "NEXT TAB"
00200 POSN←POSN+SPCS; XPOSN←XPOSN+XSPLEN(SPCS); SPCS←0;
00300 DO BEGIN TABI←TABI+1; N←TABSORT[TABI] END
00400 UNTIL (IF XCRIBL THEN N*CHARW>XPOSN ELSE N>POSN);
00500 TABTO(N) ; IF N > NMAXIM+LMARG THEN TABI ← TABI - 1 ;
00600 END "NEXT TAB" ;
00700 ie 8 ... ∂ ; IF (CHR←INPUTSTR)=CR ∨ CHR=ALTMODE ∨ NULSTR(INPUTSTR) THEN EMIT(BRC)
00800 ELSE BEGIN "SPECIFIC TAB"
00900 SPCS←0 ;
01000 CHR ← LOP(INPUTSTR) ;
01100 IF (PLUS ← CHR)="+" ∨ CHR="-" THEN CHR ← LOP(INPUTSTR) ELSE PLUS←0 ;
01200 IF CHR="(" THEN
01300 BEGIN
01400 PASS ; N ← CVD(E("0",0)) ;
01500 IF ¬ITSCH(")") THEN WARN("=","Missed ) after ∂(...") ;
01600 END
01700 ELSE IF (F←LDB(FAMILY(CHR)))=0 THEN N←
01800 CVD(EVALV(SYM[N←SYMNUM(CHR)], LDB(IXN(N)), LDB(TYPEN(N))))
01900 ELSE IF F = DIGQ THEN N ← CHR - 48 comment, Digit ;
02000 ELSE BEGIN WARN("=","Unintelligible ∂ Construct") ; N ← 0 END ;
02100 IF PLUS="-" THEN
02200 BEGIN "BACKSPACE"
02300 EMIT(NULL) ; STARPOSN ← POSN MAX STARPOSN ;
02400 IF XCRIBL THEN
02500 BEGIN
02600 APPEND(FONTCHAR&'35&LOP(INPUTSTR));
02700 IF N ≠ 1 THEN
02800 WARN("=","Can't backspace more than one!!");
02900 END
03000 ELSE
03100 BEGIN
03200 POSN ← POSN-N MAX 0 ;
03300 APPEND(FONTCHAR&PLUS&CVSR(N)) ;
03400 END;
03500 END
03600 ELSE IF PLUS="+" ∧ NULSTR(LBF) THEN
03700 BEGIN
03800 IF N>0 THEN BEGIN APPEND(FONTCHAR&"+"&CVSR(IF XCRIBL THEN N*CHARW ELSE N));
03900 POSN←POSN+N MIN NMAXIM+LMARG END;
04000 END
04100 ELSE TABTO((IF PLUS="*" THEN STARPOSN ELSE
04200 IF PLUS="+" THEN POSN+N ELSE N) MIN NMAXIM+LMARG) ;
04300 END "SPECIFIC TAB" ;
04400 ie 9 ... ← ; IF LBK ≠ 2 THEN BOUND(1) ELSE EMIT(BRC) ;
04500 ie 10 ... → ; IF LBK ≠ 2 THEN BOUND(2) ELSE EMIT(BRC) ;
04600 ie 11 ... ∞ ; IF (N←INPUTSTR)=CR ∨ N=ALTMODE THEN WARN("=","∞ What?")
04700 ELSE BOUND(-LOP(INPUTSTR)) ;
04800 ie 12 ... ↑ ; IF ON ∧ (CHR←INPUTSTR)≠CR ∧ CHR≠ALTMODE THEN SCRIPT("↑") ELSE EMIT(BRC) ;
04900 ie 13 ... ↓ ; IF ON THEN IF (CHR←INPUTSTR)=CR ∨ CHR=ALTMODE THEN EMIT(BRC)
05000 ELSE IF LDB(SPCODE(INPUTSTR))=UNDERBAR THEN
05100 BEGIN
05200 LOPP(INPUTSTR) ; EMIT(NULL) ;
05300 IF POSN≤MAXIM OR XCRIBL THEN BEGIN IF UNDERLINING=0 THEN APPEND(FONTCHAR&"_"); UNDERLINING←2 END ;
05400 END
05500 ELSE SCRIPT("↓") ;
05600 ie 14 ... ] ; IF SUPERSUB AND ON THEN UNSCRIPT(0)
05700 ELSE EMIT(BRC) ;
00100 ie 15 ... hyphen ; IF MIDWORD AND FILL AND ON AND ¬SUPERSUB THEN
00200 BEGIN
00300 EMIT("-") ; OKCR(FALSE) ;
00400 IF INPUTSTR=CR THEN BEGIN LOPP(INPUTSTR); DONE←TRUE END ;
00500 END
00600 ELSE BEGIN N←MIDWORD ; EMIT(BRC) ; MIDWORD ← N END ;
00700 ie 16 ... .!? ; IF MIDWORD∧FILL∧ON∧¬SUPERSUB THEN BEGIN EMIT(BRC) ; PUNC←TRUE END
00800 ELSE EMIT(BRC) ;
00900 ie 17 ... space ; EMSPACES(1 + LENGTH(RD(TO_NON_SP)) ) ;
01000 ie 18 ... underline ; IF LDB(SPCODE(INPUTSTR))=DARROW AND ON THEN
01100 BEGIN
01200 LOPP(INPUTSTR) ; EMIT(NULL) ;
01300 IF UNDERLINING THEN
01400 ENDERLINE: BEGIN
01500 UNDERLINING ← 0 ;
01600 IF POSN≤MAXIM OR XCRIBL THEN APPEND(FONTCHAR&"≡") ;
01700 END ;
01800 END
01900 ELSE BEGIN
02000 EMIT(NULL) ;
02100 IF POSN≤MAXIM OR XCRIBL THEN EMIT(BRC);
02200 COMMENT POSN< CHANGED TO POSN≤ ON 2/27/73 TES ;
02300 END ;
02400 ie 19 ... π ; BEGIN
02500 IF (CHR ← INPUTSTR) = "g" THEN CHR ← "G" ;
02600 IF CHR="G" ∨ CHR="." ∨ CHR="∂" ∨ CHR="+" ∨ CHR="-" ∨ CHR="~" THEN
02700 BEGIN
02800 EMIT(NULL) ;
02900 IF ON ∧ (POSN<MAXIM OR XCRIBL) THEN
03000 BEGIN APPEND(FONTCHAR&"π") ; EMIT(CHR) END ;
03100 LOPP(INPUTSTR) ;
03200 END
03300 ELSE EMIT(BRC) ;
03400 END ;
03500 ie 20 ... ∪ ; IF ON ∧ UNDERLINING=0 THEN
03600 BEGIN COMMENT ∪NDERLINE ONE WORD ;
03700 EMIT(NULL) ; UNDERLINING ← 1 ;
03800 IF POSN<MAXIM OR XCRIBL THEN APPEND(FONTCHAR & "_") ;
03900 IF FULSTR("PIECE←RD(ALPHA)") THEN EMIT(PIECE) ;
04000 GO TO ENDERLINE ;
04100 END ;
04200 ie 21 ... ∩ ; EMIT(BRC) ; COMMENT CURRENTLY NOT USED ;
04300 ie 22 ... VT ; WARN("=", "`⊃' SEEMS TO BE ON TEXT LINE IN MACRO") ;
04400 ie 23 ... $ ; IF LDB(SPCODE(INPUTSTR))=LBRACK THEN
04500 BEGIN LOPP(INPUTSTR) ; DONE←TRUE END ELSE BEGIN WARN("=","!!") ;EMIT(BRC) ; END ;
04600 ie 24 ... % ; IF ON THEN
04700 BEGIN "PERCENT"
04800 F←LOP(INPUTSTR);
04900 IF "1"≤F≤"9" THEN F←F-"0"
05000 ELSE IF "A"≤F≤"Z" THEN F←F-("A"-10)
05100 ELSE IF "a"≤F≤"z" THEN F←F-("a"-10)
05200 ELSE IF F="*" THEN F←OLDFONT
05300 ELSE BEGIN WARN("=","Illegal font `"&F&"'"); F←0 END;
05400 IF F>0 AND FONTFIL[F]=0 THEN
05500 BEGIN
05550 IF XCRIBL THEN TES 11/5/73 ;
05600 WARN("=","Unknown font `"&(IF F<10 THEN (F+"0") ELSE (F+("A"-10)))&"'");
05700 F←0;
05800 END;
06000 IF F AND XCRIBL THEN
06100 BEGIN
06200 EMIT(NULL);
06250 IF F NEQ THISFONT THEN PICKFONT(F) ;
06400 SWITCHFONT(F) ; TES 11/15/73 SUBROUTINIZED ;
06700 END;
06800 END;
06900 ie 25 ... ⊗ ; EMIT(BRC) ; comment PASS 3 control only, no action here ;
07000 ie 26 ... [ ; EMIT(BRC) ; comment just to be safe ;
07100 ie 27 ... & ; EMIT(BRC) comment just to be safe ;
07200 END ; COMMENT BY BRC ;
07300 END "SCAN TEXT" UNTIL DONE ;
07400 END "PROCESS " ;
00100 INTERNAL RECURSIVE BOOLEAN PROCEDURE TEXTLINE ;
00200 BEGIN
00300 PRELOAD_WITH 6, [8]0, 1, [2]0, 5, 0, 3, [4]4, [6]0, 4, 2, 4, 2, [2]0 ;
00400 OWN INTEGER ARRAY TEXTTYPE[-15:15] ;
00500 BOOLEAN IMITEXT ; INTEGER USYMB, LEN ; STRING STR ;
00600 IMITEXT ← TRUE ; comment assume computed text line ;
00700 CASE TEXTTYPE[THISTYPE] OF
00800 BEGIN COMMENT BY TYPE ;
00900 ie 0 ... Invalid ; RETURN(FALSE) ;
01000 ie 1 ... [ ; BEGIN comment [Est] Label or [@] rubout gen-label ; PASS ;
01100 IF ITS(@) THEN BEGIN PASS ; IMITEXT ← FALSE END
01200 ELSE BEGIN LEN ← CVD(E("5", 0)) ; COMMENT THANKS RKJ ;
01300 IF ITSCH("]") THEN PASS ELSE WARN("=","Missed ] after label length") ;
01400 THISWD ← LABELREF(0, LEN) ; END ;
01500 END ;
01600 ie 2 ... Unit ; IF THATISID THEN
01700 BEGIN comment Unit Label ;
01800 USYMB ← SYMB ;
01900 LEN ← IF THISTYPE=PUNITTYPE THEN PATT_CHRS(IX) ELSE CTR_CHRS(IX) ;
02000 PASS ; THISWD ← LABELREF(USYMB, LEN) ;
02100 END
02200 ELSE IF IX=IXPAGE THEN
02300 BEGIN comment, Generate a label ;
02400 THISWD ← NULL ;
02500 THISWD ← LABELREF(0, IF ITS(PAGE) THEN CTR_CHRS(IXPAGE) ELSE PATT_CHRS(IXPAGE)) ;
02600 END
02700 ELSE THISWD ← VEVAL ;
02800 ie 3 ... Constant ;
02900 BEGIN
03000 LOPP(THISWD) ;
03100 IF THATISID ∧ SIMLOOK(CAPITALIZE(STR←SCAN(THISWD,ALPHA,DUMMY)))
03200 ∧ (SYMTYPE = UNITTYPE ∨ SYMTYPE = PUNITTYPE) THEN
03300 BEGIN comment "Unit.." Label ;
03400 IF SYMTYPE=PUNITTYPE THEN STR←STR[1 TO ∞-1]; USYMB ← SYMBOL;
03500 LEN ← IF SYMTYPE=PUNITTYPE THEN PATT_CHRS(SYMIX) ELSE CTR_CHRS(SYMIX) ;
03600 PASS ; THISWD ← STR & SP & LABELREF(USYMB, LEN) ;
03700 END ;
03800 END ;
03900 ie 4 ... Variable ; THISWD ← VEVAL ;
04000 ie 5 ... ⎇ etc. ; IF IX comment not ⎇ ; THEN RETURN(FALSE) ELSE IMITEXT←FALSE ;
04100 ie 6 ... misc ; IF ITSCH("(") THEN BEGIN PASS; STR←E(NULL,NULL);
04200 IF ¬ITSCH(")") THEN WARN("=","Parens don't match") ; THISWD←STR END ELSE RETURN(FALSE) ;
04300 END ; COMMENT BY TYPE ;
04400 IF IMITEXT THEN IF NULSTR(THISWD) OR ¬ON THEN ELSE
04500 BEGIN
04600 BEGINBLOCK(FALSE, 0, "!NAKED") ;
04700 SWICH(THISWD&ALTMODE&" END ""!NAKED""", -1, 0) ;
04800 PROCESS ;
04900 END
05000 ELSE PROCESS ;
05100 PASS ;
05200 RETURN(TRUE) ;
05300 END "TEXTLINE" ;
00100 END "INNER BLOCK" ;
00200 END "FILLER"