Programmer 7500/MAX_PROGRAMMERS.iso/PROGRAMS/UTILS/DOS_HELP/PC_HELP2.ZIP/HELP.PAS

Pascal/Delphi Source File | 1986-01-21 | 25.1 KB | 638 lines

{******************************************************************************
*                                                                             *
*                     IBM PERSONAL COMPUTER ON-LINE HELP                      *
*                         V5.1 by D.N.Ikle' 01/20/85                          *
*                         For public domain use only                          *
*                                                                             *
*       This Turbo Pascal V3.0 program displays HELP screens for the          *
*       commands and utilities on a hard disk system. The screens are         *
*       stored as text files of the same name as the command with the         *
*       extension .### in sub-directories accessed through the public         *
*       utility DPATH.  This version contains numerous improvements over      *
*       earlier versions that make program execution faster and simplify      *
*       its structure.  In addition, the instruction screen is stored         *
*       internally as an array, the heap is used to save and restore the      *
*       initial display screen, all writing to the screen is done             *
*       through the video memory, and the keyword entry field on the          *
*       main menu can be edited and is limited to 8 characters.  The          *
*       program has been tested on an IBM PC/XT, an IBM AT, and on            *
*       several PC clones with both color and monochrome monitors.            *
*                                                                             *
*       Copyright 1985 by David N. Ikle'.  All rights reserved.               *
*                                                                             *
*                              David N. Ikle'                                 *
*                              1671 Newport St.                               *
*                              Denver, CO 80220                               *
*                              303-333-9322                                   *
*                                                                             *
******************************************************************************}
{NOTE: Compiled with maximum free dynamic memory = $0800 paragraphs}
program help;
type
  regpack               = record
                          ax,bx,cx,dx,bp,si,di,ds,es,flags : integer;
                          end;
  string80              = string[80];
  string68              = string[68];
  string12              = string[12];
  string8               = string[8];
  text_array            = array[1..184] of string80;
  menu_array            = array[1..11] of string80;
  help_array            = array[1..23] of string80;
  stack                 = array[1..25] of string[160];
var
  terminate             : boolean;
  arg_number            : integer;
  row,line_count        : integer;
  start_last_page       : integer;
  text_buffer           : text_array;
  key_char,key_scan     : byte;
  help_name             : string8;
  display               : string12;
  cursor_x,cursor_y     : integer;
  mono_screen           : char absolute $B000:$0000;
  colo_screen           : char absolute $B800:$0000;
  screen_stack          : ^stack;
  attr_hi,attr_lo       : byte;
const
  max_rows  : integer   = 23;    {max number of text lines in the display}
  max_lines : integer   = 184;   {max number of lines in the text files}
  message : string68 =
    'Press Ent to return; Esc to exit; Up,Dn,PgUp,PgDn,Home,End to scroll';
  menu : menu_array =
    ('                                              ',
     '      IBM PERSONAL COMPUTER ON-LINE HELP      ',
     '          V5.1 by D.N.Ikle'' 01/20/85          ',
     '          For public domain use only          ',
     '                                              ',
     '                                              ',
     '                                              ',
     '  Keywords are names of commands or features  ',
     '       Enter ? or HELP for instructions       ',
     '             Press Enter to quit              ',
     '                                              ');
  help : help_array =
('                     IBM PERSONAL COMPUTER ON-LINE HELP                     ',
 '                                                                            ',
 '                         Usage : HELP [keyword ...]                         ',
 '                                                                            ',
 'The optional keyword can be ?  (to display this screen), the name of a DOS  ',
 'or other system command or utility, or the name of certain system features. ',
 'The keyword HELP provides a detailed description of the HELP facility and a ',
 'list of the keywords that describe the system features.  The keyword        ',
 'COMMANDS displays a list of all the commands on the system.  Entry of HELP  ',
 'with no keywords displays a keyword entry menu from which the Lt, Rt, Home, ',
 'End, Ins, Del, Back, and Esc keys can be used to edit the eight character   ',
 'keyword entry field.  Invalid keywords entered on the command line or on the',
 'entry menu produce a speaker tone, and the keyword entry menu is displayed  ',
 'with the invalid entry to be edited.  Following entry of a valid keyword, up',
 'to 8 screens of text are displayed from the file that describes the command,',
 'utility, or feature.  From any HELP screen, press Enter to return to the    ',
 'entry menu or to display HELP for the next keyword on the command line, or  ',
 'press Escape to return to the operating system.  The cursor control keys Up,',
 'Dn, PgUp, PgDn, Home and End can be used to scroll the file a line or a page',
 'at a time or to display the first or last page of the file.  Line 25 of the ',
 'display summarizes these functions and identifies the end of the file.      ',
 '                                                                            ',
'                         Press any key to continue                          ');
{*****************************************************************************}
procedure set_display;            {identifies monitor and sets attributes}
                                  (* requires types string12, regpack *)
                                  (* requires variables attr_hi, attr_lo,
                                     and dsiplay *)
