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;