home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS 1992 September / Simtel20_Sept92.cdr / msdos / sysutl / stack.arc / MANUAL.PAS < prev    next >
Pascal/Delphi Source File  |  1987-12-10  |  16KB  |  562 lines
  1. PROGRAM MANUAL;
  2.  
  3. const
  4.  
  5. { See documentation for notes on how to modify these constants }
  6.  
  7.   bold     = #02;         {wordstar bold face}
  8.   double   = #04;
  9.   pagelines = 66;         {default lines per printed page}
  10.   tab_posn = 10;
  11.   striptop = 127;        {used to strip top bit off bytes}
  12. {colours for monitor control}
  13.   lightgrey = 7;
  14.   black     = 0;
  15.   lightblue = 9;
  16.   yellow    = 14;
  17.  
  18.  
  19.   title    = '         Documentation Display System - Version 1.4, Dec 87';
  20.   author   = '                                        by Shane Bergl';
  21.   scrnsize = 21;
  22.   PageWidth = 95;
  23.   FormFeed = #12;
  24.   ctrla    = #01;         {control a char}
  25.   onefox   = #31;         { 1F hex}
  26.   cr       = #13;         {carriage return}
  27.   lf       = #10;         {line feed}
  28.   pgup     = #73;         {PgUp key less ESC code}
  29.   pgdn     = #81;         {PgDn key less ESC code}
  30.   lnup     = #72;         {up arrow less ESC code}
  31.   lndn     = #80;         {down arrow less ESC code}
  32.   nd       = #79;         {End key less ESC code}
  33.   home     = #71;         {home key less ESC code}
  34.   esc      = #27;
  35.   blank    = #32;
  36.   maxline  = 20;          {max lines per screen}
  37.   firstline = 2;          {first line for text}
  38.   text_size = 512;
  39.   space80  =
  40. '                                                                                 ';
  41.   screen   = true;
  42.   printer  = false;
  43.  
  44. type
  45.   filename   =  string[12];
  46.   line       =  record
  47.                   detail   :  string[75];
  48.                   sect     :  integer;
  49.                 end;
  50.   scr        =  array[1..20] of line;
  51.   scrn_ptr   =  ^scrn_type;
  52.   scrn_type  =  record
  53.                   scrn     :  scr;
  54.                   next_scr :  scrn_ptr;
  55.                 end;
  56.   workstr    =  string[79];
  57.   buff       =  array[1..512] of byte;
  58.  
  59. var
  60.   infile     :  file of buff;
  61.   doco       :  file of workstr;
  62.   index      :  file of scr;
  63.   testfile   :  text;
  64.   doco_file_name : filename;
  65.   heading,
  66.   boldface,
  67.   finished   :  boolean;
  68.   size_of_file,
  69.   curline,
  70.   printlength :  integer;
  71.   curscr,
  72.   contents   :  scrn_ptr;
  73.   key        :  char;
  74.  
  75. {----------------------------------------------------------}
  76.  
  77. procedure highon;
  78.  
  79. begin
  80.   textbackground(lightgrey);
  81.   textcolor(black);
  82. end;
  83.  
  84. {----------------------------------------------------------}
  85.  
  86. procedure highoff;
  87.  
  88. begin
  89.   textbackground(lightblue);
  90.   textcolor(yellow);
  91. end;
  92.  
  93. {----------------------------------------------------------}
  94.  
  95. procedure init;
  96.  
  97. var result : integer;
  98.  
  99. Function exists(name: filename): boolean;
  100.   var  fp : file;
  101.   begin
  102.     Assign(fp,Name);
  103.     {$I-} reset(fp); {$I+}
  104.     If IOresult <> 0 then
  105.       exists := False
  106.     else
  107.       exists := True;
  108.     {end if}
  109.     close(fp);
  110.   end { exists };
  111.  
  112.  
  113. Procedure checkfiles;
  114.   begin
  115.     If ParamCount = 0 then begin
  116.       Write('Enter documentation name: ');
  117.       readln(doco_file_name);
  118.       end
  119.     else begin
  120.       doco_file_name := ParamStr(1);
  121.     end;
  122.     If Not exists(doco_file_name + '.DOC') then
  123.       if not exists(doco_file_name + '.IDX')
  124.       and not exists(doco_file_name + '.DOK') then begin
  125.         Writeln('ERROR -- documentation not found:  ',doco_file_name);
  126.         Halt;
  127.       end; {if}
  128.   end {checkfiles};
  129.  
  130. begin {init}
  131.   clrscr;
  132.   checkfiles;
  133.   if ParamCount < 2 then
  134.     Printlength := pagelines
  135.   else
  136.     val(ParamStr(2),PrintLength,result);
  137.   {end if}
  138.   PrintLength := PrintLength - 6;  {3 lines each for header and footer}
  139.   highoff;
  140.   gotoxy(1, 10);
  141.   writeln(' ':29, 'Please wait', ' ':39);
  142. {a quick bit of publicity}
  143.   writeln;
  144.   writeln(title, ' ':78-length(title));
  145.   writeln(author, ' ':78-length(author));
  146.   writeln;
  147. {end of ad}
  148.   contents := nil;
  149.   curline := 1;
  150.   finished := false;
  151.   curscr := nil;
  152. end;
  153.  
  154. {----------------------------------------------------------}
  155.  
  156. Function CmdLine(inbuf : workstr) : boolean;
  157.  
  158. begin
  159.   if (inbuf[1] = '.') and ((inbuf[2]='P')or(inbuf[2]='p'))
  160.   and ((inbuf[3]='A')or(inbuf[3]='a')) then
  161.     CmdLine := true
  162.   else
  163.     CmdLine := false;
  164.   {end if}
  165. end;
  166.  
  167. {----------------------------------------------------------}
  168.  
  169. procedure print(lines2print:integer; screen:boolean; var stopped:boolean;
  170.                  var linecount:integer);
  171.  
  172. var  cur_row  : integer;
  173.      prtstr,
  174.      printstr,
  175.      dupe_str : workstr;
  176.      dupe     : boolean;
  177.      i        : integer;
  178.  
  179. begin
  180.   cur_row := 0;
  181.   if not screen then begin
  182.     gotoxy(1,scrnsize+firstline+1);
  183.     highon;
  184.     write('Printing, press any key to abort                                 ');
  185.     highoff;
  186.   end {if};
  187.   repeat
  188.     read(doco, printstr);
  189.     if CmdLine(printstr) then
  190.       if not screen then
  191.         cur_row := printlength
  192.       else
  193.         cur_row := cur_row
  194.       {end if} {Note: dummy statement required so IF..THEN..ELSEs work properly}
  195.     else begin
  196.       cur_row := succ(cur_row);
  197.       dupe_str := '';
  198.       prtstr := '';
  199.       dupe := false;
  200.       for i := 1 to length(PrintStr) do begin
  201.         if (printstr[i] >= blank) or (printstr[i] = bold)
  202.         or (printstr[i] = double) then
  203.           if (printstr[i] = bold) or (printstr[i] = double) then
  204.             dupe := not(dupe)
  205.           else
  206.             if dupe then
  207.               dupe_str := dupe_str + PrintStr[i]
  208.             else
  209.               dupe_str := dupe_str + ' ';
  210.             {end if}
  211.           {end if}
  212.         {end if}
  213.         if printstr[i] >= blank then prtstr := prtstr + printstr[i];
  214.       end {for};
  215.       if (dupe_str <> '') and not screen then write(lst,'          ', dupe_str, cr);
  216.       if screen then writeln(prtstr) else writeln(lst,'          ', prtstr);
  217.     end {if};
  218.   until (cur_row >= lines2print) or (cur_row >= printlength) or keypressed or eof(doco);
  219.   if keypressed then stopped := true else stopped := false;
  220.   linecount := cur_row;
  221. end {print};
  222.  
  223. {----------------------------------------------------------}
  224.  
  225. procedure lpr;
  226.  
  227. var
  228.   stopped   :  boolean;
  229.   i,
  230.   pagenum   :  integer;
  231.  
  232. begin
  233.   pagenum := 1;
  234.   reset(doco);
  235.   repeat
  236.     writeln(lst);
  237.     writeln(lst, ' ':(pagewidth div 2)-4, pagenum:3);
  238.     writeln(lst);
  239.     print(printlength, printer, stopped, i);
  240.     write(lst, formfeed);
  241.     pagenum := succ(pagenum);
  242.   until eof(doco) or stopped;
  243. end;
  244.  
  245.  
  246. procedure build_contents;
  247.  
  248.  
  249. procedure create_index;
  250. {---------------------}
  251.   var
  252.     i, k, curln, j, chrposn,
  253.     sect     : integer;
  254.     buf      : buff;
  255.     bite     : byte;
  256.     outstr   : workstr;
  257.     ch       : char;
  258.     line_of_blanks : boolean;
  259.  
  260.  
  261. procedure newrec;
  262.  
  263. begin
  264.   curln := 1;
  265.   if curscr = nil then begin
  266.     new(contents);
  267.     curscr := contents;
  268.     end
  269.   else begin
  270.     new(curscr^.next_scr);
  271.     curscr := curscr^.next_scr;
  272.   end; {if}
  273.   curscr^.next_scr := nil;
  274.   for k := 1 to maxline do begin
  275.     curscr^.scrn[k].detail := '     ';
  276.     curscr^.scrn[k].sect := 0;
  277.   end; {for}
  278. end;
  279.  
  280.  
  281.   begin
  282.     writeln(' ':28, 'Building Index', ' ':37);
  283.     curscr := nil;
  284.     heading := false;
  285.     line_of_blanks := true;
  286.     sect := 0;
  287.     outstr := '';
  288.     chrposn := 1;
  289.  
  290.   {build index}
  291.     curln := maxline;
  292.     while not eof(infile) do begin
  293.       read(infile, buf);
  294.       for i := 1 to 512 do begin
  295.         ch := chr(buf[i] and striptop);
  296.         case ch of
  297.           bold : if heading then begin
  298.                    heading := false;
  299.                    end
  300.                  else begin
  301.                    heading := true;
  302.                    curln := curln + 1;
  303.                    if curln > maxline then newrec;
  304.                    curscr^.scrn[curln].sect := sect;
  305.                    if chrposn = 1 then
  306.                      curscr^.scrn[curln].detail := curscr^.scrn[curln].detail
  307.                      + '    '
  308.                    else
  309.                      if not line_of_blanks then
  310.                        curscr^.scrn[curln].detail := curscr^.scrn[curln].detail
  311.                        + '        '
  312.                      else
  313.                        if chrposn <= tab_posn then
  314.                          curscr^.scrn[curln].detail
  315.                          := curscr^.scrn[curln].detail + '         ';
  316.                        {end if}
  317.                      {end if}
  318.                    {end if}
  319.                  end; {if}
  320.            cr : begin
  321.                   if heading then heading := false;
  322.                   write(doco, outstr);
  323.                   outstr := '';
  324.                   sect := sect + 1;
  325.                   line_of_blanks := true;
  326.                   chrposn := 1;
  327.                  end;
  328.           double : begin
  329.                      line_of_blanks := false;
  330.                      if heading then curscr^.scrn[curln].detail
  331.                        := curscr^.scrn[curln].detail + ch;
  332.                      {end if}
  333.                      outstr := outstr + ch;
  334.                      chrposn := succ(chrposn);
  335.                    end;
  336.           ctrla..onefox : ;
  337.           else   begin
  338.                  line_of_blanks := line_of_blanks and (ch = blank);
  339.                  if heading then curscr^.scrn[curln].detail
  340.                    := curscr^.scrn[curln].detail + ch;
  341.                  outstr := outstr + ch;
  342.                  chrposn := succ(chrposn);
  343.                  end;
  344.           end {case};
  345.         end {for};
  346.     end; {while}
  347.   end; {create index}
  348.  
  349. begin {build contents}
  350.   assign(index, doco_file_name + '.IDX');
  351.   {$I-}
  352.   reset(index);
  353.   {$I+}
  354.   if IOresult = 0 then begin
  355.     assign(doco, doco_file_name + '.DOK');
  356.     reset(doco);
  357.     while not eof(index) do begin
  358.       if contents = nil then begin
  359.         new(curscr);
  360.         contents := curscr;
  361.         end
  362.       else begin
  363.         new(curscr^.next_scr);
  364.         curscr := curscr^.next_scr;
  365.       end; {if}
  366.       read(index, curscr^.scrn);
  367.       curscr^.next_scr := nil;
  368.     end {while}
  369.     end
  370.   else begin
  371.     assign(infile, doco_file_name + '.DOC');
  372.     reset(infile);
  373.     assign(doco, doco_file_name + '.DOK');
  374.     rewrite(doco);
  375.     create_index;
  376.     close(doco);
  377.     reset(doco);
  378.     rewrite(index);
  379.     curscr := contents;
  380.     while curscr <> nil do begin
  381.       write(index, curscr^.scrn);
  382.       curscr := curscr^.next_scr;
  383.     end; {while}
  384.     close(index);
  385.   end {if};
  386. end {build contents};
  387.  
  388.  
  389. {----------------------------------------------------------}
  390.  
  391. procedure display_contents(strt_scrn : scrn_ptr; curline : integer);
  392.  
  393. var
  394.   i     :  integer;
  395.  
  396. begin
  397.   clrscr;
  398.   highon;
  399.   writeln('----------------------------- SYSTEM DOCUMENTATION ',
  400.           '-----------------------------');
  401.   highoff;
  402.   writeln(' ':78);
  403.   gotoxy(1, firstline+1);
  404.   with strt_scrn^ do for i := 1 to 20 do begin
  405.     if scrn[i].detail <> '' then begin
  406.       if i = curline then highon;
  407.       writeln(scrn[i].detail, ' ':78-length(scrn[i].detail));
  408.       if i = curline then highoff;
  409.       end
  410.     else
  411.       writeln;
  412.     {end if}
  413.   end;
  414.   writeln(' ':78);
  415.   highon;
  416.   write('-- PgUp, PgDn, End to exit, Home to print manual, ',
  417.           'Enter to view selected item --');
  418.   highoff;
  419. end;
  420.  
  421. {----------------------------------------------------------}
  422.  
  423. procedure display_page(sector : integer);
  424.  
  425. var
  426.   linecount,
  427.   sect      : integer;
  428.   buf       : workstr;
  429.   stopped,
  430.   finished  : boolean;
  431.   key       : char;
  432.  
  433. begin
  434.   linecount := 0;
  435.   sect := sector;
  436.   finished := false;
  437.   while not finished do begin
  438.     reset(doco);
  439.     seek(doco, sect);
  440.     clrscr;
  441.     highon;
  442.     write('------------------------------ SYSTEM DOCUMENTATION ',
  443.             '----------------------------');
  444.     highoff;
  445.     gotoxy(1,firstline);
  446.     print(scrnsize, screen, stopped, linecount);
  447.     gotoxy(1,scrnsize+firstline+1);
  448.     highon;
  449.     write('---------- PgUp, PgDn, Home to print this page, End to return ',
  450.           'to index ---------');
  451.     highoff;
  452.     read(kbd, key);
  453.     if key = esc then read(kbd, key);
  454.     case key of
  455.       pgup : begin
  456.              sect := sect - scrnsize;
  457.              if sect <= 0 then sect := 0;
  458.              end;
  459.       pgdn : if (sect+linecount < size_of_file) then sect := sect + linecount;
  460.       nd   : finished := true;
  461.       home : begin
  462.              reset(doco);
  463.              seek(doco, sect);
  464.              print(printlength, printer, stopped, linecount);
  465.              end;
  466.       else   ;
  467.     end {case};
  468.   end {while};
  469. end;
  470.  
  471. {----------------------------------------------------------}
  472.  
  473. procedure find_prev_scrn(var curscr : scrn_ptr);
  474.  
  475. var curptr : scrn_ptr;
  476.  
  477. begin
  478.   if not (curscr = contents) then begin  {check for start}
  479.     curptr := contents;
  480.     while (curptr^.next_scr <> curscr) and (curptr^.next_scr <> nil) do
  481.       curptr := curptr^.next_scr;
  482.     {end do}
  483.     curscr := curptr;
  484.   end; {if}
  485. end;
  486.  
  487. {----------------------------------------------------------}
  488.  
  489. begin {main program}
  490.   init;
  491.   build_contents;   {also initialises vars}
  492.   curscr := contents;
  493.   size_of_file := filesize(doco);
  494.   display_contents(curscr, curline);
  495.   while not finished do begin
  496.     read(kbd, key);
  497.     if key = esc then read(kbd, key);
  498.     case key of
  499.       pgdn  :  begin
  500.                  if curscr^.next_scr <> nil then curscr := curscr^.next_scr;
  501.                  curline := 1;
  502.                  display_contents(curscr, curline);
  503.                end;
  504.       pgup  :  begin
  505.                  find_prev_scrn(curscr);
  506.                  curline := maxline;
  507.                  display_contents(curscr, curline);
  508.                end;
  509.       lnup  :  begin
  510.                  curline := curline - 1;
  511.                  if curline < 1 then begin
  512.                    find_prev_scrn(curscr);
  513.                    curline := maxline;
  514.                    display_contents(curscr, curline);
  515.                    end
  516.                  else begin
  517.                    gotoxy(1, curline + 1 + firstline);
  518.                    highoff;
  519.                    writeln(curscr^.scrn[curline+1].detail,
  520.                            ' ':78-length(curscr^.scrn[curline+1].detail));
  521.                    gotoxy(1, curline + firstline);
  522.                    highon;
  523.                    writeln(curscr^.scrn[curline].detail,
  524.                            ' ':78-length(curscr^.scrn[curline].detail));
  525.                    gotoxy(78, curline + firstline);
  526.                    highoff;
  527.                  end {if};
  528.                end;
  529.       lndn  :  begin
  530.                  curline := curline + 1;
  531.                  if curline >= maxline then begin
  532.                    if curscr^.next_scr <> nil then curscr := curscr^.next_scr;
  533.                    curline :=  1;
  534.                    display_contents(curscr, curline);
  535.                    end
  536.                  else begin
  537.                    gotoxy(1, curline - 1 + firstline);
  538.                    highoff;
  539.                    writeln(curscr^.scrn[curline-1].detail,
  540.                            ' ':78-length(curscr^.scrn[curline-1].detail));
  541.                    gotoxy(1, curline + firstline);
  542.                    highon;
  543.                    writeln(curscr^.scrn[curline].detail,
  544.                            ' ':78-length(curscr^.scrn[curline].detail));
  545.                    gotoxy(78, curline + firstline);
  546.                    highoff;
  547.                  end;
  548.                end;
  549.       nd    :  finished := true;
  550.       home  :  begin
  551.                lpr;
  552.                display_contents(curscr, curline);
  553.                end;
  554.       cr    :  begin
  555.                display_page(curscr^.scrn[curline].sect);
  556.                display_contents(curscr, curline);
  557.                end;
  558.     end; {case}
  559.   end; {do while not finished}
  560.   crtinit;
  561. end.  {program}
  562.