program tblctent(input, output, infile, outfile); (* WordStar file utility -- 9-21-85 Ver 1.0P *) (* Copyright 1985 by Dean A. Fields *) (* *) (* Written in TURBO PASCAL Ver. 3.0 *) (* on a COMPAQ *) (* *) (* Creates a Table of Contents for a WordStar *) (* document file. TBLCTENT looks for control *) (* codes, and takes whatever is between them *) (* and places it in the table of contents *) (* file. The control codes are, ^R to start *) (* and stop inclusion into the table of *) (* contents file. They are placed in the *) (* file by entering a ^P^R at the begining *) (* and end of the text you want included into *) (* the table of contents file. The ^R's *) (* should never have WordStar dot commands *) (* between them. The name of the table of *) (* contents file is the same as the input *) (* document, except the file type which is *) (* ".TBC". *) (* *) Const MaxLineLen = {255} 500; (* max. input line length *) version = '2.0'; (* version number *) date = 'November 28, 1987'; (* release date *) MaxNum = 4; (* maximum number of digits for .PN n *) space = $20; bell = 07; lf = 10; cr = $0D; ctlr = 18; period = 46; tens = 10; hundreds = 100; thous = 1000; MaxChrs = 500; (* max. chars allowed for TBC entry *) PageLen = 55; (* number of lines per page *) ControlR_1 : boolean = false; ControlR_2 : boolean = false; dop : boolean = false; ChNum : integer = 1; page_num : integer = 0; line : integer = 0; (* variable that contains the current *) (* TBC line # being output for *) (* the current TBC page *) (* * TblLine is the next line to be printed to the .TBC file *) TblLine : integer = 7; (* initialize TblLine to 7 *) TYPE AnyString= string[255]; VAR infile, outfile : text; LineIn : array[1..MaxLineLen] of byte; LoopCntr, chrcnt, indx : integer; dot_cmnd, cancel : boolean; page_num_print : array[1..4] of byte; ch : char; (* character read from input file *) (* * The following function converts any lower case characters in a string * to upper case, and was copied from TURBO PASCAL manual (v3.0) page 146. *) FUNCTION StUpCase (st:anystring):anystring; VAR I : integer; begin (* FUNCTION StUpCase *) for i:= 1 to length(st) do st[i] := upcase(st[i]); stupcase := st; end; (* * This procedure opens the input and output files *) PROCEDURE open_files; VAR infname : string[20]; outfname : string[20]; ans : string[10]; goodfile : boolean; dotpos, FileNmeEnd : integer; BEGIN repeat write('Enter input filename --> '); readln(infname); infname := StUpCase(infname); assign(infile, infname); {$I-} reset(infile) {$I+}; goodfile := (IOresult = 0); if not goodfile then begin clrscr; GotoXY(1,6); write (chr(bell)); writeln('FILE ', infname, 'NOT FOUND!!!'); delay(6000); end; until goodfile; repeat dotpos := 0; FileNmeEnd := length(infname); dotpos := POS('.', infname); if (dotpos > 0) then begin dotpos := pred(dotpos); outfname := copy(infname, 1, dotpos); end else outfname := copy(infname, 1, FileNmeEnd); insert('.TBC', outfname, (FileNmeEnd+1)); FileNmeEnd := 20 - (FileNmeEnd+4); delete(outfname, (FileNmeEnd+5), FileNmeEnd); assign(outfile, outfname); {$I-} reset(outfile) {$I+}; goodfile := (IOresult <> 0); if not goodfile then begin write(chr(bell), 'FILE ', outfname, ' EXISTS, OVERWRITE? (Y/N) '); readln(ans); goodfile := (UpCase(ans[1]) = 'Y'); gotoxy(1, 7); write(' '); (* * the following code allows a to return to DOS, after * closing the input file; in the event that goodfile comes * back as an 'N'. *) if not goodfile then begin cancel := true; end end; until goodfile; rewrite(outfile); (* * output standard Table of Content header to output file *) writeln(outfile, '.op'); writeln(outfile); writeln(outfile); writeln(outfile, ' Table of Content'); writeln(outfile); writeln(outfile); writeln(outfile); end; (* procedure open_files *) (* * The following procedure reads a line of input, ended by CRLF, into an * internal buffer, for further processing. As the input characters are * read they are ended with decimal 127 to strip off the 8th bit, if it's * set. *) PROCEDURE get_line; VAR lonum : byte; (* variable used to strip 8th bit *) begin ch := chr(0); lonum := 0; chrcnt := 0; while not eof(infile) and (lonum <> lf) do begin chrcnt := succ(chrcnt); read(infile, ch); lonum := (ord(ch) and 127); LineIn[chrcnt] := lonum; end end; (* procedure get_line *) (* * Procedure test_line searches the input line, that has been read in * by get_line, for the following conditions: * .OP -> which causes the program to stop searching for Table * of Content information, because .OP turns off page * number and therefore there is no page number to * associate to the Table of Content entry, and thus * no reason to report a Table of Content entry. * * .PA which causes the page number variable to be * inceremented * .PN n which causes the page number variable to be set * to number n of the .PN n command. n can not be * larger than 9999. *) PROCEDURE test_line; VAR pndx : integer; (* index for page_num_print array *) begin dot_cmnd := false; (* initialize dot_cmnd to false *) (* * search for .OP *) if LineIn[1] = period then begin ch := chr(LineIn[2]); if UpCase(ch) = 'O' then begin ch := chr(LineIn[3]); if UpCase(ch) = 'P' then begin line := 0; dop := true; end end end; (* * search for .PA *) if LineIn[1] = period then begin ch := chr(LineIn[2]); if UpCase(ch) = 'P' then begin ch := chr(LineIn[3]); if UpCase(ch) = 'A' then begin line := 0; dot_cmnd := true; page_num := succ(page_num); end end end; (* * search for .PN n *) if LineIn[1] = period then begin ch := chr(LineIn[2]); if UpCase(ch) = 'P' then begin ch := chr(LineIn[3]); if Upcase(ch) = 'N' then begin line := 0; dop := false; (* reset dop flag *) dot_cmnd := true; indx := 4; (* * ignore spaces between .pn and number, if any *) while LineIn[indx] = space do indx := succ(indx); pndx := 0; repeat pndx := succ(pndx); page_num_print[pndx] := LineIn[indx]; indx := succ(indx); if pndx > MaxNum then begin if LineIn[indx] <> cr then begin ClrScr; gotoxy(1,10); writeln(chr(bell),'Invalid .PN command, number is too large'); writeln('Last valid page number was ', page_num); writeln('Table of Content program ABORTING!!'); delay(6000); cancel := true; LineIn[indx] := cr; (* force repeat until to end *) end end; until LineIn[indx] = cr; (* * the follow code converts the n, of the .PN n command, from a text number * to an integer number *) page_num := page_num_print[pndx] - 48; Case pndx of 2 : begin page_num := page_num + ((page_num_print[pndx-1] - 48) * tens); end; 3 : begin page_num := page_num + ((page_num_print[pndx-1] - 48) * tens); page_num := page_num + ((page_num_print[pndx-2] - 48)* hundreds); end; 4 : begin page_num := page_num + ((page_num_print[pndx-1] - 48) * tens); page_num := page_num + ((page_num_print[pndx-2] - 48) * hundreds); page_num := page_num + ((page_num_print[pndx-3] - 48) * thous); end; end (* case *) end (* if *) end (* if *) end (* if *) end; (* procedure test_line *) (* * Procedure translate_line translates fenced Table of Content entries * into Table of Content entries in the Table of Content file. (if you * can figure out that last sentence, you'll have no problem with the * this program) Control R is the fence character. This procedure * searches for a Control R. When the first Control R is encountered, a * flag (ControlR_1) is set true and the following characters are written * to the Table of Content file. When a second control R is found then a * flag (ControlR_2) is set true, which ends character writting to the * Table of Content file, clears both Control R flags, formats the rest * of the Table of Content line, and puts in the page number for that * entry. *) PROCEDURE translate_line; VAR indx1 : integer; (* index used to step thru the input line *) RemainChrs : integer; (* variable to contain the number of *) (* characters remaining in the TBC *) (* line being printed. Used for *) (* formatting TBC lines so that *) (* they look uniform. *) begin (* procedure translate_line *) for indx1 := 1 to chrcnt do (* process every character in the line *) begin (* * check for a ^R *) if LineIn[indx1] = ctlr then begin indx1 := succ(indx1); (* * if a ^R found, then determine which one *) if (ControlR_1) then ControlR_2 := true else ControlR_1 := true; end; (* * the following code is executed if the 2nd ^R is found *) if ControlR_2 then begin ControlR_1 := false; ControlR_2 := false; {Clrscr; Writeln('ChNum is ',ChNum); Readln;} if (ChNum >= 1) and (ChNum <= 55) Then begin {55} (* * keep TBC lines to 55 characters wide, max *) if ChNum > 55 then ChNum := 55; (* determine the number of characters not used, out of a max. of 55 *) RemainChrs := 55 - 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; {55} if (ChNum >= 56) and (ChNum <= 110) Then begin {110} (* * keep TBC lines to 110 characters wide, max *) if ChNum > 110 then ChNum := 110; (* determine the no. of characters not used, out of a max. of 110 *) RemainChrs := 110 - 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; {110} if (ChNum >= 111) and (ChNum <= 165) Then begin {165} (* * keep TBC lines to 165 characters wide, max *) if ChNum > 165 then ChNum := 165; (* determine the no. of characters not used, out of a max. of 165 *) RemainChrs := 165 - 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; {165} if (ChNum >= 166) and (ChNum <= 220) Then begin {220} (* * keep TBC lines to 220 characters wide, max *) if ChNum > 220 then ChNum := 220;