TBLCTENTDOC$TBLCTENTPAS%Šÿ .op WordStar file utility -- 9-21-85 Ver 1.0P Copyright 1985 by Dean A. Fields Thió  prograí  ió releaseä tï thå Publiã Domaiî anä  maù  bå freelù  distributeä  anä copied¬  buô maù noô bå solä withouô thå authoró writteî permission. All Rights Reserved Written in TURBO PASCAL Ver. 3.0 on a COMPAQ Tested on a: COMPAQ MsDos 3.1 KAYPRO 4-84 CP/M 2.2 Tï uså thió prograí, typå thå prograí name¬ TBLCTENT¬ aô thå DOÓ  prompt¬  anä presó thå returî key®  Thå prograí wilì  firsô announcå  itself¬  anä theî prompô foò thå namå oæ thå filå  thaô the table of content is to be created from. Thió  prograí  createó á Tablå oæ Contentó  foò  á  WordStaò documenô  file®  TBLCTENÔ  lookó foò controì  codes¬  anä  takeó whateveò  ió betweeî theí anä placeó iô iî thå tablå oæ  contentó file® Thå controì codeó are¬ ^Ò tï starô anä stoð inclusioî intï thå  tablå  oæ  contentó file®  Theù arå placeä iî thå  filå  bù enterinç  á  ^P^Ò aô thå beginninç anä enä oæ thå  texô  yoõ wanô includeä intï thå tablå oæ contentó file®  Thå ^R'ó shoulä neveò havå  WordStaò doô commandó betweeî them®  Thå namå oæ thå tablå oæ  contentó filå ió thå samå aó thå inpuô document¬  excepô  thå filå  typå  whicè ió ".TBC"®  Thå maximuí numbeò  oæ  characteró alloweä  iî  á  Tablå oæ Contenô entrù ió 55¬  iæ  morå  theî  5µ characteró  appeaò betweeî thå ^R's¬  theî thå Tablå  oæ  Contenô entrù ió truncateä tï 5µ characters. Afteò  yoõ enteò thå filå namå thaô thå tablå oæ contenô  ió tï  bå  createä  from¬  TBLCTENÔ wilì trù tï opeî thaô  filå  foò input®  Iæ thå filå caî noô bå openeä (ie® becauså iô caî noô bå founä  oò  something©  thå  conditioî ió  reporteä  anä  yoõ  arå reprompteä foò aî inpuô filå name®  Thió prograí caî bå  aborteä aô  anytimå bù á ^C®  Iæ thå inpuô filå namå ió found¬  theî thå outpuô  filå  (Tablå oæ Contenô file© ió  checkeä  for®  Iæ  thå outpuô  filå  alreadù exist¬  yoõ arå giveî thå optioî oæ  eitheò deletinç iô (overwrittinç iô )¬ oò cancelinç thå program® Iæ yoõ deletå  it¬  theî processinç continueó aó iæ thå filå  haä  neveò existed. Durinç  processing¬  TBLCTENÔ  reportó  pageó  thaô  iô  haó scanneä   foò  tablå  oæ  contenô  entries»   sï  yoõ  caî   telì approximatelù  ho÷  faò  yoõ arå iî thå  inpuô  document®  Pageó covereä bù á .OÐ command arå noô counted® .pa Š Thå followinç describeó ho÷ thå WordStaò .OP¬ .PA¬ anä .PÎ î commands are treated by TBLCTENT:          .OP   causeó  thå  prograí tï stoð searchinç  foò  Tablå                oæ Contenô information¬ becauså .OÐ turnó ofæ pagå                numbeò  anä  thereforå therå ió nï pagå numbeò  tï                associatå tï thå Tablå oæ Contenô entry¬  anä thuó                nï  reasoî  tï  reporô á Tablå oæ  Contenô  entry®                Tablå  oæ Contenô searchinç resumeó witè thå  nexô                .PN n command encountered.          .PA   causeó thå pagå numbeò variablå tï bå incremented          .PN n  causeó  thå  pagå  numbeò variablå tï  bå  seô tï                numbeò  î  oæ thå .PÎ î command®  î  caî  noô  bå                largeò thaî 9999¬ unlesó provisionó arå madå tï dï                the following:                     1©  - MaxNuí  iî  thå CONSÔ  sectioî  aô  thå                     beginninç  oæ thå prograí musô bå changeä  tï                     accommodate the new size                     2©   - thå   "CASÅ  pndø  of¢  structurå   iî                     Procedurå test_linå musô bå changeä tï handlå                     the larger page numbers                     3©   - Procedurå   translate_linå   musô   bå                     modifieä  tï accommodatå  thå  ne÷  TBà linå                     format¬    whicè   includeó   balancinç   anä                     centering of the TBC entry. Oncå  thå Tablå oæ Contenô filå haó beeî created¬  iô caî bå editeä  witè  WordStaò tï adä iî printeò controì codeó  foò  youò specifiã typå oæ printer®  Oî somå machineó thå Tablå oæ Contenô filå wilì contaiî á fe÷ ^@'ó aô thå enä oæ thå file»  Thå ^@'ó dï noô  print®  Yoõ  caî  ignorå theí oò deletå theí  iô  makeó  nï difference.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; (* max. input line length *) version = '1.0P'; (* version number *) date = 'September 21, 1985'; (* 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 = 55; (* max. char.s 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 anded with decimal 127 to strip of 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 follwoing code is executed if the 2nd ^R is found *) if ControlR_2 then begin ControlR_1 := false; ControlR_2 := false; (* * keep TBC lines to 55 characters wide, max *) if ChNum > MaxChrs then ChNum := MaxChrs; (* determine the number of characters not used, out of a max. of 55 *) RemainChrs := MaxChrs - 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; (* * the follwoing 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) 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('Version # ', version, ' of ', date, '.'); writeln; gotoxy(1, 6); open_files; if not cancel then process; exit end. (* main *)  COM M€