(* --- rnf2 --- *) procedure GetNum(var SignValue: sign; var NumberValue: integer); const SMnestMax = 5; var EndOfSyl: boolean; SylCharIndex: integer; CurChar, LookAheadChar: char; SubMacStackIndx: integer; SMstack: array [1 .. SMnestMax] of record TextPtr: integer; SMmac: pmac; end; PROCEDURE NextChar; BEGIN CurChar := ' '; if SubMacStackIndx = 0 then with syl do begin ExprErr := ExprErr or EndOfSyl; IF SylCharIndex <= LEN THEN begin CurChar := LIN[SylCharIndex]; SylCharIndex := SylCharIndex + 1; end ELSE EndOfSyl := true; end else begin with SMstack[SubMacStackIndx] do with SMmac^ do begin if TextPtr <= MacroEnd then begin CurChar := StgTable[TextPtr]; TextPtr := TextPtr + 1 end; end; end; END (*NextChar*); FUNCTION Expression: INTEGER; VAR EXPR1, EXPR2: integer; EXPR3: boolean; EXPROP: RELOPR; function number: integer; var ival: integer; begin ival := 0; while (CurChar in ['0' .. '9']) and (ival < DangerPoint) do begin ival := ival * 10 + (ord(CurChar) - ord('0')); NextChar end; if CurChar in ['0' .. '9'] then if (ord(CurChar) - ord('0')) > maxint mod 10 then error(58) (* number too big *) else begin ival := ival * 10 + (ord(CurChar) - ord('0')); NextChar; if CurChar in ['0' .. '9'] then error(58) (* number too big *); end; while CurChar in ['0' .. '9'] do NextChar; number := ival; end; function character: integer; var cval: char; begin NextChar (* skip quote *); cval := CurChar; ExprErr := false; if CurChar = '''' then begin (* handle quotes as characters *) NextChar; ExprErr := CurChar <> ''''; end; NextChar; ExprErr := ExprErr or (CurChar <> ''''); NextChar; if ExprErr then begin error(59) (* bad character constant *); cval := '?'; ExprErr := false; end; character := ord(cval); end; FUNCTION TERM: INTEGER; var term1, term2: integer; tch: char; function item: integer; var ItemSign: (none, negative, positive, LogicalNot); item1: integer; FUNCTION VARIABLE: INTEGER; VAR V: ALFA; I: INTEGER; VNDX1, VNDX2: 0 .. VARMAX; VAR1: INTEGER; BEGIN NextChar; V := AlfaBlanks; I := 0; WHILE ForceUpperCase(CurChar) IN ['A' .. 'Z', '$', '0' .. '9'] DO BEGIN I := I + 1; IF I <= AlfaLen THEN V[I] := ForceUpperCase(CurChar); NextChar; END; VAR1 := 0; IF I = 0 THEN ExprErr := TRUE ELSE BEGIN VID[TV] := V; VNDX1 := 1; VNDX2 := 0; WHILE VID[VNDX1] <> V DO VNDX1 := VNDX1 + 1; IF VNDX1 <> TV THEN BEGIN IF (VTY[VNDX1] = VARRAY) AND (CurChar = '[') THEN BEGIN NextChar; VNDX2 := TERM; IF CurChar <> ']' THEN ExprErr := TRUE ELSE NextChar; IF (VNDX2 < 0) OR (VNDX2 > VUP[VNDX1]) THEN BEGIN Error(4) (* Error - ARRAY INDEX OUT OF BOUNDS *); VNDX2 := 0 END; END; IF CurChar = '=' THEN BEGIN NextChar; VAL[VNDX1 + VNDX2] := TERM; END; VAR1 := VAL[VNDX1 + VNDX2]; END ELSE begin VarName := V; Error(55) (* UNDEFINED VARIABLE: $V*); end; END; VARIABLE := VAR1; END (*VARIABLE*); FUNCTION SUBMACRO: INTEGER; VAR SaveCurChar: char; SUBMAC: PMAC; MACNAME: alfa; NAMINDX: integer; EXITFLAG: BOOLEAN; BEGIN MACNAME := AlfaBlanks; NextChar; NAMINDX := 0; while CurChar = macchr do begin (* pick up leading macchrs *) namindx := namindx + 1; if namindx <= alfalen then macname[namindx] := CurChar; NextChar; end; while CurChar in ['A' .. 'Z', 'a' .. 'z', '0' .. '9'] do begin namindx := namindx + 1; if namindx <= alfalen then macname[namindx] := ForceUpperCase(CurChar); NextChar; end; SUBMAC := MACLSTP; EXITFLAG := FALSE; REPEAT IF SUBMAC = NIL THEN EXITFLAG := TRUE ELSE IF SUBMAC ^.NM = MACNAME THEN EXITFLAG := TRUE ELSE SUBMAC := SUBMAC ^.MA; UNTIL EXITFLAG; IF TestOk((SUBMAC <> NIL), 1) (* Error - UNRECOGNIZED SUB-MACRO NAME *) THEN if TestOk(not submac^.on, 2) (* Error - recursive sub-macro *) then if SubMacStackIndx < SMnestMax then begin SaveCurChar := CurChar; SubMacStackIndx := SubMacStackIndx + 1; with SMstack[SubMacStackIndx], submac^ do begin (* stack SUB-MACRO VALUE *) on := true; SMmac := submac; TextPtr := MacroBegin; NextChar; LookAheadChar := StgTable[TextPtr]; submacro := Expression; on := false; end; SubMacStackIndx := SubMacStackIndx - 1; CurChar := SaveCurChar; END; END (* SUBMACRO *); BEGIN (* item *) ItemSign := none; IF CurChar = '-' THEN ItemSign := negative ELSE IF CurChar = '#' THEN ItemSign := LogicalNot ELSE IF CurChar = '+' THEN ItemSign := positive; if ItemSign <> none then NextChar; ITEM1 := 0; IF CurChar = varchr THEN ITEM1 := VARIABLE ELSE IF CurChar = macchr THEN ITEM1 := SUBMACRO ELSE IF CurChar IN ['0' .. '9'] THEN item1 := number else if CurChar = '''' then item1 := character ELSE ExprErr := TRUE; CASE ItemSign OF none, positive:; negative: ITEM1 := - ITEM1; LogicalNot: item1 := BoolOrd(item1 = 0) END; ITEM := ITEM1; END (*ITEM*); BEGIN (* term *) TERM1 := 0; IF CurChar = '(' THEN BEGIN NextChar; TERM1 := TERM; IF CurChar <> ')' THEN ExprErr := TRUE ELSE NextChar; END ELSE IF CurChar IN ITEMSET THEN BEGIN TERM1 := ITEM; WHILE CurChar IN ['+', '-'] DO BEGIN TCH := CurChar; NextChar; TERM2 := 0; IF CurChar IN ITEMSET THEN TERM2 := ITEM ELSE IF CurChar = '(' THEN TERM2 := TERM; IF TCH = '+' THEN TERM1 := TERM1 + TERM2 ELSE TERM1 := TERM1 - TERM2; END; END; TERM := TERM1; END (*TERM*); FUNCTION RELOP: RELOPR; VAR OP: ALFA; ROP: RELOPR; BEGIN OP := AlfaBlanks; NextChar; OP[1] := ForceUpperCase(CurChar); NextChar; OP[2] := ForceUpperCase(CurChar); NextChar; IF CurChar = '.' THEN NextChar; ARELOPR[BADRELOP] := OP; ROP := EQ; WHILE (ARELOPR[ROP] <> OP) DO ROP := SUCC(ROP); IF (ROP = BADRELOP) THEN Error(5) (* UNRECOGNIZED RELATIONAL OPERATOR *); RELOP := ROP; END (*RELOP*); BEGIN (* expression *) EXPR1 := 0; IF (CurChar = varchr) AND (LookAheadChar = '(') THEN NextChar; IF CurChar IN TERMSET THEN BEGIN EXPR1 := TERM; IF CurChar = '.' THEN BEGIN EXPROP := RELOP; EXPR2 := 0; IF CurChar IN TERMSET THEN EXPR2 := TERM; CASE EXPROP OF EQ: expr3 := EXPR1 = EXPR2; GT: expr3 := EXPR1 > EXPR2; LT: expr3 := EXPR1 < EXPR2; NE: expr3 := EXPR1 <> EXPR2; GE: expr3 := EXPR1 >= EXPR2; LE: expr3 := EXPR1 <= EXPR2; BADRELOP: EXPR3 := false; END; EXPR1 := BoolOrd(EXPR3); END end; Expression := EXPR1; END (*Expression*); BEGIN (* GetNum *) SubMacStackIndx := 0; EndOfSyl := false; SylCharIndex := 1; NextChar; IF CurChar = '+' THEN SignValue := plus ELSE IF CurChar = '-' THEN SignValue := minus ELSE SignValue := UnSigned; if SignValue <> UnSigned then NextChar; LookAheadChar := Syl.LIN[SylCharIndex]; ExprErr := false; NumberValue := Expression; if CurChar = ';' then begin ShowExpr := false; NextChar; end else ShowExpr := true; while (CurChar = ' ') and not EndOfSyl do NextChar; IF ExprErr or not EndOfSyl then begin SignValue := invalid; Error(6) (* ERROR IN EXPRESSION *); end; END (*GetNum*); PROCEDURE PSHENV; BEGIN SAVENV(ENSTK[ENP]); ENP := ENP + BoolOrd(TestOk((ENP <> MAXENP), 7)); (* Error - TOO MANY P OR LIST LEVELS *) END (*PSHENV*); PROCEDURE POPENV; BEGIN ENP := ENP - BoolOrd(TestOk((ENP <> 0), 8)); (* Error - TOO MANY POPS *) RESENV(ENSTK[ENP]); END (*POPENV*); PROCEDURE DOJUST(VAR L: LINE; VAR F: JUSLIN; RIGHT: BOOLEAN); VAR LineIndex: integer; I, J, K, N, M: LLEN; BEGIN WITH L, F DO BEGIN IF LEN > 2 THEN IF XTRABL THEN BEGIN LEN := LEN - 1 END; IF (NOT CENTER) AND (NDX > 1) AND (LEN <= VAL[VRM] + 1) THEN BEGIN I := NDX; J := VAL[VRM]; N := (VAL[VRM] - LEN + 1) DIV (NDX - 1); M := (VAL[VRM] - LEN + 1) MOD (NDX - 1); LEN := J + 1; FOR K := NDX DOWNTO 2 DO BEGIN FOR LineIndex := POS[K] DOWNTO POS[K - 1] + 1 DO BEGIN LIN[J] := LIN[LineIndex]; OverLin[J] := OverLin[LineIndex]; BoldFlag[j] := BoldFlag[LineIndex]; USflag[j] := USflag[LineIndex]; J := J - 1 END; FOR LineIndex := 1 TO N DO BEGIN LIN[J] := ' '; OverLin[J] := ' '; BoldFlag[j] := false; USflag[j] := false; J := J - 1 END; IF RIGHT THEN BEGIN IF (NDX - K) <= M THEN BEGIN LIN[J] := ' '; OverLin[J] := ' '; BoldFlag[j] := false; USflag[j] := false; J := J - 1 END END ELSE IF (K - 2) <= M THEN BEGIN LIN[J] := ' '; OverLin[J] := ' '; BoldFlag[j] := false; USflag[j] := false; J := J - 1 END END END END END (*DOJUST*); PROCEDURE STARTLINE; BEGIN if RightSpace > 0 then write(outfile,' ':RightSpace); if bar then if otl.bbar then write(outfile, '| ') else write(outfile,' ':3); END (*STARTLINE*); PROCEDURE DOTOP; var i: integer; BEGIN if HandFeed then begin write(' Type return when paper is ready >'); readln; end else if InitialPageEject then IF NOPAGE THEN FOR i := VAL[VOLNO] TO OEPAG DO writeln(outfile) ELSE PAGE(OUTFILE); InitialPageEject := true; { subsequent pages always eject } VAL[VOLNO] := 1; STARTLINE; OVETXT := OETXT - 1; OVBTXT := 0; IF NOT HOLDBB THEN BEGIN HOLDBB := BB; BB := FALSE; END; END (*DOTOP*); PROCEDURE DOBOT; var i: integer; BEGIN FOR i := VAL[VOLNO] TO OETXT DO writeln(outfile); VAL[VOLNO] := OETXT + 1; OVETXT := 32000; HOLDBB := BB; END (*DOBOT*); PROCEDURE PUTBLANK(count: integer); var i: integer; BEGIN IF VAL[VOLNO] > OVBTXT THEN for i := 1 to count do IF VAL[VOLNO] <= OVETXT + 1 THEN BEGIN VAL[VOLNO] := VAL[VOLNO] + 1; if Bar then if Otl.BBar then begin if RightSpace > 0 then write(outfile,' ':Rightspace); write(outfile, '| '); end; writeln(outfile); END; END (*PUTBLANK*); PROCEDURE WRITEOTL; VAR i, LineIndex: integer; LastPos, CENTS: INTEGER; BoldStarted, UscoreStarted : Boolean; BEGIN (*WRITEOTL*) WITH OTL DO BEGIN LEN := LEN - BoolOrd(Len > 0); if center then CENTS := ((VAL[VRM] - VAL[VLM]) DIV 2) - ((LEN - VAL[VLM]) DIV 2) else cents := 0; IF NOT UL THEN FOR LineIndex := 1 TO LEN DO BEGIN LIN[LineIndex] := ForceUpperCase(LIN[LineIndex]); OverLin[LineIndex] := MakeUpper[OverLin[LineIndex]]; END; STARTLINE; if cents > 0 then write(outfile,' ':cents); LastPos := len; while (LastPos > 1) and (Lin[LastPos] = ' ') do LastPos := LastPos - 1; if val[VANSI] = 1 then begin { This code is for any ANSI output device } { it can be used for screen previews of underlining and bold } { on VT100 or on the IBM-PC if the ANSI driver is loaded. } { To enable it, put $$ANSI=1 in your input text file. } BoldStarted := false; UScoreStarted := false; for i := 1 to Lastpos do begin if UScoreStarted and (not USFlag[i]) or BoldStarted and (not BoldFlag[i]) then begin { ANSI turns off both at once } write (outfile, chr(27),'[0m'); UScoreStarted := false; BoldStarted := false; end; if (not BoldStarted) and BoldFlag[i] then begin write (outfile, chr(27),'[1m');{ turn on bold mode } BoldStarted := true; end; if (not UScoreStarted) and USFlag[i] then begin write (outfile, chr(27),'[4m'); UScorestarted := true; end; write (outfile, lin[i]); { now write the character } end; { finished with character writing, turn off attributes } if UScoreStarted or BoldStarted then begin write (outfile, chr(27),'[0m'); UScoreStarted := false; BoldStarted := false; end; end else begin { non-ANSI device, overprint for bold and underline } WritePAOC(Lin, Lastpos); if HasBoldPrinting then begin for LineIndex := 1 to len do if BoldFlag[LineIndex] then LastPos := LineIndex else Lin[LineIndex] := ' '; for i := 1 to 2 {number of overwrites} do begin write(outfile, chr(val[vcr])); STARTLINE; if cents > 0 then write(outfile,' ':cents); WritePAOC( Lin, LastPos); end; end; if HasOverPrinting then begin write(outfile, chr(val[vcr])); STARTLINE; if cents > 0 then write(outfile,' ':cents); LastPos := len; while (LastPos > 1) and (OverLin[LastPos] = ' ') do LastPos := LastPos - 1; WritePAOC( OverLin, Lastpos); end; if HasUnderScore then begin write(outfile, chr(val[vcr])); STARTLINE; if cents > 0 then write(outfile,' ':cents); for LineIndex := 1 to len do if USflag[LineIndex] then begin Lin[LineIndex] := '_'; LastPos := LineIndex; end else Lin[LineIndex] := ' '; WritePAOC( Lin, LastPos); end; end; writeln(outfile); { finished with complete line } END END (*WRITEOTL*); PROCEDURE DOMID; VAR i: integer; DOFIG: BOOLEAN; PROCEDURE MIDRESTORE; BEGIN CLRLINE; IF PAGOTL THEN BEGIN OTL := PAGSAV; WRITEOTL; VAL[VOLNO] := VAL[VOLNO] + 1; PAGOTL := FALSE; CLRLINE; END; BB := HOLDBB; HOLDBB := FALSE; END (*MIDRESTORE*); BEGIN OVBTXT := VAL[VOLNO]; DOFIG := TRUE; IF FIGP > 0 THEN WHILE DOFIG DO IF FIGN[FIGP] <= OVETXT - OVBTXT + 1 THEN BEGIN FOR i := 1 TO FIGN[FIGP] DO BEGIN writeln(outfile); VAL[VOLNO] := VAL[VOLNO] + 1; END; FIGP := FIGP - 1; IF FIGP = 0 THEN DOFIG := FALSE; END ELSE DOFIG := FALSE; MIDRESTORE; END (*DOMID*); PROCEDURE PUTLINE; BEGIN IF (NOT SUP) AND (NOT EMPTY) THEN BEGIN IF (VAL[VOLNO] + BoolOrd(pushed) > OVETXT + 1) THEN BEGIN PAGSAV := OTL; PAGOTL := TRUE; PushText(DefrFrcPgMacP); END ELSE BEGIN PUSHED := FALSE (* NO PAGE THROW *); VAL[VOLNO] := VAL[VOLNO] + 1; RIGHT := NOT RIGHT; WRITEOTL; END END; PUTBLANK(DEFRB); CLRLINE; END (*PUTLINE*); PROCEDURE PUSHSYL(VAR Asyl: LINE); FORWARD; PROCEDURE TESTPAGE(N: INTEGER; SaveSyl: boolean); BEGIN IF (N * VAL[VSP]) - 1 > (OVETXT - VAL[VOLNO] + 1) THEN BEGIN if SaveSyl then PushSyl(Syl); PushText(DefrFrcPgMacP); END; END (*TESTPAGE*); PROCEDURE PARAGRAPH; var indent: integer; BEGIN RIGHT := TRUE (* RESET ALTERNATING FILL *); PUTBLANK(PARSPACE * VAL[VSP]); WITH OTL DO BEGIN IF PREL THEN IF VAL[VLM] + PMAR > 0 THEN indent := VAL[VLM] + PMAR ELSE indent := 1 ELSE indent := PMAR; LEN := indent; {} if len = 0 then len := 1; FOR indent := 1 TO LEN DO LIN[indent] := ' '; END; RIGHT := TRUE; TESTPAGE(PARTEST, true); END (*PARAGRAPH*); PROCEDURE MARKJUST(N: LLEN); BEGIN WITH JUST DO BEGIN NDX := NDX + 1; POS[NDX] := N END END (*MARKJUST*); PROCEDURE ADDWORD; VAR TAB, J, LineIndex: INTEGER; procedure CopyDown(OffSet: integer); var i, indx: integer; begin with tmpl do FOR i := LEN DOWNTO 1 DO BEGIN indx := i + OffSet; LIN[indx] := LIN[i]; OverLin[indx] := OverLin[i]; USflag[indx] := USflag[i]; BoldFlag[indx] := BoldFlag[i]; END; end; FUNCTION GETTAB(X: INTEGER): INTEGER; var TabLoc: integer; BEGIN TabLoc := 1; TABS[TABMAX] := X; WHILE TABS[TabLoc] < X DO TabLoc := TabLoc + 1; JUST.NDX := 0; RT := FALSE; T := FALSE; GETTAB := TABS[TabLoc]; END (*GETTAB*); BEGIN WITH OTL DO BEGIN IF (XTEND) AND (JUST.NDX > 0) THEN BEGIN JUST.NDX := JUST.NDX - 1; CopyDown(LASTSLEN); FOR LineIndex := 1 TO LASTSLEN DO BEGIN J := LineIndex + LASTLEN - 1; TMPL.LIN[LineIndex] := LIN[J]; TMPL.OverLin[LineIndex] := OverLin[J]; TMPL.USflag[LineIndex] := USflag[J]; tmpl.BoldFlag[LineIndex] := BoldFlag[J]; END; TMPL.LEN := TMPL.LEN + LASTSLEN; LEN := LASTLEN; FOR LineIndex := 1 TO SYL.LEN DO ADDSYL.LIN[LineIndex + ADDSYL.LEN] := SYL.LIN[LineIndex]; ADDSYL.LEN := ADDSYL.LEN + SYL.LEN END ELSE ADDSYL := SYL; XTEND := FALSE; TAB := 0; IF RT THEN TAB := GETTAB(LEN + TMPL.LEN - 1) - TMPL.LEN + 1 ELSE IF T THEN TAB := GETTAB(LEN); WHILE LEN < TAB DO BEGIN IF DOT AND (NOT (LEN = TAB - 1)) THEN LIN[LEN] := '.' ELSE LIN[LEN] := ' '; OverLin[LEN] := ' '; LEN := LEN + 1; END; IF (LEN + TMPL.LEN - 1 > VAL[VRM]) AND (NOT EMPTY) THEN BEGIN IF JUSTIT THEN DOJUST(OTL, JUST, RIGHT); PUSHED := TRUE; PUSHSYL(ADDSYL) (* SAVE THE CURRENT SYMBOL *); PushText(CarRtnMacP) (* AND FORCE THE END OF LINE*); PUTLINE; PUSHED := FALSE; END ELSE BEGIN EMPTY := FALSE; FOR LineIndex := 1 TO TMPL.LEN DO LIN[LEN + LineIndex - 1] := TMPL.LIN[LineIndex]; HasOverPrinting := tmpl.HasOverPrinting or HasOverPrinting; if tmpl.HasOverPrinting then for LineIndex := 1 to tmpl.len do OverLin[LEN + LineIndex - 1] := tmpl.OverLin[LineIndex]; HasUnderScore := tmpl.HasUnderScore or HasUnderscore; if tmpl.HasUnderScore then for LineIndex := 1 to tmpl.len do USflag[Len + LineIndex - 1] := tmpl.USflag[LineIndex]; HasBoldPrinting := tmpl.HasBoldPrinting or HasBoldPrinting; if tmpl.HasBoldPrinting then for LineIndex := 1 to tmpl.len do BoldFlag[Len + LineIndex - 1] := tmpl.BoldFlag[LineIndex]; LASTLEN := LEN; LASTSLEN := TMPL.LEN; LEN := LEN + TMPL.LEN; MARKJUST(LEN - 1); IF NOT SIGBL THEN BEGIN LIN[LEN] := ' '; LEN := LEN + 1; IF PQEND THEN BEGIN LIN[LEN] := ' '; LEN := LEN + 1 END; XTRABL := PQEND END; END; END; END (*ADDWORD*); PROCEDURE ADDCHR(C: CHAR); BEGIN WITH OTL DO BEGIN LIN[LEN] := C; LEN := LEN + 1; END; END (*ADDCHR*); PROCEDURE ADDNUM(N: INTEGER; VAR LocOTL: LINE); PROCEDURE ADDCHROTL(C: CHAR); BEGIN WITH LocOTL DO BEGIN LIN[LEN] := C; LEN := LEN + 1; END; END (*ADDCHR*); PROCEDURE ADDN(N: INTEGER); BEGIN IF N >= 10 THEN ADDN(N DIV 10); ADDCHROTL(CHR((N MOD 10) + ORD('0'))); END (*ADDN*); BEGIN IF N < 0 THEN BEGIN ADDCHROTL('-'); ADDN(- N) END ELSE ADDN(N); END (*ADDNUM*); PROCEDURE UNFLAG(VAR L: LINE; LOWER: BOOLEAN); VAR LineIndex: integer; FUP: 0 .. 3; RCHN: LLEN; OVER: BOOLEAN; PROCEDURE OUT(C: CHAR); BEGIN RCHN := RCHN + 1; with tmpl do begin LIN[RCHN] := C; OverLin[RCHN] := ' '; if UNDL then begin HasUnderScore := true; USflag[RCHN] := true; end; if bold then if c <> ' ' then begin HasBoldPrinting := true; BoldFlag[RCHN] := true; end; end; LineIndex := LineIndex + 1; END (*OUT*); BEGIN (*UNFLAG*) RCHN := 0; with tmpl do begin HasBoldPrinting := false; HasOverPrinting := false; HasUnderScore := false; BoldFlag := EmptyFlags; USflag := EmptyFlags; end; WITH L DO BEGIN FUP := 0 (* NO CASE FORCING *); LineIndex := 1; PQEND := FALSE; if len < linlen then lin[len+1] := ' '; WHILE LineIndex <= LEN DO BEGIN IF NOT (LIN[LineIndex] IN ['''', '"', ')']) THEN PQEND := FALSE; CASE CharCategory[LIN[LineIndex]] OF UpArrow: BEGIN IF FLAG AND (LineIndex < LEN) THEN IF CharCategory[LIN[LineIndex + 1]] IN [ucLetter, lcLetter] THEN BEGIN LineIndex := LineIndex + 1; CASE FUP OF 0, 1: LIN[LineIndex] := MAKEUPPER[LIN[LineIndex]]; 2: LIN[LineIndex] := MAKELOWER[LIN[LineIndex]] END END; OUT(LIN[LineIndex]); END; ucLetter: begin if (FUP = 2) or ((FUP = 0) and LOWER) then repeat lin[LineIndex] := MakeLower[LIN[LineIndex]]; out(lin[LineIndex]) until not (CharCategory[LIN[LineIndex]] in [ucLetter, lcLetter]) else repeat out(lin[LineIndex]) until (CharCategory[LIN[LineIndex]] <> ucLetter); end; lcLetter: begin if (FUP = 1) or ((FUP = 0) and NOT LOWER) then repeat lin[LineIndex] := MakeUpper[LIN[LineIndex]]; out(lin[LineIndex]) until not (CharCategory[LIN[LineIndex]] in [ucLetter, lcLetter]) else repeat out(lin[LineIndex]) until (CharCategory[LIN[LineIndex]] <> lcLetter); end; LeftAngle: begin IF FLAGCAPS THEN BEGIN FUP := FUP + 1; IF FUP = 3 THEN FUP := 1; LineIndex := LineIndex + 1; END else out(lin[LineIndex]); end; EndSentence: begin IF PERIOD THEN PQEND := TRUE; OUT(LIN[LineIndex]); end; UnderScore: begin LineIndex := LineIndex + BoolOrd(ESCCHR); OUT(LIN[LineIndex]); end; NumberSign: begin IF FLAGSIG THEN BEGIN OVER := UNDL; UNDL := UNDL AND USB; OUT(' '); UNDL := OVER; END else out(lin[LineIndex]); end; BackSlash: begin IF FLAGOVER THEN BEGIN LineIndex := LineIndex + 1; tmpl.HasOverPrinting := true; tmpl.OverLin[rchn] := Lin[LineIndex]; LineIndex := LineIndex + 1; END else OUT(LIN[LineIndex]); end; MiscChar: begin IF NOT (UL OR LOWER) THEN LIN[LineIndex] := MAKEUPPER[LIN[LineIndex]]; OUT(LIN[LineIndex]); end; ArithChar: OUT(LIN[LineIndex]); OtherChar: LineIndex := LineIndex + 1 END; END; TMPL.LEN := RCHN; END; END (*UNFLAG*); PROCEDURE ROMAN(N: INTEGER); var i, j: integer; BEGIN j := 1; if n <= 10000 then for i := 1 to 13 do begin while n >= RomanValue[i] do with syl do begin len := len + 1; lin[len] := RomanChars[j]; lin[len+1] := RomanChars[j+1]; len := len + BoolOrd(RomanChars[j+1] <> ' '); n := n - RomanValue[i]; end; j := j + 2; end; END (*ROMAN*); PROCEDURE DOFMT(F, N: INTEGER); var savesc: boolean; BEGIN SYL.LEN := 0; savesc := escchr; escchr := true; IF (F >= 0) AND (F <= 4) THEN CASE F OF 0: BEGIN SYL.LEN := 1; ADDNUM(N, SYL); SYL.LEN := SYL.LEN - 1; UNFLAG(SYL, FALSE); END; 1: BEGIN SYL.LEN := 2; SYL.LIN[1] := '_'; SYL.LIN[2] := chr(N) ; { Cyber was CHR(N MOD CHRMOD) } END; 2: BEGIN SYL.LEN := 2; SYL.LIN[1] := '_'; SYL.LIN[2] := chr(N) ; { Cyber did lower case shift } END; 3, 4: ROMAN(N); END; IF SYL.LEN > 0 THEN begin UNFLAG(SYL, (F = 4)); ADDWORD; end; escchr := savesc; END (*DOFMT*); PROCEDURE BREAK; BEGIN PUTLINE; END (*BREAK*); PROCEDURE CR; BEGIN PUTBLANK(VAL[VSP] - 1) END (*CR*); PROCEDURE ENDPARA; BEGIN BREAK; CR; END (*ENDPARA*); PROCEDURE BLANKLINE; BEGIN IF (NOT AP) THEN BEGIN ENDPARA; PUTBLANK(1) END ELSE PushText(ParagMacP); END (*BLANKLINE*); PROCEDURE ENDLINE; BEGIN IF SUP THEN CLRLINE; IF FORCE OR (NOT FILL) OR OTL.CENTER THEN ENDPARA; END (*ENDLINE*); PROCEDURE FIN; BEGIN PUTLINE; DOTOP; END (*FIN*); PROCEDURE PUTWORD; BEGIN UNFLAG(SYL, LOWER); ADDWORD; END (*PUTWORD*); PROCEDURE PUTVAR; VAR N: INTEGER; S: SIGN; BEGIN GETNUM(S, N); IF S <> INVALID THEN BEGIN IF SHOWEXPR THEN BEGIN SYL.LEN := 1; ADDNUM(N, SYL); SYL.LEN := SYL.LEN - 1; PUTWORD; END END ELSE PUTWORD; END (*PUTVAR*);