home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / MBUG / MBUG013.ARC / GETYES.FUN < prev    next >
Text File  |  1979-12-31  |  2KB  |  58 lines
  1. function GETYES : boolean;
  2.  
  3. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
  4. {* Secure from the console a reply of yes (y) or no (n).             *}
  5. {* Return "true" if yes, "false" otherwise.                          *}
  6. (* Note - while this function is employed specifically for the       *)
  7. (*        program ANIMAL.PAS, it may, of course, be used with        *)
  8. (*        advantage in other programs.                               *)
  9. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
  10.  
  11. const
  12.   suffix   = '? (Y/N)  ';
  13.   prompt   = '  Please reply yes (Y) or no (N):  ';
  14.   yes      = 'YES';
  15.   no       = 'NO';
  16.  
  17. var
  18.   ans       : char;
  19.   gotreply  : boolean;
  20.   messy     : boolean;
  21.  
  22. begin {getyes function}
  23.   write(suffix);
  24.   lowvideo;
  25.   gotreply  := false;
  26.   getyes    := false;
  27.   messy     := false;
  28.   while gotreply = false do
  29.     begin {while}
  30.       read(kbd,ans);
  31.       case ans of
  32.            'Y', 'y' : begin {YES processor}
  33.                         writeln(yes);
  34.                         gotreply := true;
  35.                         getyes := true;
  36.                         normvideo
  37.                       end;  {YES processor}
  38.            'N', 'n' : begin {NO processor}
  39.                         writeln(no);
  40.                         gotreply := true;
  41.                         getyes := false;
  42.                         normvideo
  43.                       end {NO processor}
  44.         end; {case}
  45.       if not gotreply
  46.         then begin {if not gotreply}
  47.                if messy
  48.                  then delline
  49.                  else begin
  50.                         clreol;
  51.                         writeln
  52.                       end;
  53.                write(^G,prompt);
  54.                messy := true
  55.              end {if not gotreply}
  56.     end; {while}
  57. end; {getyes function}
  58.