var
  regs : regpack;
begin
  intr ($11,regs);
  if regs.ax and 48 = 48
    then
      begin
        display := 'monochrome';
        attr_hi := 15;
        attr_lo := 07;
      end
    else
      begin
        display := 'color';
        attr_hi := 12;
        attr_lo := 10;
      end;
end; {set_display}
{*****************************************************************************}
procedure cursor_off;             {sets cursor to blank}
                                  {adapted from procedure by Mark Brown}
                                  (* requires type regpack *)
var
  regs : regpack;
begin
  with regs do
    begin
      ax := $0100;
      bx := 0;
      cx := $100 * 32;
      intr ($10,regs);
    end;
end; {cursor_off}
{*****************************************************************************}
procedure cursor_on;              {sets cursor to normal}
                                  {adapted from procedure by Mark Brown}
                                  (* requires type regpack *)
                                  (* requires variable display *)
var
  regs : regpack;
begin
  with regs do
    begin
      ax := $0100;
      bx := 0;
      if display = 'monochrome' then
        cx := 13 + $100 * 12
      else
        cx := 7 + $100 * 6;
      intr ($10,regs);
    end;
end; {cursor_on}
{*****************************************************************************}
procedure inkey                   {interprets keyboard scan codes}
  (var key_char,key_scan : byte); {ASCII and extended code of keyboard key}
var
  regs : regpack;
begin
  with regs do
    begin
      ax := $0000;
      intr($16,regs);
      key_char := lo(ax);
      key_scan := hi(ax);
    end;
end; {inkey}
{*****************************************************************************}
procedure push_screen;            {save display contents when HELP called}
                                  (* requires variables display,screen_stack^,
                                     mono_screen, and colo_screen *)
begin
  if display = 'monochrome' then
    move(mono_screen,screen_stack^,4000)
  else
    move(colo_screen,screen_stack^,4000);
end; {push_screen}
{*****************************************************************************}
procedure pop_screen;             {restore display to when HELP called}
                                  (* requires variables display,screen_stack^,
                                     mono_screen, and colo_screen *)
begin
  if display = 'monochrome' then
    move(screen_stack^,mono_screen,4000)
  else
    move(screen_stack^,colo_screen,4000);
end; {pop_screen}
{*****************************************************************************}
procedure fastwrite               {writes lines of text to the screen buffer}
  (col,row,attrib : byte;         {display position and attribute}
   str            : string80);    {character string to be displayed}
                                  {procedure provided by Marshall Brain}
                                  (* requires type string80 *)
begin
  col := col - 1;
  row := row - 1;
  inline
    ($1E/$1E/$8A/$86/row/$B3/$50/$F6/$E3/$2B/$DB/$8A/$9E/col/
     $03/$C3/$03/$C0/$8B/$F8/$be/$00/$00/$8A/$BE/attrib/
     $8a/$8e/str/$22/$c9/$74/$3e/$2b/$c0/$8E/$D8/$A0/$49/$04/
     $1F/$2C/$07/$74/$22/$BA/$00/$B8/$8E/$DA/$BA/$DA/$03/$46/
     $8a/$9A/str/$EC/$A8/$01/$75/$FB/$FA/$EC/$A8/$01/$74/$FB/
     $89/$1D/$47/$47/$E2/$Ea/$2A/$C0/$74/$10/$BA/$00/$B0/
     $8E/$DA/$46/$8a/$9A/str/$89/$1D/$47/$47/$E2/$F5/$1F);
