home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / modula2 / library / queuem2 / getrange.mod < prev    next >
Text File  |  1989-08-02  |  4KB  |  120 lines
  1. (* source: h:\modula\code\util\GetRange.MOD   v1.0a         revised: 88.06.20
  2.    author: G.Greene, AGCS D/429 (NS/TS), 312/681-7783       created: 88.06.20
  3.  
  4.    function:
  5.     This is the implementation code for a module which exports procedures
  6.     which interact with the operator, prompting for numeric values which
  7.     must be constrained to specified ranges.
  8.  
  9.    history:
  10.     88.06.20  1.0a  initial release.
  11. *)
  12.  
  13.  
  14. IMPLEMENTATION MODULE  GetRange;
  15.  
  16.  
  17. FROM  IO   IMPORT  (*PROC*) WrStr,  WrCard,  WrLn,  RdCard,
  18.                             WrInt,  RdInt,   RdReal;
  19.  
  20.  
  21. (* Return as the function value a CARDINAL within the range specified by
  22.    the first and second parameters.  The value to be returned is requested
  23.    interactively of the program's operator, using the prompt string specified
  24.    by the third parameter, and a display of the acceptable value limits.
  25. *)
  26.  
  27. PROCEDURE  GetLimitedCARDINAL (
  28.                        (*in*)  LowerLimit,
  29.                        (*in*)  UpperLimit:   CARDINAL;
  30.                        (*in*)  PromptString: ARRAY  OF CHAR ): CARDINAL;
  31.  
  32.   VAR
  33.     InputValue: CARDINAL;
  34.  
  35.   BEGIN
  36.     REPEAT
  37.       WrStr ( PromptString );      WrStr ( " [" );
  38.       WrCard   ( LowerLimit, 1 );  WrStr ( ", " );
  39.       WrCard   ( UpperLimit, 1 );  WrStr ( "]: " );
  40.       InputValue := RdCard ( );
  41.       WrLn;
  42.     UNTIL  ( InputValue >= LowerLimit )  AND  ( InputValue <= UpperLimit );
  43.  
  44.     RETURN  InputValue;
  45.   END   GetLimitedCARDINAL;
  46.  
  47. (*                                                                         [2]
  48.  source: h:\modula\code\util\GetRange.MOD   v1.0a         revised: 88.06.20 *)
  49.  
  50.  
  51. (* Return as the function value an INTEGER within the range specified by
  52.    the first and second parameters.  The value to be returned is requested
  53.    interactively of the program's operator, using the prompt string specified
  54.    by the third parameter, and a display of the acceptable value limits.
  55. *)
  56.  
  57. PROCEDURE  GetLimitedINTEGER (
  58.                       (*in*)  LowerLimit,
  59.                       (*in*)  UpperLimit:   INTEGER;
  60.                       (*in*)  PromptString: ARRAY  OF CHAR ): INTEGER;
  61.  
  62.   VAR
  63.     InputValue: INTEGER;
  64.  
  65.   BEGIN
  66.     REPEAT
  67.       WrStr ( PromptString );      WrStr ( " [" );
  68.       WrInt    ( LowerLimit, 1 );  WrStr ( ", " );
  69.       WrInt    ( UpperLimit, 1 );  WrStr ( ": " );
  70.       InputValue := RdInt ( );
  71.       WrLn;
  72.     UNTIL  ( InputValue >= LowerLimit )  AND  ( InputValue <= UpperLimit );
  73.  
  74.     RETURN  InputValue;
  75.   END   GetLimitedINTEGER;
  76.  
  77. (*                                                                         [3]
  78.  source: h:\modula\code\util\GetRange.MOD   v1.0a         revised: 88.06.20 *)
  79.  
  80.  
  81. (* Return as the function value a positive REAL.  The value to be returned is
  82.    requested interactively of the program's operator, using the prompt string
  83.    specified by the first parameter.  The second parameter indicates whether
  84.    zero is an acceptable value:  if is is FALSE, the value must be "strictly
  85.    positive" (i.e., non-zero).
  86. *)
  87.  
  88. PROCEDURE  GetPositiveREAL (
  89.                     (*in*)  PromptString: ARRAY  OF CHAR;
  90.                     (*in*)  ZeroAllowed:  BOOLEAN ): REAL;
  91.  
  92.   VAR
  93.     Value:  REAL;
  94.     Valid:  BOOLEAN;
  95.  
  96.   BEGIN
  97.     WrStr ( PromptString );   WrLn;
  98.  
  99.     REPEAT
  100.       CASE  ZeroAllowed  OF
  101.         FALSE:
  102.           WrStr (
  103.                "  ... your answer must be a strictly positive real value: " );
  104.           Value := RdReal ( );   WrLn;
  105.  
  106.           Valid := Value > 0.0;
  107.       |
  108.         TRUE:
  109.           WrStr ( "  ... your answer must be a positive real value: " );
  110.           Value := RdReal ( );   WrLn;
  111.  
  112.           Valid := Value >= 0.0;
  113.       END;   (* CASE ZeroAllowed *)
  114.     UNTIL  Valid;
  115.  
  116.     RETURN  Value;
  117.   END  GetPositiveREAL;
  118.  
  119. END  GetRange.
  120.