PROGRAM cretas;
 {$nomain}

{ 
  File:[22,310]CRETAS.PAS
  Author: Phil Hannay 21-Jun-89  (patterned after CINTAS.PAS)

  Last Edit: 22-JUN-1989 13:43:08 

  History:

}

 {[a+,b+,l-,k+,r+] Pasmat }

%include pas$ext:general.typ;

%include pas$ext:slen.ext;
%include pas$ext:sclear.ext;
%include pas$ext:schconcat.ext;

  PROCEDURE Cretas(    rea: real;
                   VAR asc: PACKED ARRAY [lo..hi: integer] OF char;
                   VAR pos: integer;
                       place: integer);
    EXTERNAL;

{*USER*

CRETAS converts an input real number in REA to an output string 
of ASCII characters in ASC.  The real number is assumed to be decimal
(base 10).  ASC MUST be a valid type0 or type1 string.

POS specifies starting point and justification of the output
in the string ASC.  The string ASC will always be cleared before
insertion of the real number conversion, so any previous contents
of ASC will be destroyed.

If POS is greater than 0 (zero), then the 
ascii characters will be left justified,
starting at position POS.  Leading blanks will be inserted 
before POS if POS is not the beginning of the string.

If POS is 0, then the ascii characters will
be right justified, using the entire string.  
Leading blanks will be inserted as needed in front of the converted
number.

If POS is less than 0,
then the ascii characters will be right justified ending at -(POS).
Once again, leading blanks will be inserted as needed in front of the
converted number.

PLACE will indicate the number of places desired after the decimal
point.  It must be zero or greater.  If PLACE is zero, there will be
only a trailing decimal point.  PLACE can NEVER be negative.

If the real number is negative, a leading minus "-" sign will precede
the ascii digits.  There will be no space between the minus sign and
the first digit.

A decimal point will ALWAYS be present.  Likewise, if the number is
less that 1.0, a leading zero before the decimal point will ALWAYS
be present.

Upon exit from this
procedure, POS will be left pointing to the rightmost character placed in the
number string.  This is generally of value only if POS was greater
than zero, indicating left justification was desired, as it now
points to the rightmost character that was put in the string.

If POS is returned as zero, there was a conversion error.

Real numbers can vary from 1E-38 to 1E+38.  You can specify a PLACE
value larger than 38, however, it will simply return zeros in places
beyond 38.

Remember that single precision
real numbers (4 bytes) will give you about 7 digits of precision, 
while double precision (8 bytes) will give you about 15 digits.

*ERROR CODES*

If POS is returned as zero, there was a conversion 
error.  The most likely cause is that the resulting 
ascii represented real number would not fit in the 
string ASC provided.  In this case, the string has 
been cleared, but nothing inserted.  You as the 
caller can determine how to handle this case.  
Less likely conversion errors are due to programmer
error, either with POS or PLACE values.  These 
errors will also result in the below documented 
error messages appearing to aid in program
debugging.

The following error messages can appear when using
CRETAS.  They normally indicate a programming error.

CRETAS -- ASC string is not a type0 or type1 string
  ( The ASC string parameter supplied must be a
    type0 or type1 string. )

CRETAS -- PLACE value (n) cannot be negative
  (A negative PLACE parameter "n" (number of places
   after decimal point) was used.)

CRETAS -- POS value (n) is not within string'
  (The POS parameter "n" is in error as it
   does not fall between the lower and upper
   bounds of the string array.)

}