end; {fastwrite}
{*****************************************************************************}
procedure beep                    {sounds a tone on the system speaker}
  (tone,time:integer);            {frequency and duration of tone}
begin
  sound(tone);
  delay(time);
  nosound;
end; {beep}
{*****************************************************************************}
procedure drawbox                 {draws a box connecting specified points}
  (x1,y1,x2,y2   : integer);      {coordinates of upper-left and lower-right}
                                  (* requires procedure fastwrite *)
                                  (* requires constant attr_hi *)
var
  i  : integer;
const
  ch_lr : char = #186;            {left and right sides}
  ch_tr : char = #187;            {top right corner}
  ch_br : char = #188;            {bottom right corner}
  ch_bl : char = #200;            {bottom left corner}
  ch_tl : char = #201;            {top left corner}
  ch_tb : char = #205;            {top and bottom sides}
begin
  fastwrite(x1,y1,attr_hi,ch_tl);
  for i := x1+1 to x2-1 do fastwrite(i,y1,attr_hi,ch_tb);
  fastwrite(x2,y1,attr_hi,ch_tr);
  for i := y1+1 to y2-1 do
    begin
      fastwrite(x1,i,attr_hi,ch_lr);
      fastwrite(x2,i,attr_hi,ch_lr);
    end;
  fastwrite(x1,y2,attr_hi,ch_bl);
  for i := x1+1 to x2-1 do fastwrite(i,y2,attr_hi,ch_tb);
  fastwrite(x2,y2,attr_hi,ch_br);
end; {drawbox}
{*****************************************************************************}
procedure get_string              {input character string with edit control}
  (var answer       : string8);   {character string to be input}
                                  {adapted from procedures by Brenston Worrell}
                                  (* requires procedures inkey and beep *)
var
  ch                : char;
  row,col,cloc      : integer;
  cur_string        : string8;
  key_char,key_scan : byte;
const
  anslen : integer = 8;
  blank = '        ';
procedure invalid_key;
  begin
    beep(150,75);
  end; {invalid_key}
procedure write_string;
  begin
    gotoxy(col,row);
    write(cur_string + copy(blank,1,anslen-length(cur_string)));
    gotoxy(cloc,row);
  end; {write_string}
procedure write_char;
  begin
    if (cloc - col + 1) <= anslen then
      begin
        write(ch);
        cur_string := copy(cur_string,1,cloc-col) + ch +
                      copy(cur_string,cloc-col+2,anslen);
        cloc := cloc + 1;
      end
    else
      invalid_key;
  end; {write_char}
procedure back_space;
  begin
    if cloc <= col then
      invalid_key
    else
      begin
        delete(cur_string,cloc-col,1);
        cloc := cloc - 1;
        write_string;
      end;
  end; {back_space}
procedure rt_arrow;
  begin
    if cloc < (col + anslen -1) then
      begin
        cloc := cloc + 1;
        gotoxy(cloc,row);
      end
    else
      invalid_key;
  end; {rt_arrow}
procedure lt_arrow;
  begin
    if cloc > col then
      begin
        cloc := cloc - 1;
        gotoxy(cloc,row);
      end
    else
      invalid_key;
  end; {lt_arrow}
procedure insert_char;
  begin
    if (length(cur_string) < anslen) and
       ((cloc - col +1) <= length(cur_string)) then
      begin
        insert(' ',cur_string,cloc-col+1);
        write_string;
      end
    else
      invalid_key;
  end; {insert_char}
procedure delete_char;
  begin
    if (cloc - col + 1) <= length(cur_string) then
      begin
        delete(cur_string,cloc-col+1,1);
        write_string;
      end
    else
      invalid_key;
  end; {delete_char}
begin
  col := wherex;
  row := wherey;
  cloc := col;
  cur_string := answer;
  repeat
    inkey(key_char,key_scan);
    ch := chr(key_char);
    case key_char of
       0 : begin                  {extended key codes}
             case key_scan of
               71 : begin                                {home key}
                      cloc := col;
                      gotoxy(cloc,row);
                    end;
               75 : lt_arrow;                            {left arrow}
               77 : rt_arrow;                            {right arrow}
               79 : begin                                {end key}
                      cloc := col + length(cur_string);
                      gotoxy(cloc,row);
                    end;
               82 : insert_char;                         {insert}
               83 : delete_char;                         {delete}
             else
               invalid_key;
             end;
           end;
       8 : back_space;                                   {back space}
      13 : answer := cur_string;                         {enter}
      27 : begin                                         {escape}
             cloc := col;
             cur_string := '';
             write_string;
           end;
      65..90  : write_char;                              {upper case letters}
      97..122 : write_char;                              {lower case letters}
      48..57  : write_char;                              {numeric digits}
      33,35..41,45,63,64,95,96,123,125 : write_char;     {special characters}
    else
      invalid_key;
    end;
  until key_char = 13;
