Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/ADC_TP3.ZIP/CMDKEY.PAS

Pascal/Delphi Source File | 1987-03-01 | 9.4 KB | 282 lines

Program CommandKeys;
{$U-,C-}
{Written March 27, 1985 by Carl Neiburger, Los Osos, Calif.}

{Here are four subroutines that install and interpret function
key commands.

They can allow you to:
    1: Write programs that can be installed on computers that use
       different function keys (ie arrows);
    2: Change your mind about what what you want function keys to do.

Getcmd works like the [C]ommand part of Tinst.  It asks you to
type command keys and prompts. The prompts are not necessary but can be
used in a help feature. As written, Getcmd identifies the commands
by number.  You can substitute a list of names like "Cursor Up" or
"Delete Word."  Getcmd lets you review (and change) the commands and
then writes the file "COMMAND.FIL" to preserve your choices.

Install retrieves the commands from the disk.

The main program initializes all the commands as empty strings.
This is necessary to prevent garbage.  In an application, the program
can look for "COMMAND.FIL."  If it doesn't find it, it can initialize
the commands and invoke Getcmd.

Cmdkey is the heart of the program. When invoked, it returns the
command number or zero if it doesn't recognize the command. The
statement, "case cmdkey of" can invoke other subroutines.

Test_Loop demonstrates the other subroutines.}

const
    cmdnum =    10; {This tells how many commands there will be}

type
    nos =       set of byte;
    str6 =      string[6];
    str15 =     string[15];
    cmdrec =    record
                  cmd:  str6;     {command sequences}
                  key:  str15     {prompts}
                end;
    recarray =  array[1..cmdnum] of cmdrec;

const
    keynos:     nos = [1..cmdnum];

var
    cmdarray:   recarray;          {list of commands}
    cmdfile:    file of recarray;
    i:          integer;
    choice,
    ch:         char;

procedure getcmds;

