Simtel MSDOS 1992 June/SIMTEL_0692.cdr/msdos/sysutl/stack.arc/MANUAL.PAS

Pascal/Delphi Source File | 1987-12-10 | 15.4 KB | 562 lines

PROGRAM MANUAL;

const

{ See documentation for notes on how to modify these constants }

  bold     = #02;         {wordstar bold face}
  double   = #04;
  pagelines = 66;         {default lines per printed page}
  tab_posn = 10;
  striptop = 127;        {used to strip top bit off bytes}
{colours for monitor control}
  lightgrey = 7;
  black     = 0;
  lightblue = 9;
  yellow    = 14;


  title    = '         Documentation Display System - Version 1.4, Dec 87';
  author   = '                                        by Shane Bergl';
  scrnsize = 21;
  PageWidth = 95;
  FormFeed = #12;
  ctrla    = #01;         {control a char}
  onefox   = #31;         { 1F hex}
  cr       = #13;         {carriage return}
  lf       = #10;         {line feed}
  pgup     = #73;         {PgUp key less ESC code}
  pgdn     = #81;         {PgDn key less ESC code}
  lnup     = #72;         {up arrow less ESC code}
  lndn     = #80;         {down arrow less ESC code}
  nd       = #79;         {End key less ESC code}
  home     = #71;         {home key less ESC code}
  esc      = #27;
  blank    = #32;
  maxline  = 20;          {max lines per screen}
  firstline = 2;          {first line for text}
  text_size = 512;
  space80  =
'                                                                                 ';
  screen   = true;
  printer  = false;

type
  filename   =  string[12];
  line       =  record
                  detail   :  string[75];
                  sect     :  integer;
                end;
  scr        =  array[1..20] of line;
  scrn_ptr   =  ^scrn_type;
  scrn_type  =  record
                  scrn     :  scr;
                  next_scr :  scrn_ptr;
                end;
  workstr    =  string[79];
  buff       =  array[1..512] of byte;

var
  infile     :  file of buff;
  doco       :  file of workstr;
  index      :  file of scr;
  testfile   :  text;
  doco_file_name : filename;
  heading,
  boldface,
  finished   :  boolean;
  size_of_file,
  curline,
  printlength :  integer;
  curscr,
  contents   :  scrn_ptr;
  key        :  char;

{----------------------------------------------------------}

procedure highon;

begin
  textbackground(lightgrey);
  textcolor(black);
end;

{----------------------------------------------------------}

procedure highoff;

begin
  textbackground(lightblue);
  textcolor(yellow);
end;

{----------------------------------------------------------}

procedure init;

var result : integer;

Function exists(name: filename): boolean;
  var  fp : file;
  begin
    Assign(fp,Name);
    {$I-} reset(fp); {$I+}
    If IOresult <> 0 then
      exists := False
    else
      exists := True;
    {end if}
    close(fp);
  end { exists };


Procedure checkfiles;
  begin
    If ParamCount = 0 then begin
      Write('Enter documentation name: ');
      readln(doco_file_name);
      end
    else begin
      doco_file_name := ParamStr(1);
    end;
    If Not exists(doco_file_name + '.DOC') then
      if not exists(doco_file_name + '.IDX')
      and not exists(doco_file_name + '.DOK') then begin
        Writeln('ERROR -- documentation not found:  ',doco_file_name);
        Halt;
      end; {if}
  end {checkfiles};

begin {init}
  clrscr;
  checkfiles;
  if ParamCount < 2 then
    Printlength := pagelines
  else
    val(ParamStr(2),PrintLength,result);
  {end if}
  PrintLength := PrintLength - 6;  {3 lines each for header and footer}
  highoff;
  gotoxy(1, 10);
  writeln(' ':29, 'Please wait', ' ':39);
{a quick bit of publicity}
  writeln;
  writeln(title, ' ':78-length(title));
  writeln(author, ' ':78-length(author));
  writeln;
{end of ad}
  contents := nil;
  curline := 1;
  finished := false;
  curscr := nil;
end;

{----------------------------------------------------------}

Function CmdLine(inbuf : workstr) : boolean;

begin
  if (inbuf[1] = '.') and ((inbuf[2]='P')or(inbuf[2]='p'))
  and ((inbuf[3]='A')or(inbuf[3]='a')) then
    CmdLine := true
  else
    CmdLine := false;
  {end if}
end;

{----------------------------------------------------------}

procedure print(lines2print:integer; screen:boolean; var stopped:boolean;
                 var linecount:integer);

var  cur_row  : integer;
     prtstr,
     printstr,
     dupe_str : workstr;
     dupe     : boolean;
     i        : integer;

