{$I TBL20.INC} (* determine the no. of characters not used, out of a max. of 220 *) RemainChrs := 220 - ChNum; (* if RemainChrs does not divide evenly by 2, then a space is *) (* needed before you can start putting the dots on the TBC line *) if (RemainChrs MOD 2) > 0 then write(outfile, ' '); (* integer div. of RemainChrs by 2 yields the number of dots to be *) (* printed *) RemainChrs := RemainChrs DIV 2; write(outfile, ' '); (* print the dots *) for LoopCntr := 1 to RemainChrs do write(outfile, '. '); (* print the page number *) write(outfile, page_num:4); writeln(outfile); (* incerement the TBC line counter and reset the TBC character *) (* counter to 1 *) TblLine := succ(TblLine); ChNum := 1; end; {220} if (ChNum >= 221) and (ChNum <= 275) Then begin {275} (* * keep TBC lines to 275 characters wide, max *) if ChNum > 275 then ChNum := 275; (* determine the no. of characters not used, out of a max. of 275 *) RemainChrs := 275 - ChNum; (* if RemainChrs does not divide evenly by 2, then a space is *) (* needed before you can start putting the dots on the TBC line *) if (RemainChrs MOD 2) > 0 then write(outfile, ' '); (* integer div. of RemainChrs by 2 yields the number of dots to be *) (* printed *) RemainChrs := RemainChrs DIV 2; write(outfile, ' '); (* print the dots *) for LoopCntr := 1 to RemainChrs do write(outfile, '. '); (* print the page number *) write(outfile, page_num:4); writeln(outfile); (* incerement the TBC line counter and reset the TBC character *) (* counter to 1 *) TblLine := succ(TblLine); ChNum := 1; end; {275} if (ChNum >= 276) and (ChNum <= 330) Then begin {330} (* * keep TBC lines to 330 characters wide, max *) if ChNum > 330 then ChNum := 330; (* determine the no. of characters not used, out of a max. of 330 *) RemainChrs := 330 - ChNum; (* if RemainChrs does not divide evenly by 2, then a space is *) (* needed before you can start putting the dots on the TBC line *) if (RemainChrs MOD 2) > 0 then write(outfile, ' '); (* integer div. of RemainChrs by 2 yields the number of dots to be *) (* printed *) RemainChrs := RemainChrs DIV 2; write(outfile, ' '); (* print the dots *) for LoopCntr := 1 to RemainChrs do write(outfile, '. '); (* print the page number *) write(outfile, page_num:4); writeln(outfile); (* incerement the TBC line counter and reset the TBC character *) (* counter to 1 *) TblLine := succ(TblLine); ChNum := 1; end; {330} if (ChNum >= 331) and (ChNum <= 385) Then begin {385} (* * keep TBC lines to 385 characters wide, max *) if ChNum > 385 then ChNum := 385; (* determine the no. of characters not used, out of a max. of 385 *) RemainChrs := 385 - ChNum; (* if RemainChrs does not divide evenly by 2, then a space is *) (* needed before you can start putting the dots on the TBC line *) if (RemainChrs MOD 2) > 0 then write(outfile, ' '); (* integer div. of RemainChrs by 2 yields the number of dots to be *) (* printed *) RemainChrs := RemainChrs DIV 2; write(outfile, ' '); (* print the dots *) for LoopCntr := 1 to RemainChrs do write(outfile, '. '); (* print the page number *) write(outfile, page_num:4); writeln(outfile); (* incerement the TBC line counter and reset the TBC character *) (* counter to 1 *) TblLine := succ(TblLine); ChNum := 1; end; {385} if (ChNum >= 386) and (ChNum <= 440) Then begin {440} (* * keep TBC lines to 440 characters wide, max *) if ChNum > 440 then ChNum := 440; (* determine the no. of characters not used, out of a max. of 440 *) RemainChrs := 440 - ChNum; (* if RemainChrs does not divide evenly by 2, then a space is *) (* needed before you can start putting the dots on the TBC line *) if (RemainChrs MOD 2) > 0 then write(outfile, ' '); (* integer div. of RemainChrs by 2 yields the number of dots to be *) (* printed *) RemainChrs := RemainChrs DIV 2; write(outfile, ' '); (* print the dots *) for LoopCntr := 1 to RemainChrs do write(outfile, '. '); (* print the page number *) write(outfile, page_num:4); writeln(outfile); (* incerement the TBC line counter and reset the TBC character *) (* counter to 1 *) TblLine := succ(TblLine); ChNum := 1; end; {440} if (ChNum >= 441) and (ChNum <= 495) Then begin {495} (* * keep TBC lines to 495 characters wide, max *) if ChNum > 495 then ChNum := 495; (* determine the no. of characters not used, out of a max. of 495 *) RemainChrs := 495 - ChNum; (* if RemainChrs does not divide evenly by 2, then a space is *) (* needed before you can start putting the dots on the TBC line *) if (RemainChrs MOD 2) > 0 then write(outfile, ' '); (* integer div. of RemainChrs by 2 yields the number of dots to be *) (* printed *) RemainChrs := RemainChrs DIV 2; write(outfile, ' '); (* print the dots *) for LoopCntr := 1 to RemainChrs do write(outfile, '. '); (* print the page number *) write(outfile, page_num:4); writeln(outfile); (* incerement the TBC line counter and reset the TBC character *) (* counter to 1 *) TblLine := succ(TblLine); ChNum := 1; end; {495} writeln(outfile); end; (* * the following code is executed if the 1st ^R is found *) if ControlR_1 then begin if ChNum = 1 then begin write(outfile, ' '); (* indent each TBC line by 3 char.s *) end; if ChNum < MaxChrs then begin (* * CR and LF are filtered from Table of Content entries, in the event * that an entry spans a line. *) {if LineIn[indx1] <> cr then begin if LineIn[indx1] <> lf then begin } (* * filter out control characters *) if (LineIn[indx1] > 31) then begin ch := chr(LineIn[indx1]); write(outfile, {UpCase}ch); ChNum := succ(ChNum); IF (ChNum = 56) or (ChNum = 111) or (Chnum = 166) or (ChNum = 221) or (ChNum = 276) or (ChNum = 331) or (ChNum = 386) or (ChNum = 441) or (ChNum = 496) then begin Writeln(Outfile{, (Chr(Cr)}); Write(Outfile, ' '); end; end (* if > 31 *) {end * if lf *} {end * if cr *} end (* if ChNum *) end (* if *) end; (* for *) end; (* procedure translate_line *) (* * The following function returns a true value if the * character input was a "Y" or "y" *) FUNCTION inyn : boolean; VAR ans : string[10]; begin write('Y/N '); readln(ans); inyn := (UpCase(ans[1]) = 'Y') end; (* function inyn *) (* * The process procedure controls Table of Content processing, * if the program is not canceled at the open_file procedure. * This procedure executes get_line to retrieve a line from * the input file; executes test_line to search for WordStar * dot commands; executes translate_line, depending on the * results of test_line, and counts the number of pages of * input to be scanned for Table of Content entries. *) PROCEDURE process; VAR contnu : boolean; (* set false if program is to be *) (* abnormally ended *) BEGIN contnu := true; gotoxy(1,12); write('Page # '); while contnu do begin get_line; test_line; if not cancel then begin if not dop then begin if not dot_cmnd then begin line := succ(line); if line > PageLen then begin line := 0; page_num := succ(page_num) end; (* if line > PageLen *) translate_line; gotoxy(8, 12); write(page_num:5) end (* if not dot_cmnd *) end (* if not dop *) end else contnu := false; if eof(infile) then contnu := false; end (* while contnu *) end; (* procedure process *) (* * The exit procedure displays an end of processing message, closes * all open files, and returns to DOS *) PROCEDURE exit; begin ClrScr; gotoxy(1, 11); if cancel then begin writeln('Table of Contents program Aborted!!'); close(infile); close(outfile) end else begin writeln('Table of Content program completed!'); writeln(outfile); close(infile); close(outfile) end end; (* procedure exit *) (* * MAIN is the actual Table of Content program. It announces * the start of the program, and ask for the name of the file * to be scanned for Table of Content entries. *) BEGIN (* main *) ClrScr; cancel := false; writeln; writeln('WordStar Table of Content generator Program'); writeln('Copyright 1985 by Dean A. Fields'); writeln('Revised 1987 by Ellis B. Levin'); writeln('Version # ', version, ' of ', date, '.'); writeln; gotoxy(1, 6); open_files; if not cancel then process; exit end. (* main *)