{$nomain}
{$nowalkback}
{
.STOP

File			: SC:[22,310]CRETAS.PAS
Author			: Peter Stadick
Origin Date		: Nov 16,1987
Edit History		:

	       Last edit: 21-NOV-1987 21:21:35 



Description:

	This callable routine will convert a real number into the ascii
	conforment array parameter given it. If the real number is negitive 
	it will add a hyphine to the beginning of the number. The last 
	parameter is the number of digits behind the decimal point to be 
	displayed. If this value is zero no decimal point is included.
	The ascii number value is always left justified in the array. If 
	for some reason the array given is not big enough to hold the
	number value an array of spaces is returned.

}

procedure cretas(var asc : packed array [lo..hi:integer] of char;
		     rea : real;
		     dec : integer); external;

procedure cretas;

const
  max_number_size = 38;

var
  in_rea : real;
  multiplyer : real;
  asc_num : packed array [1..max_number_size] of char;
  num_pos : integer;
  asc_pos : integer;
  negitive : boolean;
  total_length : integer;
  in_length : integer;
  real_digit : integer;

begin
  in_length := hi-lo+1;
  for asc_pos := lo to hi do
    asc[asc_pos] := ' ';    

  if dec < 1 then dec := 0;

  negitive := false;
  total_length := 0;
  if rea < 0 then
  begin
    rea := abs(rea);
    negitive := true;
    total_length := 1;
  end;

  { Find order of magnitude of number }
  multiplyer := 1;
  while (rea/multiplyer >= 10.0 ) do
    multiplyer := multiplyer * 10.0;

  in_rea := rea;
  num_pos := 0;
  if in_rea >= 1 then
  repeat
    real_digit := trunc(in_rea / multiplyer);
    in_rea := in_rea - (real_digit * multiplyer);
    num_pos := num_pos + 1;
    asc_num[num_pos] := chr(real_digit + ord('0'));
    multiplyer := multiplyer / 10.0;
  until (multiplyer < 0.9) or (num_pos = max_number_size)
  else
  begin
    { add leading zero to values less then one }
    num_pos := 1;
    asc_num[1] := '0';
  end;

  { Check that number will fit into output string }
  total_length := total_length + num_pos;
  if dec > 0 then
    total_length := total_length + dec + 1;
  
  if total_length <= in_length then
  begin
    { determine left justify postion in output string }
    asc_pos := hi;
    if dec > 0 then
      asc_pos := hi - dec - 1;

    { transfer stuff above decimal point to output string }
    while num_pos > 0 do
    begin
      asc[asc_pos] := asc_num[num_pos];
      asc_pos := asc_pos - 1;
      num_pos := num_pos - 1;
    end;

    { add negitive sign if negitive }
    if negitive then
      asc[asc_pos] := '-';

    { Next we stick in values behind decimal point. Need to check that
      supplied array is big enough to hold value. }
    if dec > 0 then
    begin
      asc_pos := hi - dec;
      asc[asc_pos] := '.';
      multiplyer := 10;
      repeat
        real_digit := trunc(in_rea * multiplyer);
        in_rea := in_rea - (real_digit / multiplyer);
        asc_pos := asc_pos + 1;
        asc[asc_pos] := chr(real_digit + ord('0'));
        multiplyer := multiplyer * 10.0;
      until asc_pos = hi;
    end;
  end;

end;