end; {get_string}
{*****************************************************************************}
procedure get_file                {reads a text file into an array}
  (file_name       : string12;    {name of text file}
   var file_exist  : boolean);    {true, if file exists; false, otherwise}
                                  (* requires procedure beep *)
                                  (* requires types text_array, string12
                                     and string80 *)
                                  (* requires variables line_count,
                                     start_last_page and text_buffer *)
                                  (* requires constant max_lines *)
type
  text_file        = text[$800];
var
  infile           : text_file;
  cur_line,blank   : string80;
const
  blank1 = '                                        ';
  blank2 = '                                        ';
begin
  blank := blank1 + blank2;
  file_exist := false;
  assign (infile,file_name);
  {$I-} reset (infile) {$I+};
  if ioresult <> 0 then
    beep(200,400)
  else
    begin
      file_exist := true;
      line_count := 0;
      repeat
        line_count := line_count + 1;
        readln(infile,cur_line);
        text_buffer[line_count] := cur_line +
          copy(blank,1,80-length(cur_line));
      until (line_count >= max_lines) or eof(infile);
      close (infile);
      if line_count <= max_rows then
        start_last_page := 1
      else
        start_last_page := line_count - max_rows + 1;
    end;
end; {get_file}
{******************************************************************************}
procedure input_menu              {inputs HELP names from the main menu}
  (var help_name    : string8;    {name of requested HELP}
       edit_mode    : boolean);   {true, if editing invalid entry on the
                                   command line; false, otherwise}
                                  (* requires procedures fatswrite, drawbox,
                                     get_string, get_file *)
                                  (* requires types string8,text_array and
                                     menu_array *)
                                  (* requires variables text_buffer, and
                                     line_count *)
                                  (* requires constants attr_hi, attr_lo,
                                     and menu *)
var
  row             : integer;
  valid_name      : boolean;
  file_name       : string12;
begin
  cursor_on;
  valid_name := false;
  drawbox(17,6,64,18);
  for row := 1 to 11 do fastwrite(18,row+6,attr_lo,menu[row]);
  gotoxy (28,12);
  textcolor(attr_hi);
  write ('Enter keyword ==> ');
  if edit_mode then
    write(help_name)
  else
    help_name := '';
  repeat
    gotoxy(46,12);
    get_string(help_name);
    file_name := help_name + '.###';
    if (help_name = '') or (help_name = '?') then
      valid_name := true
    else
      get_file(file_name,valid_name);
  until valid_name;
  textcolor(attr_lo);
  cursor_off;
end; {input_menu}
{*****************************************************************************}
procedure input_parm              {inputs HELP names from the command line}
  (var arg_number   : integer;    {number of arguement on the command line}
   var help_name    : string8);   {name of requested HELP}
                                  (* requires procedures get_file, pop_screen,
                                     and input_menu *)
                                  (* requires types string8,string12 *)
var
  valid_name      : boolean;
  file_name       : string12;
begin
  repeat
    valid_name := false;
    arg_number := arg_number + 1;
    help_name := paramstr(arg_number);
    if help_name <> '?' then
      begin
        file_name := help_name + '.###';
        get_file(file_name,valid_name);
        if not valid_name then
          begin
            pop_screen;
            input_menu(help_name,true);
          end;
      end;
  until (help_name <> '') or (arg_number >= paramcount);
end; {input_parm}
{*****************************************************************************}
procedure get_key                 {interprets key codes from the HELP screen}
  (var first_line   : integer;    {number of first line to be displayed}
   var enter_key    : boolean;    {true, if enter pressed; false, otherwise}
   var escape_key   : boolean);   {true, if escape pressed; false, otherwise}
                                  (* requires procedures inkey and beep *)
                                  (* requires variable start_last_page *)
                                  (* requires constant max_rows *)