begin
  cur_row := 0;
  if not screen then begin
    gotoxy(1,scrnsize+firstline+1);
    highon;
    write('Printing, press any key to abort                                 ');
    highoff;
  end {if};
  repeat
    read(doco, printstr);
    if CmdLine(printstr) then
      if not screen then
        cur_row := printlength
      else
        cur_row := cur_row
      {end if} {Note: dummy statement required so IF..THEN..ELSEs work properly}
    else begin
      cur_row := succ(cur_row);
      dupe_str := '';
      prtstr := '';
      dupe := false;
      for i := 1 to length(PrintStr) do begin
        if (printstr[i] >= blank) or (printstr[i] = bold)
        or (printstr[i] = double) then
          if (printstr[i] = bold) or (printstr[i] = double) then
            dupe := not(dupe)
          else
            if dupe then
              dupe_str := dupe_str + PrintStr[i]
            else
              dupe_str := dupe_str + ' ';
            {end if}
          {end if}
        {end if}
        if printstr[i] >= blank then prtstr := prtstr + printstr[i];
      end {for};
      if (dupe_str <> '') and not screen then write(lst,'          ', dupe_str, cr);
      if screen then writeln(prtstr) else writeln(lst,'          ', prtstr);
    end {if};
  until (cur_row >= lines2print) or (cur_row >= printlength) or keypressed or eof(doco);
  if keypressed then stopped := true else stopped := false;
  linecount := cur_row;
end {print};

{----------------------------------------------------------}

procedure lpr;

var
  stopped   :  boolean;
  i,
  pagenum   :  integer;

begin
  pagenum := 1;
  reset(doco);
  repeat
    writeln(lst);
    writeln(lst, ' ':(pagewidth div 2)-4, pagenum:3);
    writeln(lst);
    print(printlength, printer, stopped, i);
    write(lst, formfeed);
    pagenum := succ(pagenum);
  until eof(doco) or stopped;
end;


procedure build_contents;


procedure create_index;
{---------------------}
  var
    i, k, curln, j, chrposn,
    sect     : integer;
    buf      : buff;
    bite     : byte;
    outstr   : workstr;
    ch       : char;
    line_of_blanks : boolean;


procedure newrec;

begin
  curln := 1;
  if curscr = nil then begin
    new(contents);
    curscr := contents;
    end
  else begin
    new(curscr^.next_scr);
    curscr := curscr^.next_scr;
  end; {if}
  curscr^.next_scr := nil;
  for k := 1 to maxline do begin
    curscr^.scrn[k].detail := '     ';
    curscr^.scrn[k].sect := 0;
  end; {for}
end;


  begin
    writeln(' ':28, 'Building Index', ' ':37);
    curscr := nil;
    heading := false;
    line_of_blanks := true;
    sect := 0;
    outstr := '';
    chrposn := 1;

  {build index}
    curln := maxline;
    while not eof(infile) do begin
      read(infile, buf);
      for i := 1 to 512 do begin
        ch := chr(buf[i] and striptop);
        case ch of
          bold : if heading then begin
                   heading := false;
                   end
                 else begin
                   heading := true;
                   curln := curln + 1;
                   if curln > maxline then newrec;
                   curscr^.scrn[curln].sect := sect;
                   if chrposn = 1 then
                     curscr^.scrn[curln].detail := curscr^.scrn[curln].detail
                     + '    '
                   else
                     if not line_of_blanks then
                       curscr^.scrn[curln].detail := curscr^.scrn[curln].detail
                       + '        '
                     else
                       if chrposn <= tab_posn then
                         curscr^.scrn[curln].detail
                         := curscr^.scrn[curln].detail + '         ';
                       {end if}
                     {end if}
                   {end if}
                 end; {if}
           cr : begin
                  if heading then heading := false;
                  write(doco, outstr);
                  outstr := '';
                  sect := sect + 1;
                  line_of_blanks := true;
                  chrposn := 1;
                 end;
          double : begin
                     line_of_blanks := false;
                     if heading then curscr^.scrn[curln].detail
                       := curscr^.scrn[curln].detail + ch;
                     {end if}
                     outstr := outstr + ch;
                     chrposn := succ(chrposn);
                   end;
          ctrla..onefox : ;
          else   begin
                 line_of_blanks := line_of_blanks and (ch = blank);
                 if heading then curscr^.scrn[curln].detail
                   := curscr^.scrn[curln].detail + ch;
                 outstr := outstr + ch;
                 chrposn := succ(chrposn);
                 end;
          end {case};
        end {for};
    end; {while}
  end; {create index}

begin {build contents}
  assign(index, doco_file_name + '.IDX');
  {$I-}
  reset(index);
  {$I+}
  if IOresult = 0 then begin
    assign(doco, doco_file_name + '.DOK');
    reset(doco);
    while not eof(index) do begin
      if contents = nil then begin
        new(curscr);
        contents := curscr;
        end
      else begin
        new(curscr^.next_scr);
        curscr := curscr^.next_scr;
      end; {if}
      read(index, curscr^.scrn);
      curscr^.next_scr := nil;
    end {while}
    end
  else begin
    assign(infile, doco_file_name + '.DOC');
    reset(infile);
    assign(doco, doco_file_name + '.DOK');
    rewrite(doco);
    create_index;
    close(doco);
    reset(doco);
    rewrite(index);
    curscr := contents;
    while curscr <> nil do begin
      write(index, curscr^.scrn);
      curscr := curscr^.next_scr;
    end; {while}
    close(index);
  end {if};
