Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/MADTRB40.ZIP/ANSWER.INC

Text File | 1986-01-21 | 5.7 KB | 139 lines

Procedure Parse(Var Line : Str255; Var Word : Str80; Delim : Char);
{Removes first word in Line and returns it in Word.  Line is modified so that
 it no longer has leading blanks before the word is filled.  The delim constant
 is used to identify the symbol used to delimit words.  The Line variable is
 decreased in length by one word, and of course leading blanks, before it is
 returned}
Const
  Space  =  ' ';
Var
  Indx, Len  :  Integer;
Begin
  While Pos(Space, Line) = 1 Do     {remove leading blanks}
    Delete(Line, 1, 1);
  Len := Pos(Delim, Line);
  If Len = 0 then
    begin             {no delimiters left}
      Word := Line;
      Line := '';
    End
  Else If Len = 1 then
      begin                             {check for two delimiters in a row}
        Word := '';                      {return null string}
        Delete(Line, 1, Len);            {delete delimiter}
      End
    Else
      Begin                             {get word and delete from line}
        Word := Copy(Line, 1, Len -1);  {get all but delimiter}
        Delete(Line, 1, Len);            {delete word plus delimeter}
      End
End;  {of Parse}

Procedure LowToUp(Var Line : Str255);
{Converts characters in Line to upper case}
Var
  Indx, Len      : Integer;
Begin
  Len := Length(Line);
  For Indx := 1 to Len do
    Line[Indx] := UpCase(Line[Indx]);   {built-in TURBO function}
End;  {of LowToUp}

Procedure Answer(Ans : Str255; Var Posn : Integer; CaseSen : Boolean);
{Answer will motitor the keyboard and only allow entry of one of the possible
 matches found in Str255.  Responses in Ans should be separated by a comma
 and may be padded with blanks, although all leading blanks will be ignored
 when processing a response.  When enough keystrokes have been entered to
 identify a match as being unique, the rest of the response is displayed and
 the user can accept the answer by hitting return or can strike the backspace
 key and re-enter another valid response.  The procedure returns the ordinal
 position of the response to the calling program for further processing.
 CaseSen is used to determine is the response should be upper/lower case
 sensitive.}
Label
  Return, Start;
Var
  Indx           :  Integer;    {number of possible answers}
  ChPos          :  Integer;    {Chacter position index}
  Cnt            :  Integer;    {counter for correct matches}
  Match          :  Array[1..25] of Str80;       {possible answer array}
  Mtch           :  Array[1..25] of Boolean;        {Previous match array}
  StrPos         :  Integer;           {index for stepping through matches}
  Ch             :  Char;              {variable read from the keyboard}
  MtchLen        :  Integer;           {contains the length of the match}
  I              :  Integer;           {counter index}
Begin
  Indx := 0;
  If NOT CaseSen then               {Check upper/lower case sensitivity}
  LowToUp(Ans);                     {If not sensitive then capitalize all ans.}
  While Ans <> '' do                {Parse Ans into matching responses}
    Begin
      Indx := Indx +  1;               {find number of answers}
      Parse(Ans,Match[Indx],',');      {and put them in Match[array]}
    End;
  If Indx = 0 then                 {Check to see if a string was passed in Ans}
    Begin
      Write('No string was passed to use as a response, please check code.');
      Goto Return;
    End;
Start:
  For Cnt := 1 to 25 do Mtch[Cnt] := True; {Initialize pointers to all true}
  ChPos := 1;
  Repeat
    Cnt := 0;                             {set match counter}
    Read(Kbd, Ch);                        {Get characters from the keyboard}
    If NOT CaseSen then Ch := UpCase(Ch);
      For StrPos := 1 to Indx do          {Search all responses for matches}
        Begin
          If Mtch[StrPos] then            {Check for previous match}
            If Ch = Copy(Match[StrPos], ChPos, 1) then
              Begin
                Cnt  := Cnt + 1;             {Count the number of matches}
                Posn := StrPos;              {Enter the position of the last}
              End                           {match in the return variable.}
        End;
    If Cnt = 0 then             {Check for no match}
      If Ch = Chr(8) then          {Check for a backspace}
        Begin                   {If backspace has been hit then decrease}
          ChPos := ChPos -1;    {the character index by one.}
          If ChPos < 1 then     {If the backspace has been over used then}
            Begin               {reset to position one and beep.}
              ChPos := 1;
              Write(Chr(7));
            End
          Else
            Begin
              Write(Chr(8));
              Write(Chr(32));
              Write(Chr(8));
            End;
        End
      Else
        Write(Chr(7))      {If the character has no match just beep and}
    Else                        {don't write it to the screen}
      Begin
        For StrPos := 1 to Indx do
          If Ch <> Copy(Match[StrPos], ChPos, 1) then
            Mtch[StrPos] := False;
        ChPos := ChPos + 1;
        Write(Ch);           {Otherwise write the matching character to the}
      End;
  Until Cnt = 1;                 {screen.}
  MtchLen := Length(Match[Posn]) - ChPos + 1;
  Write(Copy(Match[Posn], ChPos, MtchLen));
  Repeat
   Read(Kbd, Ch);
   If Ch = Chr(8) then
    begin
     For I := 1 to Length(Match[Posn]) do Write(Chr(8));
     For I := 1 to Length(Match[Posn]) do Write(Chr(32));
     For I := 1 to Length(Match[Posn]) do Write(Chr(8));
     ChPos := 1;
     Goto Start;
    end
   else
    If Ord(Ch) <> 13 then Write (Chr(7));
  Until Ord(Ch) = 13;
Return:
End;  {of Answer}