var
  key_char,key_scan : byte;
  valid_key         : boolean;
function min(x,y:integer):integer;
 begin
    min := x;
    if y < x then min := y;
  end; {min}
function max(x,y:integer):integer;
  begin
    max := x;
    if y > x then max := y;
  end; {max}
procedure invalid_key;
  begin
    beep(150,75);
    valid_key := false;
  end; {invalid_key}
begin
  repeat
    inkey(key_char,key_scan);
    valid_key := true;
    case key_char of
       0 : begin                    {extended key codes}
             case key_scan of
               72 : if first_line <= 1 then                     {up arrow}
                      invalid_key
                    else
                      first_line := first_line - 1;
               80 : if first_line >= start_last_page then       {down arrow}
                      invalid_key
                    else
                      first_line := first_line + 1;
               73 : if first_line <= 1 then                     {page up}
                      invalid_key
                    else
                      first_line := max(1,first_line-max_rows);
               81 : if first_line >= start_last_page then       {page down}
                      invalid_key
                    else
                      first_line := min(start_last_page,first_line+max_rows);
               71 : if first_line <= 1 then                     {home key}
                      invalid_key
                    else
                      first_line := 1;
               79 : if first_line >= start_last_page then       {end key}
                      invalid_key
                    else
                      first_line := start_last_page;
             else
               invalid_key;
             end;
           end;
      13 : enter_key := true;                    {enter}
      27 : escape_key := true;                   {escape}
    else
      invalid_key
    end;
  until valid_key;
end; {get_key}
{*****************************************************************************}
procedure display_help            {displays individual HELP screens}
  (var escape_key   : boolean);   {true, if escape pressed; false, otherwise}
                                  (* requires procedures fastwrite,get_key *)
                                  (* requires types string80, string68 and
                                     text_array *)
                                  (* requires variables text_buffer,
                                     and line_count *)
                                  (* requires constants max_rows,message *)
var
  enter_key       : boolean;
  first_line      : integer;
  line, row       : integer;
  line_25         : string80;
begin
  enter_key := false;
  first_line := 1;
  clrscr;
  repeat
    row := 0;
    repeat
      row := row + 1;
      line := first_line + row - 1;
      fastwrite(1,row,attr_lo,text_buffer[line]);
    until (row >= max_rows) or (line >= line_count);
    if line >= line_count then
      line_25 := message + ' <EndOfFile>'
    else
      line_25 := message + ' <Continued>';
    fastwrite(1,25,attr_hi,line_25);
    get_key(first_line,enter_key,escape_key);
  until enter_key or escape_key;
end; {display_help}
{*****************************************************************************}
begin
  if (memavail < 0) or (memavail >= 256) then
    begin
      arg_number := 0;                        {initialize variables}
      terminate := false;
      set_display;
      cursor_x := wherex;
      cursor_y := wherey;
      new(screen_stack);
      push_screen;
      cursor_off;                             {remove cursor}
      repeat
        if (paramcount > 0) and (arg_number < paramcount) then
          begin                               {input from command line}
            input_parm(arg_number,help_name);
            if (help_name = '') and (arg_number >= paramcount) then
              terminate := true;
          end
        else
          begin                               {input from main menu}
            pop_screen;
            input_menu(help_name,false);
            if help_name = '' then terminate := true;
          end;
        if terminate then
          begin                               {exit to original screen}
            pop_screen;
            gotoxy(cursor_x,cursor_y-1);
          end
        else                                  {display requested HELP}
          begin
            if help_name = '?' then           {display ? screen}
              begin
                clrscr;
                drawbox(1,1,80,25);
                for row := 1 to 23 do fastwrite(3,row+1,attr_lo,help[row]);
                inkey(key_char,key_scan);
              end
            else                              {display HELP screens}
              display_help(terminate);
            if terminate then
              begin                           {exit on line 25}
                gotoxy (1,25);
                delline;
                gotoxy (1,24);
              end;
          end;
      until terminate;
    end
  else                                        {terminate if insufficient heap}
      writeln ('Insufficient Heap Space (',memavail*16,
                ' bytes) - HELP Terminated');
  cursor_on;                                  {restore cursor}
end. {help}