end {build contents};


{----------------------------------------------------------}

procedure display_contents(strt_scrn : scrn_ptr; curline : integer);

var
  i     :  integer;

begin
  clrscr;
  highon;
  writeln('----------------------------- SYSTEM DOCUMENTATION ',
          '-----------------------------');
  highoff;
  writeln(' ':78);
  gotoxy(1, firstline+1);
  with strt_scrn^ do for i := 1 to 20 do begin
    if scrn[i].detail <> '' then begin
      if i = curline then highon;
      writeln(scrn[i].detail, ' ':78-length(scrn[i].detail));
      if i = curline then highoff;
      end
    else
      writeln;
    {end if}
  end;
  writeln(' ':78);
  highon;
  write('-- PgUp, PgDn, End to exit, Home to print manual, ',
          'Enter to view selected item --');
  highoff;
end;

{----------------------------------------------------------}

procedure display_page(sector : integer);

var
  linecount,
  sect      : integer;
  buf       : workstr;
  stopped,
  finished  : boolean;
  key       : char;

begin
  linecount := 0;
  sect := sector;
  finished := false;
  while not finished do begin
    reset(doco);
    seek(doco, sect);
    clrscr;
    highon;
    write('------------------------------ SYSTEM DOCUMENTATION ',
            '----------------------------');
    highoff;
    gotoxy(1,firstline);
    print(scrnsize, screen, stopped, linecount);
    gotoxy(1,scrnsize+firstline+1);
    highon;
    write('---------- PgUp, PgDn, Home to print this page, End to return ',
          'to index ---------');
    highoff;
    read(kbd, key);
    if key = esc then read(kbd, key);
    case key of
      pgup : begin
             sect := sect - scrnsize;
             if sect <= 0 then sect := 0;
             end;
      pgdn : if (sect+linecount < size_of_file) then sect := sect + linecount;
      nd   : finished := true;
      home : begin
             reset(doco);
             seek(doco, sect);
             print(printlength, printer, stopped, linecount);
             end;
      else   ;
    end {case};
  end {while};
end;

{----------------------------------------------------------}

procedure find_prev_scrn(var curscr : scrn_ptr);

var curptr : scrn_ptr;

begin
  if not (curscr = contents) then begin  {check for start}
    curptr := contents;
    while (curptr^.next_scr <> curscr) and (curptr^.next_scr <> nil) do
      curptr := curptr^.next_scr;
    {end do}
    curscr := curptr;
  end; {if}
end;

{----------------------------------------------------------}

begin {main program}
  init;
  build_contents;   {also initialises vars}
  curscr := contents;
  size_of_file := filesize(doco);
  display_contents(curscr, curline);
  while not finished do begin
    read(kbd, key);
    if key = esc then read(kbd, key);
    case key of
      pgdn  :  begin
                 if curscr^.next_scr <> nil then curscr := curscr^.next_scr;
                 curline := 1;
                 display_contents(curscr, curline);
               end;
      pgup  :  begin
                 find_prev_scrn(curscr);
                 curline := maxline;
                 display_contents(curscr, curline);
               end;
      lnup  :  begin
                 curline := curline - 1;
                 if curline < 1 then begin
                   find_prev_scrn(curscr);
                   curline := maxline;
                   display_contents(curscr, curline);
                   end
                 else begin
                   gotoxy(1, curline + 1 + firstline);
                   highoff;
                   writeln(curscr^.scrn[curline+1].detail,
                           ' ':78-length(curscr^.scrn[curline+1].detail));
                   gotoxy(1, curline + firstline);
                   highon;
                   writeln(curscr^.scrn[curline].detail,
                           ' ':78-length(curscr^.scrn[curline].detail));
                   gotoxy(78, curline + firstline);
                   highoff;
                 end {if};
               end;
      lndn  :  begin
                 curline := curline + 1;
                 if curline >= maxline then begin
                   if curscr^.next_scr <> nil then curscr := curscr^.next_scr;
                   curline :=  1;
                   display_contents(curscr, curline);
                   end
                 else begin
                   gotoxy(1, curline - 1 + firstline);
                   highoff;
                   writeln(curscr^.scrn[curline-1].detail,
                           ' ':78-length(curscr^.scrn[curline-1].detail));
                   gotoxy(1, curline + firstline);
                   highon;
                   writeln(curscr^.scrn[curline].detail,
                           ' ':78-length(curscr^.scrn[curline].detail));
                   gotoxy(78, curline + firstline);
                   highoff;
                 end;
               end;
      nd    :  finished := true;
      home  :  begin
               lpr;
               display_contents(curscr, curline);
               end;
      cr    :  begin
               display_page(curscr^.scrn[curline].sect);
               display_contents(curscr, curline);
               end;
    end; {case}
  end; {do while not finished}
  crtinit;
end.  {program}