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

Pascal/Delphi Source File | 1985-11-18 | 8.1 KB | 354 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.

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


{*  THIS IS A PROGRAM, TAKE OUT THE MAIN ROUTINE TO USE JUST THE FUNCTIONS *}

Program LalaBlahLala(InThoughTheOutDoor,OutThroughTheInDoor);

Var
  TestSt:  String;
  TestRl:  Real;


{***
 *   Floating Point Conversion routines.
 *   From Real to String and String to Real
 *
 *   By Kevin L. McGrath
 ***}

PROCEDURE Str(Value: Real; VAR St: String);

{* Notes:
 *   This routine is only accurate up to 9 digits becuase of the LongTrunc.
 *   It HAD rounding errors, but they are now fixed (with the LongTrunc)
 *
 * O.S.S. Pascals Floating Point Format:
 *   This is just a guess, but here goes...
 *   One byte of exponent biased by 128 to give a +38 to -38 range.
 *   Fourty bits of mantissa to give 11 digits of accuracy, One bit sign.
 *   Most floating points are normalized to the left, with the point between
 *   the most significant bit of the mantissa and the second most, so I think
 *   this is two.  To find out, just plug out a routine that has a pointer
 *   to a real, coerce's it into a pointer to a record structure of byte like
 *   this:
 *     Record
 *       Exponent:      Byte;
 *       MantissaOne:   Long;
 *       MantissaTwo:   Long;
 *       MantissaThree: Long;
 *     End;
 *   then you can extract the exponent and mantissa just by doing a
 *   "Ptr.Exponent" or somethin like that.  Well, I haven't had time to get
 *   that fancy with this, but I have used this routine and am sure it works.
 *   Hope you guys at O.S.S. can vert it to some kind of normal ASM function!
 *      Good Luck...   (Nice Compiler)
 *      Call me if there are any probs, dig?
 *}


Const
  Max_Digits    = 09;
  Max_Exponent  = 38;

Var
  Val:          Real;
  TempInt,
  Sig_Digits,
  Dec_Exp,
  I:            Integer;
  Digits:       String;

Begin
  Val := Abs(Value);
  Dec_Exp := 0;

  {* Get the exponent without Natural Log (Ln doesn't seem to work fer me) *}

  If (Val < 1) And (Val > 0) Then
  Begin
    For I := 0 To (Max_Exponent-1) Do
      If (Val < (1/PwrOfTen(I))) And (Val >= (1/PwrOfTen(I+1))) Then
        Dec_Exp := -(I+1);
    Val := Val * PwrOfTen(Abs(Dec_Exp)-1);
  End
  Else
  Begin
    For I := 0 To (Max_Exponent-1) Do
      If (Val >= PwrOfTen(I)) And (Val < PwrOfTen(I+1)) Then
        Dec_Exp := I;
    Val := Val / PwrOfTen(Dec_Exp+1);
  End;

{ Get decimal digits by stripping }

  Digits := '';
  St := '';

  For I := Max_Digits DownTo 1 Do
  Begin
    { Take care of rounding problems }

    Val := Long_Trunc(Val*PwrOfTen(I)+0.5)/PwrOfTen(I);

    Val := Val*10.0;
    Digits := ConCat(Digits,Chr(48+Trunc(Val)));
    Val := Val-Trunc(Val);

    { Take care of rounding problems }

    Val := Long_Trunc(Val*PwrOfTen(I)+0.5)/PwrOfTen(I);

  End;

{ Format and put result in St }
{ Put sign }

  If Value < 0 Then St := '-';

{ Compute significant digits }

  Sig_Digits := Max_Digits;
  I := Max_Digits - 1;
  While ((Digits[I]='0') And (I>0)) Do
  Begin
    Sig_Digits := Sig_Digits - 1;
    I := I - 1;
  End;
  Sig_Digits := Sig_Digits - 1;

{ Put in exponential or non-exonential }

  If ((Sig_Digits-Max_Digits)<=Dec_Exp) And (Dec_Exp<=Max_Digits) Then
  Begin
    { Non-exponental form }
    { Put decimal point and leading zeros for numbers with negative exponents }

    If Dec_Exp < 0 Then
    Begin
      St := ConCat(St,'.');
      For I := 1 To -Dec_Exp-1 Do
        St := ConCat(St,'0');
    End;

    { Put significant digits }

    St := ConCat(St,Digits[1]);
    For I := 1 To Sig_Digits-1 Do
    Begin
      If Dec_Exp = 0 Then
        St := ConCat(St,'.');
      St := ConCat(St,Digits[I+1]);
      Dec_Exp := Dec_Exp - 1;
    End;

    { Put trailing zeros }

    While Dec_Exp > 0 Do
    Begin
      St := ConCat(St,'0');
      Dec_Exp := Dec_Exp - 1;
    End;
  End
  Else
  Begin
    { Exponental form }
    { Put first digit }

    St := ConCat(St,Digits[1]);

    { Put decimal point }

    If Sig_Digits > 1 Then
      St := ConCat(St,'.');

    { Put remaining significant digits }

    For I := 1 To (Sig_Digits - 1) Do
      St := ConCat(St,Digits[I+1]);

    { Put the 'E' for the exponent }

    St := ConCat(St,'E');

    { Put exponents sign }

    If Dec_Exp >= 0 Then
      St := ConCat(St,'+')
    Else
    Begin
      St := ConCat(St,'-');
      Dec_Exp := Abs(Dec_Exp);
    End;

    { Put the exponent }

    If Dec_Exp >= 10 Then
    Begin
      St := ConCat(St,Chr(48+(Dec_Exp Div 10)));
      St := ConCat(St,Chr(48+Dec_Exp-((Dec_Exp Div 10) * 10)));
    End
    Else
    Begin
      St := ConCat(St,'0');
      St := ConCat(St,Chr(48+Dec_Exp));
    End;
  End;
End;


FUNCTION Val( St: String): Real;

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;

  Val := Result;

End;


{*  MAIN ROUTINE  *}

Begin
  TestRl := 0.0;
  While (TestRl <> 9.0) do
  Begin
    WriteLn('Test for Val and Str. Enter a "9" to stop.');
    Write('Enter a number:');
    ReadLn(TestSt);
    TestRl := Val(TestSt);
    Str(TestRl,TestSt);
    WriteLn('Real number as a string:',TestSt);
  End;
End.