home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TOOLKIT2.ZIP / TOOLKIT2.PAS
Encoding:
Pascal/Delphi Source File  |  1985-07-29  |  4.6 KB  |  173 lines
  1. {
  2.   TOOLKIT    Pascal  functions and procedures for interactive programs
  3.   Copyright (c) 1983 by Ronald Florence                                 
  4.  
  5.       RDREAL: reads a real number in decimal notation                   
  6.       RDINT: reads an integer between low and high limits               
  7.       RDCHAR: reads a char in a declared set                            
  8.       YES: reads a y/n response                                         
  9.       NOMORE: prompts "More?" and reads a response                      
  10.       PAUSE: waits until any key is pressed to continue                 
  11.  
  12.   The functions are used to speed up interactive input and to prevent   
  13.   "Data error in file USER" crashes. In a "repeat...until" loop, RDINT  
  14.   and RDREAL repeat a prompt line and sound a bell until a suitable     
  15.   response is entered. For example:                                     
  16.  
  17.           repeat                                                        
  18.             write ('Enter a number between 1 and 10: ');                
  19.           until rdint (number, 1, 10);                                  
  20.  
  21.   RDCHAR, YES, NOMORE and PAUSE are "inkey" functions which do not      
  22.   require the return key.                                               
  23.  
  24.   For compact code store each function as a separate file to be called  
  25.   with a $INCLUDE metacommand. Remember to include CHARSET: SET of CHAR
  26.   as a type declaration in any program which uses RDCHAR.
  27. }
  28.  
  29.  
  30.  
  31. function RDREAL (var r: real): boolean;
  32.    const
  33.       bell = chr (7);
  34.    var
  35.       decimal, left, right: real;
  36.       neg: boolean;
  37. begin
  38.    left:= 0;
  39.    decimal:= 1;
  40.    right:= 0;
  41.    neg:= false;
  42.    while not eoln and not (input^ in [chr(33)..chr(255)]) do get (input);
  43.    neg:= input^ = chr(45);
  44.    if neg then get (input);
  45.    rdreal:= input^ in ['0'..'9'];
  46.    while input^ in ['0'..'9'] do begin;
  47.       left:= left * 10 + ord (input^) - ord ('0');
  48.       get (input);
  49.    end;
  50.    if input^ = chr(46) then begin
  51.       get (input);
  52.       while input^ in ['0'..'9'] do begin
  53.          right:= right + decimal * (ord (input^) - ord ('0')) / 10;
  54.          decimal:= decimal / 10;
  55.          get (input);
  56.       end;
  57.    end;
  58.    r:= left + right;
  59.    if neg then r:= - r;
  60.    if input^ in [chr(33)..chr(44), chr(47), chr(58)..chr(255)] then begin
  61.       rdreal:= false;
  62.       write (bell);
  63.    end;
  64.    readln;
  65. end;
  66.  
  67.  
  68.  
  69. function RDINT (var  i:integer; low,high:integer): boolean;
  70.    const
  71.       bell = chr (7);
  72.    var
  73.       neg: boolean;
  74. begin
  75.    i:= 0;
  76.    neg:= false;
  77.    while not eoln and not (input^ in [chr(33)..chr(255)]) do get (input);
  78.    neg:= input^ = chr(45);
  79.    if neg then get (input);
  80.    while input^ in ['0'..'9'] do begin
  81.       i:= i * 10 + ord (input^) - ord ('0');
  82.       get (input);
  83.    end;
  84.    if neg then i:= - i;
  85.    if (input^ in [chr(33)..chr(44), chr(46), chr(47), chr(58)..chr(255)]) or
  86.       (eoln and ((i < low) or (i > high))) then begin
  87.          rdint:= false;
  88.          write (bell);
  89.    end
  90.    else rdint:= (i >= low) and (i <= high);
  91.    readln;
  92. end;
  93.  
  94.  
  95.  
  96. function RDCHAR (okchars: charset): char;
  97. var  f, g: file of char;
  98.         c: char;
  99.    function inkey: char;
  100.       begin
  101.          repeat get (f) until f^ <> chr (0);
  102.          inkey:= f^;
  103.       end;
  104. begin
  105.    assign (f, 'user');
  106.    reset (f);
  107.    assign (g, 'user');
  108.    rewrite (g);
  109.    repeat
  110.       c:= inkey;
  111.       if not (c in okchars) then if c in ['A'..'Z'] then
  112.          c:= chr (ord(c) - ord('A') + ord('a'))
  113.       else if c in ['a'..'z'] then c:= chr (ord(c) - ord('a') + ord('A'));
  114.    until c in okchars;
  115.    write (g, c);
  116.    writeln;
  117.    rdchar:= c;
  118. end;
  119.  
  120.  
  121.  
  122. function YES: boolean;
  123. var   f, g: file of char;
  124.          c: char;
  125.    function inkey: char;
  126.       begin
  127.          repeat get (f) until f^ <> chr (0);
  128.          inkey:= f^;
  129.       end;
  130. begin
  131.    assign (f, 'user');
  132.    reset (f);
  133.    assign (g, 'user');
  134.    rewrite (g);
  135.    repeat c:= inkey until c in ['y','Y','n','N'];
  136.    write (g,c);
  137.    writeln;
  138.    yes:= c in ['y', 'Y'];
  139. end;
  140.  
  141.  
  142.  
  143. function NOMORE: boolean;
  144. var  f, g: file of char;
  145.         c: char;
  146.    function inkey: char;
  147.       begin
  148.          repeat get (f) until f^ <> chr (0);
  149.          inkey:= f^;
  150.       end;
  151. begin
  152.    write ('More? ');
  153.    assign (f, 'user');
  154.    reset (f);
  155.    assign (g, 'user');
  156.    rewrite (g);
  157.    repeat c:= inkey until c in ['y','Y','n','N'];
  158.    write (g, c);
  159.    writeln;
  160.    nomore:= c in ['n', 'N']
  161. end;
  162.  
  163.  
  164. procedure PAUSE;
  165. var  f: file of char;
  166. begin
  167.    assign (f, 'user');
  168.    reset (f);
  169.    write ('Press any key to continue...');
  170.    repeat get (f) until f^ <> chr (0);
  171.    writeln;
  172. end;
  173.