home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / cpm / turbopas / rnf-pas.lbr / RNF.PQS / RNF.PAS
Pascal/Delphi Source File  |  1986-07-16  |  15KB  |  481 lines
  1. PROGRAM RNF(INPUT, OUTPUT , INFILE, OUTFILE);
  2.  
  3. { RNF:  Text formatter for document prepartation.  }
  4. { Originally written for Cyber by Bob Foster at U. of Illinois.  This
  5.   version derives from Software Consulting Services production RNF
  6.   18-Dec-84 running on VAX VMS ver 4.  Enhancements to VAX version by
  7.   John McGrath.  This is a well-written program, easy to maintain,
  8.   adapt, and enhance; unfortunately there are few comments. }
  9. { Adapted to Turbo Pascal and Prospero Pro Pascal (only minor changes
  10.    required) by Willett Kempton, May 1985 and May 1986. }
  11. { Very few compiler or operating system dependencies are used, and this
  12.   program can easily be ported to most Pascal systems on most computers. }
  13. { Normally RNF is run directly to the printer; there has not been a serious
  14.   attempt at speed optimization since the printer limits run speed.  If
  15.   it is frequently used to write to files, it can be sped up by using
  16.   MOVE in place of DO loops in DOJUST and ADDWORD. }
  17.  
  18.  
  19. CONST
  20.   version = ' 7 June 86 ';
  21.   VPAGE = 1;
  22.   VCH = 2;
  23.   VHL = 3;
  24.   VLIST = 9;
  25.   (* NEXT IS 20 *)
  26.   VLM = 20;
  27.   VRM = 21;
  28.   VSP = 22;
  29.   VNMP = 23;
  30.   VOLNO = 24;
  31.   vcr = 25;
  32.   VANSI = 26;
  33.   NextVariable = 27;
  34.   (* NEXT IS 27 *)
  35.   VARMAX = 140;
  36.   MACCHR = '.';
  37.   VARCHR = '$';
  38.   CMDCHR = '.';
  39.   NOPAGE = FALSE;  { set true to make WRITELNs, not PAGE, do page eject }
  40.   TABMAX = 16;
  41.   LINLEN = 160;
  42.   MAXENP = 20;
  43.   HLMAX = 5;
  44.   CHRMOD = 128;
  45.   LowerCaseConvert = -32  (* ord('A') - ord('a') *);
  46.   FIGMAX = 10;
  47.   MaxParms = 8;
  48.   VHLMAX = 5;
  49.   MaxErrors = 63;
  50.   maxhash = 82;
  51.   AlfaBlanks = '          ';
  52.   AlfaLen = 10;
  53.   StackMax = 20;
  54.   StgTblSize = 10000;  { this may need to be smaller on CP/M-80 }
  55.   paocBUG = true; { true if "write(paoc:len);" does not work according to ISO }
  56.                   { false for Cyber, VMS, Prospero, true for Turbo and UCSD }
  57.  
  58. TYPE
  59.             alfa = PACKED ARRAY [1 .. AlfaLen] OF CHAR;
  60.         StgRange = 1  .. StgTblSize;
  61.           VARTYP = (VITEM, VARRAY);
  62.           RELOPR = (EQ, GT, LT, NE, GE, LE, BADRELOP);
  63.          ENRANGE = 0 .. MAXENP;
  64.             SIGN = (PLUS, MINUS, UNSIGNED, INVALID);
  65.           SYMTYP = (WORD, COMMAND, VARS, NONE);
  66.             LLEN = 0 .. LINLEN;
  67.            LALEN = 1 .. LINLEN;
  68.        LineFlags = packed array [llen] of boolean;
  69.           JUSLIN = RECORD
  70.                                  NDX: LLEN;
  71.                                  POS: ARRAY [LALEN] OF INTEGER
  72.                    END;
  73.            ALINE = PACKED ARRAY [LALEN] OF CHAR;
  74.             LINE = RECORD
  75.                                  LEN: LLEN;
  76.                                  LIN,
  77.                              OverLin: ALINE;
  78.                               CENTER,
  79.                                 BBAR: BOOLEAN;
  80.                      HasOverPrinting,
  81.                      HasBoldPrinting,
  82.                        HasUnderscore: boolean;
  83.                              USflag,
  84.                            BoldFlag: LineFlags;
  85.                    END;
  86.  
  87.           CMDTYP = (CBLANK, cinclude, CCR, CBREAK, CRESPAG, CRES, CESCCHR,
  88.                     CCENTER, CJUST, CUL, CLMAR, CRMAR, CFILL, CSIG, CPAGE,
  89.                     CSUP, CSTD, CPS, CSAV, CP, CPP, CAP, CI, CSP, CS, CTP,
  90.                     CCH, CHL, CNMP, CPNO, CTITLE, CST, CATITLE, CLIST,
  91.                     CLE, CELIST, CFIG, CBAR, CBB, CEB, CU, CT, CTAB,
  92.                     CTABS, CRT, CRIGHT, CLINES, CMACRO, CX, CVAR, CINC,
  93.                     CASIS, CDEC, (* END OF CMDTYP SET *) CFLAG, CBOLD,
  94.                     CCASEFLAG, CFLAGCAPS, CFLAGOVER, CFLAGSIG, CLOWER, CUPPER,
  95.                     CPERIOD, CSAVPAG, CFRCPAGE, CTOP, CMID, CBOT, CARRAY,
  96.                     CFMT, CIF, CDOT, CREM, CUPP, CUSB, NOTCMD);
  97.  
  98.          CharType = (UpArrow, ucLetter, lcLetter, LeftAngle, EndSentence,
  99.                      UnderScore, NumberSign, BackSlash, MiscChar, ArithChar,
  100.                      OtherChar);
  101.          CharRange = char;  { Prospero limits char to 0..127, thus to use }
  102.                             { full 8-bit set need   ChrRange = '00' .. 'FF' }
  103.          ENVIRON = RECORD
  104.                                    J,
  105.                                    F,
  106.                                   PR,
  107.                                   SG,
  108.                                   UN,
  109.                                   Bl: BOOLEAN;
  110.                                   PM,
  111.                                   SP: INTEGER;
  112.                                   LM,
  113.                                   RM,
  114.                                   PS,
  115.                                   PT: LLEN;
  116.                                   TB: PACKED ARRAY [1 .. TABMAX] OF LLEN
  117.                    END;
  118.           MACTYP = (HEADER, PARM);
  119.             PMAC = ^ MAC;
  120.  
  121.   StringLocation = -1 .. StgTblSize;
  122.  
  123.   StgDescription = record
  124.                      ActiveMacro: pmac;
  125.                      StgPosition,
  126.                         StgBegin,
  127.                           StgEnd: StringLocation;
  128.                    end;
  129.              MAC = RECORD
  130.                                ON: BOOLEAN;
  131.                                NM: alfa;
  132.                                MT: MACTYP;
  133.                                NP: 0 .. MaxParms;
  134.                        MacroBegin,
  135.                          MacroEnd: StringLocation;
  136.                                MA: PMAC;
  137.                    END;
  138.  
  139. {}{VAX} { string80 = packed array [1..80] of char;}
  140. {}{Turbo, Prospero } string80 = string[80];
  141.     OutflType = text;
  142.  
  143.  
  144. VAR
  145.            INFILE,
  146.          inclfile: text;
  147.           OUTFILE: OutFlType;
  148.  
  149. {}      InputName,
  150. {}       inclname: string80;
  151.           SYMTYPE: SYMTYP;
  152.        TopOfStack: integer;
  153.          StgStack: array [0 .. StackMax] of StgDescription;
  154.         StgMarker: integer  (*  free space pointer from end *);
  155.       FreeStgIndx: integer  (*  free space pointer from beginning *);
  156.          StgTable: packed array [StgRange] of char;
  157.               SYL,
  158.               OTL,
  159.              TMPL,
  160.            ADDSYL: LINE;
  161.          FREEMACP: PMAC;
  162.              CMDS: ARRAY [CMDTYP] OF alfa;
  163.           CMDTYPE: CMDTYP;
  164.           perfect: array [0 .. maxhash] of cmdtyp;
  165.        letperfect: array ['A' .. 'Z'] of integer;
  166.  
  167.  InitialPageEject,
  168.          HandFeed,
  169.                AP,
  170.              asis,
  171.            ATITLE,
  172.               BAR,
  173.                BB,
  174.              bold,
  175.          DoInclFl,
  176.            ESCCHR,
  177.              FILL,
  178.              FLAG,
  179.          FLAGCAPS,
  180.          FLAGOVER,
  181.           FLAGSIG,
  182.            HOLDBB,
  183.            JUSTIT,
  184.             LOWER,
  185.              PARA,
  186.            PERIOD,
  187.             PQEND,
  188.              PREL,
  189.             RIGHT,
  190.             SIGBL,
  191.               SUP,
  192.                UL,
  193.              UNDL,
  194.               USB,
  195.            XTRABL,
  196.               YES: Boolean;
  197.              
  198.              ILNO,
  199.            INCLNO,
  200.             OETXT,
  201.            OVETXT,
  202.             OEPAG,
  203.            OVBTXT,
  204.              PMAR: INTEGER;
  205.              
  206.              JUST: JUSLIN;
  207.             ENSTK: ARRAY [ENRANGE] OF ENVIRON;
  208.               ENP: ENRANGE;
  209.          PARSPACE,
  210.           PARTEST,
  211.           SPACING: INTEGER;
  212.            PAGENV: ENVIRON;
  213.             DEFRB: INTEGER;
  214.             FORCE,
  215.           FIRSTCH: BOOLEAN;
  216.              FIGP: 0 .. FIGMAX;
  217.              FIGN: ARRAY [1 .. FIGMAX] OF INTEGER;
  218.        RIGHTSPACE: 0 .. 136;
  219.              
  220.              TABS: ARRAY [1 .. TABMAX] OF LLEN;
  221.                RT,
  222.                 T,
  223.               DOT: BOOLEAN;
  224.  
  225.          BREAKSET,
  226.         OPTBRKSET,
  227.             CRSET: SET OF CBLANK .. CDEC;
  228.             EMPTY: BOOLEAN;
  229.           MACLSTP,
  230.     DefrFrcPgMacP,
  231.         FrcPgMacP,
  232.         ParagMacP,
  233.        CarRtnMacP,
  234.           MidMacP,
  235.           TTLMACP,
  236.           STLMACP,
  237.       ChapterMacP,
  238.           CHTMACP: PMAC;
  239.          NOTMACRO: BOOLEAN;
  240.           LASTCUP: integer;
  241.             XTEND: BOOLEAN;
  242.           LASTLEN,
  243.          LASTSLEN: LLEN;
  244.  
  245.               VID: ARRAY [1 .. VARMAX] OF ALFA;
  246.               VAL: ARRAY [1 .. VARMAX] OF INTEGER;
  247.               VTY: ARRAY [1 .. VARMAX] OF VARTYP;
  248.               VUP: ARRAY [1 .. VARMAX] OF 1 .. VARMAX;
  249.            VARNDX,
  250.                TV: 1 .. VARMAX;
  251.            
  252.            PUSHED: BOOLEAN;
  253.            PAGSAV: LINE;
  254.            PAGOTL: BOOLEAN;
  255.           
  256.           ARELOPR: ARRAY [RELOPR] OF ALFA;
  257.       DangerPoint: integer;
  258.           EXPRERR,
  259.          SHOWEXPR: BOOLEAN;
  260.           ITEMSET,
  261.           TERMSET: SET OF ' ' .. '_';
  262.        RomanChars: packed array [1 .. 26] of char;
  263.        RomanValue: array [1 .. 13] of integer;
  264.             ROMLC: BOOLEAN;
  265.          EOFINPUT: BOOLEAN;
  266.  
  267.      ErrorsOnLine: integer;
  268.          ErrorSet: set of 0 .. MaxErrors;
  269.        StartToken: integer;
  270.           VarName: alfa;
  271.        ERRORCOUNT: INTEGER;
  272.  
  273.         LineCount: integer;
  274.         MakeUpper,
  275.         MakeLower: packed array [CharRange] of char;
  276.      CharCategory: array [CharRange] of CharType;
  277.  
  278.        EmptyFlags: LineFlags;
  279.  
  280. {}{Turbo}    { Page must be manually declared on Turbo Pascal }
  281.    { use chr(12) or the page eject code for your printer, or set NOPAGE true }
  282.     procedure page(var f:text);
  283.       begin
  284.         writeln(f,chr(12))
  285.       end;
  286.  
  287. {}{Prospero} { Halt must be manually declared in Prospero Pro Pascal }
  288.    {  procedure halt;
  289.           procedure ExitProg(retcode:integer); external;
  290.       begin ExitProg(1); end;
  291.    }
  292.  
  293. procedure WritePAOC ( var L: ALINE;  width: integer);
  294. {  Write a Packed Array Of Char, with a field width.  This procedure is      }
  295. {  necessary only because some Pascal compilers ignore field width on PAOCs. }
  296.   var i : integer;
  297.   begin
  298.     if not paocBUG
  299.       THEN write(outfile,L:width) { ISO standard:  VAX, Prospero, UNIX etc. }
  300.       ELSE for i:= 1 to width do write(outfile, L[i]);  { Turbo, MT+, UCSD  }
  301.   end (* WritePAOC *);
  302.  
  303. function FileExists (filename:string80) : boolean;
  304. { Return true if file is available.  Highly compiler-specific }
  305.   var
  306.     fl : text;
  307.   begin
  308. {}{VMS}{ open (File_Variable:=Fl,File_Name:=filename,                     }
  309. {}{VMS}{ History := old,error:=continue); FileExists := (Status(fl) = 0); }
  310.     (*$I-*)
  311. {}{Turbo} assign(fl,filename); reset(fl); FileExists:= IOResult=0; close(fl);
  312.     (*$I+*)
  313. {}{Prospero} { FileExists := fstat(filename);  }
  314.   end (* fileexists *);
  315.  
  316.  
  317. function BoolOrd(BoolExp: boolean): integer;
  318.   forward;
  319.  
  320. function ForceUpperCase(achar: char): char;
  321.   forward;
  322.  
  323. procedure StackToMacro(StartAt: integer;
  324.                        var StartMacro, FinishMacro: StringLocation);
  325.   forward;
  326.  
  327. procedure Error(ErrNum: integer);
  328.   forward;
  329.  
  330. function TestOk(BoolExp: Boolean; ErrNum: integer): Boolean;
  331.   forward;
  332.  
  333. PROCEDURE CLRTAB;
  334.   forward;
  335.  
  336. PROCEDURE SAVENV(VAR E: ENVIRON);
  337.   forward;
  338.  
  339. procedure PushText(p: pmac);
  340.   forward;
  341.   
  342. PROCEDURE CLRLINE;
  343.  forward;
  344.  
  345. PROCEDURE SETSTD;
  346.  forward;
  347.  
  348. PROCEDURE RESENV(VAR E: ENVIRON);
  349.   forward;
  350.  
  351. { VAX segment  %include 'RNF0.pas' }
  352. { overlay }  { CP/M-80 requires overlay }
  353. (*$IRNF0.pas *)
  354.  
  355. { VAX segment %include 'RNF1.pas' }
  356. { overlay }  { CP/M-80 requires overlay }
  357. (*$IRNF1.pas *)
  358.  
  359.  
  360. {  VAX segment }
  361. { overlay }  { CP/M-80 requires overlay }
  362.  
  363.   procedure ProcessLine;
  364.  
  365.     var
  366.          LastTop: integer;
  367.        LineIndex,
  368.       CurLinIndx: integer;
  369.  
  370. {VAX} { %include 'RNF2.PAS' %include 'RNF3.PAS' }
  371. (*$IRNF2.pas *)
  372. (*$IRNF3.pas *)
  373.  
  374.  
  375.    begin (* ProcessLine *)
  376.      if EofInput then
  377.        fin
  378.      else
  379.        with StgStack[TopOfStack] do
  380.          if asis and (TopOfStack = 0) then
  381.            begin
  382.              if StgTable[StgBegin]  = '!' then
  383.                begin
  384.                  StgPosition := StgEnd;
  385.                  asis := false
  386.                end
  387.              else
  388.                BEGIN
  389.                  with otl do
  390.                    begin
  391.                      LineIndex := VAL[VLM];
  392.                      for CurLinIndx := StgBegin to StgEnd do
  393.                        begin
  394.                          LIN[LineIndex] := StgTable[CurLinIndx];
  395.                          LineIndex := LineIndex + 1;
  396.                        end;
  397.                      LIN[LineIndex] := ' ';
  398.                      len := LineIndex;
  399.                      
  400.                      while ((LineIndex > 1) and (LIN[LineIndex] = ' ')) do
  401.                        LineIndex := LineIndex - 1;
  402.                      if LineIndex > val[vrm] + 1 then
  403.                        begin
  404.                          StartToken := val[vrm] + 1;
  405.                          Error(54) (* Error - Asis text past right margin *);
  406.                        end;
  407.                    end;
  408.                  
  409.                  StgPosition := StgEnd;
  410.                  EMPTY := FALSE;
  411.  
  412.                  PUTLINE;
  413.                  
  414.                END;
  415.            end
  416.          else
  417.            begin
  418.              if ap and (StgTable[StgBegin] = ' ') and (StgPosition = StgBegin) 
  419.              THEN PushText(ParagMacP);
  420.              GETSYM;
  421.              IF SYMTYPE = NONE   THEN BLANKLINE
  422.              ELSE
  423.                repeat
  424.                  CASE SYMTYPE OF
  425.                    WORD: PUTWORD;
  426.                    VARS: PUTVAR;
  427.                    COMMAND: 
  428.                      begin
  429.                        LastTop := TopOfStack;
  430.                        if CMDTYPE in OPTBRKSET then BREAK;
  431.                        if CMDTYPE in CRSET then CR;
  432.                        (* the above break may force (stack) a page eject. 
  433.                           Do it first *)
  434.                        if (LastTop <> TopOfStack) and (TopOfStack < StackMax) 
  435.                        then
  436.                          begin
  437.                            StgStack[TopOfStack + 1] := StgStack[TopOfStack]; 
  438.                            TopOfStack := TopOfStack - 1;
  439.                            (* put the current symbol under the top of stack *)
  440.                            PushSyl(syl);
  441.                            (* and push both down *)
  442.                            TopOfStack := TopOfStack + 2;
  443.                          end
  444.                        else
  445.                          DoCommand(CMDTYPE)
  446.                      end
  447.                  END;
  448.                  GETSYM;
  449.                until symtype = none;
  450.              ENDLINE;
  451.            end;
  452.    end;
  453.  
  454. {VMS   %include 'RNF4.PAS'}
  455. (*$IRNF4.pas *)
  456.  
  457.  
  458. BEGIN (*RNF*)
  459.   WRITELN(' RNF  Text Formatter. ', version);
  460.   INI;
  461.   LineCount := 0;
  462.  
  463.   repeat
  464.     ErrorsOnLine := 0;
  465.     ErrorSet := [];
  466.     getcur;
  467.     ProcessLine;
  468.     if ErrorSet <> [] then
  469.       WriteErrorMessages;
  470.   until eofinput;
  471.  
  472.   writeln;
  473.   writeln(' Lines read: ', LineCount - 1: 1, '.');
  474.   if ErrorCount = 0 then
  475.     writeln(' No Errors detected.')
  476.   else
  477.     WRITELN( ' Errors detected: ', ErrorCount);
  478.   WRITELN( ' Last page processed: ', VAL[VPAGE]);
  479. {}CLOSE(OUTFILE);
  480. END (*RNF*).
  481.