Crawly Crypt Collection 2/crawlyvol2.bin/program/pascal/passrc/rinput.pas

Pascal/Delphi Source File | 1986-10-15 | 5.5 KB | 218 lines

{ -----------------------------------------------------------------------------

                                 NOTICE:

      THESE MATERIALS are UNSUPPORTED by OSS!  If you do not understand how to
      use them do not contact OSS for help!  We will not teach you how to
      program in Pascal.  If you find an error in these materials, feel free
      to SEND US A LETTER explaining the error, and how to fix it.

      THE BOTTOM LINE:

         Use it, enjoy it, but you are on your own when using these materials!


                               DISCLAIMER:

      OSS makes no representations or warranties with respect to the contents
      hereof and specifically disclaim all warranties of merchantability or
      fitness for any particular purpose.   This document is subject to change
      without notice.

      OSS provides these materials for use with Personal Pascal.  Use them in
      any way you wish.

   -------------------------------------------------------------------------- }


{**************************************************************************

   RINPUT.PAS - function takes a high, low, and default number
                and a prompt and returns when satisfied
                10-14-86 MJC

   Include in your program (*$I rinput.pas *)


   Rinput( Prompt, Low, High, Default )

   Prompt user to input a number.

   Example:

      Real_Var := Rinput( 'Enter Num ', 5.5, 1000.55, 57.654 );

   would prompt the user for a number in the range of 5.5 to 1000.55, with
   a default value of 57.654 (if user hits <RETURN> without entering
   anything, this is the value returned).  If a number outside the range of
   Low to High is entered the user will be prompted to enter another number.

***************************************************************************}

FUNCTION RVal( St: String): Real; { convert a string to a real number -
                                        see Rstrval.pas }

Const
  Max_Digits    = 09;

Var
  Dec_Exp,
  Exp_Value,
  Count,
  Position:     Integer;
  Chr:          Char;
  Result:       Real;
  Dec_Sign,
  Exp_Sign:     Boolean;

  PROCEDURE Add_Digit;

  Begin
    Result := (Result * 10) + (Ord(Chr) & $0F);
  End;

  PROCEDURE Read_Chr;

  Begin
    Position := Position + 1;
    If Position > Length(St) Then
      Chr := 'X'
    Else
      Chr := St[Position];
  End;

Begin
  Position := 0;
  Read_Chr;
  Result := 0.0;

{ Get sign }

  Dec_Sign := False;
  If Chr = '+' Then Read_Chr;
  If Chr = '-' Then
  Begin
    Read_Chr;
    Dec_Sign := True;
  End;

{ Get digits to left of decimal point }

  Dec_Exp := 0;
  Count := Max_Digits;
  While ('0' <= Chr) And (Chr <= '9') Do
  Begin
    If Count > 0 Then
    Begin
      Add_Digit;
      Count := Count - 1;
    End
    Else
      Dec_Exp := Dec_Exp + 1;
    Read_Chr;
  End;

{ Get digits to the right of decimal point }

  If Chr = '.' Then
  Begin
    Read_Chr;
    While ('0' <= Chr) And (Chr <= '9') Do
    Begin
      If Count > 0 Then
      Begin
        Add_Digit;
        Dec_Exp := Dec_Exp - 1;
        Count := Count - 1;
      End;
      Read_Chr;
    End;
  End;

{ Get exponent part }

  If (Chr = 'E') Or (Chr = 'e') Then
  Begin
    Read_Chr;
    Exp_Sign := False;
    If Chr = '+' Then Read_Chr;
    If Chr = '-' Then
    Begin
      Read_Chr;
      Exp_Sign := True;
    End;
    Exp_Value := 0;
    If ('0'<=Chr) And (Chr<='9') Then Exp_Value := (Ord(Chr) & $0F)*10;
    Read_Chr;
    If ('0'<=Chr) And (Chr<='9') Then Exp_Value := Exp_Value+(Ord(Chr) & $0F);
    If (Chr = 'X') And (Exp_Value >= 10) Then Exp_Value := Exp_Value Div 10;
    If Exp_Sign Then
      Dec_Exp := Dec_Exp - Exp_Value
    Else
      Dec_Exp := Dec_Exp + Exp_Value;
  End;

{ Multiply or divide Result by power of 10 specified by Dec_Exp }

  If Dec_Exp > 0 Then
    Result := Result * PwrOfTen(Dec_Exp)
  Else
    Result := Result / PwrOfTen(Abs(Dec_Exp));

  If Dec_Sign Then Result := -Result;

  RVal := Result;

End;


{************************************************************************

        The Famous Rinput Function...

************************************************************************}


FUNCTION Rinput( Prompt : STRING; Low, High, Def : REAL ) : REAL;


VAR

   Tempval : REAL;      { hold temp value... }
   Tempstr : STRING;    { get input }
   Done : BOOLEAN;      { Are we done... }

   BEGIN

      REPEAT
         BEGIN
            Write( Prompt );  { send prompt string }
            Readln( Tempstr );  { get input from user }

            IF Length( Tempstr ) = 0 THEN
               BEGIN
                  Tempval := Def;  { use default value }
                  Done := TRUE;    { and fall thru }
               END

            ELSE

               BEGIN
                  Tempval := Rval( Tempstr );      { convert string to real }
                  IF (Tempval >= Low) AND (Tempval <= High) THEN
                     Done := TRUE         { All is well, continue }
                  ELSE
                     BEGIN
                        Write( '* Value outside range: ' );
                        Writeln( Low:1:2, ' - ', High:1:2 );
                        Writeln;
                        Done := FALSE        { otherwise go again... }
                     END;
               END;

         END
      UNTIL Done;
      Rinput := Tempval;                { and return the value...}
   END;