var
  len:   byte; {counts the length of screen displays}

  procedure printchar(ch: char);
  {This interprets commands on the screen}

  begin
    case ord(ch) of
       0..31:   begin  {command character}
                  write('^', chr(ord(ch) + 64));
                  len:= len + 3
                end;
       33..126: begin  {printable character}
                  write(ch);
                  len:= len + 2
                end
       else     begin  {delete or byte > 126}
                  write(ord(ch));
                  len:= len + 4
                end
    end; {case}
    write(' ')  {space between characters}
  end; {printchar}

 procedure readarray;

 var
    i, j, k:  byte;
    ok:       boolean;   {if no duplicates are present}
    ch:       char;
    rec:      cmdrec;    {dummy record}

  procedure readrecord(var item: cmdrec);

  var
    done:     boolean;

  begin;
    with item do begin
       cmd:= '';         {initialize dummy record}
       key:= '';
       write('Command ', i, ': ');
       if cmdarray[i].cmd = '' then write('<nothing>            ')
       else begin        {if command exists, say so}
         len:= 0;
         for j:= 1 to length(cmdarray[i].cmd) do printchar(cmdarray[i].cmd[j]);
         for j:= len to 20 do write(' ')
       end;
       len:= 0;
       repeat
         read(kbd, ch);
         if cmd = '' then begin    {if first character of command}
           case ch of
             '-' : done:= true;    {erase sequence}
             ^m  : begin           {copy sequence}
                     done:= true;
                     item:= cmdarray[i];
                     for j:= 1 to length(cmd) do printchar(cmd[j])
                   end
             else done:= false     {get new sequence}
           end; {case}
         end
         else if ch = ^m then done:= true; {carriage return means stop}
         if not done then begin
            printchar(ch);         {print new sequence}
            cmd := cmd + ch        {and remember it}
         end
       until (length(cmd) = 6) or done; {six is the maximum length allowed}
       if cmd = '' then writeln('<nothing>')
       else begin
         for j:= len to 20 do write(' ');
         write('Name: ');
         if key = '' then readln(key)  {if it's an old one, it has a prompt}
         else writeln(key)             {it it's a new one, it doesn't}
       end {else}
    end {with}
  end; {readrecord}

 begin  {readarray}
   for i:= 1 to cmdnum do begin
     ok:= true;                 {assume there's no duplication}
     writeln;
     readrecord(rec);
     with rec do begin          {start looking for duplicates}
       if (i > 1) and (cmd <> '') then begin
         j:= 1;
         repeat                 {if you find one and it's not a blank...}
           if (cmd <> '') and (cmd = cmdarray[j].cmd) then begin
              ok:= false;
              writeln;
              write('Commands ', i, ' and ', j, ' are both defined as ');
              for k:= 1 to length(cmd) do printchar(cmd[k]);
              writeln('Redefine command ', i);
              writeln;
              readrecord(rec)   {...ask for a different key sequence}
           end {if}
           else ok:= true;
           if ok then j:= j + 1
         until ok and (i = j)
       end {if i}
     end; {with}
     cmdarray[i]:= rec
   end {for}
 end; {readarray}

begin {getcmds}                 {This part just gives instructions}
  writeln('Enter command sequences of up to six characters and key');
  writeln('prompts of up to 15 characters. To terminate, enter a');
  writeln('carriage return.  Entering a carriage return alone retains');
  writeln('the old sequence. To delete "-".');
  repeat
    readarray;
    writeln;
    write('To continue, enter "C"; To review, enter "R"; To abort, enter "X".');
    repeat
      read(kbd, choice);
    until upcase(choice) in ['C', 'R', 'X'];
    if upcase(choice) = 'X' then halt;
    writeln
  until upcase(choice) = 'C';
  rewrite(cmdfile);            {and records new COMMAND.FIL}
  write(cmdfile,cmdarray);
  close(cmdfile);
  clrscr
end; {getcmds}

procedure install;
{To read COMMAND.FIL back into memory}

begin
  reset(cmdfile);
  read(cmdfile, cmdarray)
end;

Function Cmdkey(ch: char): integer;
{To identify function keys, Cmdkey looks at the characters
one at a time.  It keeps track of the functions in the set
"keys."  It throws out the functions that don't match until
it either finds a complete match or runs out of possibilities.}

var
   command:    integer;  {dummy value for Cmdkey}
   keys:       nos;      {set of function numbers}
   i,                    {index of characters in a command sequence}
   j:       byte;        {index of commands in array}

begin
   command:= 0;
   keys:= keynos;        {list all the function in the set}
   i:= 1;                {start with the first character  }
   repeat
     j:= 1;              {start with the first command in array}
     repeat
       if j in keys then begin                  {If command j hasn't}
           if ch <> cmdarray[j].cmd[i]          {been eliminated then}
             then keys:= keys - [j]             {consider eliminating it.}
           else if length(cmdarray[j].cmd) = i  {if it survives and}
              then command:= j                  {the length is right,}
        end; {if j}                             {it's a match. If it isn't,}
        if command = 0 then j:= j + 1           {try the next command}
     until (j = cmdnum + 1)                {till you reach the end of array}
        or (command <> 0)                  {or find a match}
        or (keys = []);                    {or run out of possibilities.}
     if (keys <> [])                       {If you haven't exhausted}
        and (command = 0) then begin       {the possibilities,then}
        j:= 1;                             {go to the top of the array}
        i:= succ(i);                       {and try the next character.}
        read(kbd, ch)
     end
   until (i = 7)                        {until you've run out of characters}
      or (keys = [])                    {or possible matches}
      or (command <> 0);                {or have found a match}
   cmdkey:= command
end;

procedure test_loop;
{This procedure prints normal characters and carriage returns.
It evaluates any other characters and tells you if it recognizes
them as a command sequence. It stops when you type the last
command key on your list, so don't forget what that is.}

var
    num:        integer;

begin
  writeln('Type ', cmdarray[cmdnum].key, ' to exit.');
  repeat
    num:= 0;
    read(kbd,ch);
    case ch of
      ^m:    writeln;
      ' '..'~': write(ch)
      else begin
         num:= cmdkey(ch);
         writeln;
         if num > 0 then writeln('>', cmdarray[num].key, '<')
         else writeln('Unrecognized command.')
      end
    end {case}
  until num = cmdnum
end;

begin; {main}
 clrscr;
 for i:= 1 to cmdnum do with cmdarray[i] do begin   {initialize array}
    cmd:= '';
    key:= ''
 end;
 assign(cmdfile, 'COMMAND.FIL');
 repeat
   writeln('1: create commands');
   writeln('2: recall commands');
   writeln('3: test commands');
   writeln('4: exit');
   write('==>');
   read(kbd, choice);
   clrscr;
   case choice of
        '1':   getcmds;
        '2':   install;
        '3':   test_loop
   end {case}
 until choice = '4'
end.