{*WIZARD*

This routine handles only type0 and type1 compatible strings.

}


  PROCEDURE Cretas;

    LABEL
      999; { used for premature exit on error }

    VAR
      bpos, epos, i, left_place, strlen, maxlen, digit: integer;
      holdreal, factor: real;
      done, negative: boolean; 

    BEGIN

      epos:= 0; 
      { if EPOS remains zero, error - in most cases - generated number
        would not fit in string ASC that was provided }
      
      { make sure ASC is type0 or type1 string - program error if not }
      if (lo < 0) or (lo > 1)
        then begin
          { error - write a quick diagnostic message to help programmer }
          writeln('CRETAS -- ASC string is not a type0 or type1 string');
          GOTO 999;
          END;

      { make sure PLACE is positive - program error if not }
      if (place < 0)
        then begin
          { error - write a quick diagnostic message to help programmer }
          writeln('CRETAS -- PLACE value (',place:1,') cannot be negative');
          GOTO 999;
          END;

      { check if positive or negative value - if negative, we will need
        to have room for a minus sign }
      if rea < 0.0 
        then begin
          holdreal:= -(rea);
          negative:= true;
          end
        else begin
          negative:= false;
          holdreal:= rea;
          end;

      { Figure out how many places to the left of the decimal point that
        we will need.  We will leave FACTOR as 1.0 or the largest power of 10
        that is less that the real number supplied. }
      factor:= 1.0;
      left_place:= 1;
      done:= false;
      while not(done) do
        begin
        if factor < holdreal
          then begin
            left_place:= left_place + 1;
            if left_place < 40
              then factor:= factor * 10.0 else done:= true;
            end
          else begin
            if factor > 1.0 
              then begin
                factor:= factor / 10.0;
                left_place:= left_place - 1;
                end;
            done:= true;
            end;
        end;

      { now compute number of characters needed for ascii number }
      strlen:= left_place + 1 + place;  
      {left digits + decimal point + right digits}
      if negative then strlen:= strlen + 1; 
      { minus sign if negative }
 
      { we clear the string to insure that it is empty and determine maximum
        size }
      sclear(asc);
      maxlen:= hi;

      { make sure POS falls within string }
      if (abs(pos) > maxlen) 
        then begin
          { error - write a quick diagnostic message to help programmer }
          writeln('CRETAS -- POS value (',pos:1,') is not within string');
          GOTO 999;
          END;

      { calculate where first non-blank character will be, and where last
        non-blank character will be }
      if pos = 0
        then begin
          { right justify, use entire string }
          bpos:= maxlen - strlen + 1;
          epos:= maxlen;
          end
        else begin
          if pos > 0
            then begin
              { left justify, ending at POS }
              bpos:= pos;
              epos:= pos + strlen - 1;
              end
            else begin
              { pos < 0 : right justify, starting at POS }
              bpos:= (abs(pos) - strlen + 1);
              epos:= abs(pos);
              end
          end;

      { now make sure that the calculated beginning and ending digits
        fit in string ASC that was supplied, if not, bailout, returning
        a zero in POS indicating we could not do coversion in space
        provided }
      if (bpos < 1) or (epos > maxlen) 
        then begin
          epos:= 0;
          goto 999;
          end;

      { finally, we are ready to generate ascii number }

      { pad with blanks if required }
      for i:= 1 to (bpos-1) do schconcat(asc,' ');

      { minus sign if negative }
      if negative then schconcat(asc,'-');

      { now digits before decimal point }

      { FACTOR was left as the largest power of 10 less than the
        real number.  If real number was less than 1.0, FACTOR was left
        at 1.0.  We can use it to generate the digits, reducing
        FACTOR by 10 until we are back to FACTOR less than 1.0.  Note
        that if the real number was less than 1.0, FACTOR will be 1.0,
        and we will generate a single zero digit before the decimal
        point. }
      while factor >= 1.0 do
        begin
        digit:= trunc(holdreal/factor);
        schconcat(asc,chr(digit+ord('0')));
        holdreal:= holdreal - (digit * factor);
        factor:= factor / 10.0;
        end;           

      { add the decimal point }
      schconcat(asc,'.');

      { and the digits after the decimal point - FACTOR is 0.1, ready to
        go for generating digits - if factor reaches less than 10 to the
        minus 38th, we have reached the lower limit of the real number,
        and will just generate zeros thereafter. }
      for i:= 1 to place do
        begin
        digit:= trunc(holdreal/factor);
        schconcat(asc,chr(digit+ord('0')));
        if factor <= 10E-38
          then begin
            { no more resolution possible - just do zeros }
            holdreal:= 0;
            end
          else begin
            { reduce hold real and drop FACTOR by 1 power }
            holdreal:= holdreal - (digit * factor);
            factor:= factor / 10.0;
            end;
        end;

    999:
    { Done - ending position is EPOS.  If EPOS is still zero, we could
      not fit ascii number into the ASC string that was supplied.  And
      so we leave the string cleared (empty),  leaving it up to the 
      caller to figure out what to do. }
    Pos:= epos;
      
    END;