PROGRAM cpktas;

{
  File:[22,310]cpktas.PAS
  Author: Philip Hannay  21-Apr-88

  Last Edit: 23-JUN-1988 22:13:51 

  History:
	 23-JUN-1988 21:56:17  - JMB PA3UTL upgrade.

}

{$nomain}
 {$NOLIST}
{[A+,B+,L-,K+,R+] Pasmat directive }

%INCLUDE PAS$EXT:General.typ;
%INCLUDE PAS$EXT:PACKED.TYP;
%INCLUDE PAS$EXT:ERROR.EXT;
%INCLUDE PAS$EXT:STRING.PKG;

 {$LIST}

{-------------- Convert Packed Decimal to Ascii -----------------------------}

 PROCEDURE cpktas(Var Pk: packed array [plow..phigh: integer] of Packed_decimal;
                  Var Asc: packed array [lo..hi: integer] of char;
                  Pos: integer
                 );external;

{*USER*

The CPKTAS procedure converts an array of Packed decimal to an ascii
string.  Pos controls position, fill, and justification of output string.

.lit

Pos > 0  --  left-justify, starting at pos within string
Pos = 0  --  right-justify, concatenating at end of string
Pos < 0  --  right-justify, ending at pos within string

.eli

The ascii string supplied must be a valid type0 or type1 string.  Normally,
you will be adding the number to a string and will use POS=0.  If you wish
to place the number within an existing string, you can use POS to control
the position within the string, and the right of left justification.  

A Packed decimal array must have an even number of elements, since the
digits are packed 2 per byte.  An array that has an odd number of bytes 
will be ignored, and an error reported.

Since the length of the Packed decimal array determines the number of
converted characters, there is no need for padding.  If you wish to place
a variable length Packed decimal array in a fixed field with zero or blank
padding, you should first fill that fixed field with the desired padding
characters, and then all this routine specifying the right or left 
justification.

If you supply a value for POS that is out of the range of the string,
an error message will be printed.  If you supply a non type0 or type1
string, an error message will be printed.  If you supply a string that
is not sufficient to hold the converted characters, the conversion will
be truncated to the string length, and no error reported.

}

{*WIZZARD*

Truncations are accepted as intentional programming.  However, parameters
that result in the starting positions outside of the output string range, are
considered non-fatal programming errors that result in a warning message
to "output".  The error number will be -1, and param will be set to the
POS parameter that started the trouble in the first place.

Packed decimal digits are allocated 2 per byte.  Within the byte, the
high order digit of the pair includes the high order bit of the byte, and the
low order digit of the pair includes the low order bit of the byte.  When
the byte array is scanned by the computer (from lowest address/low order bit
to highest address/high order bit) the low order digit of the highest order
pair is encountered first, followed by the high order digit of the
highest order pair.  For example:

.lit

Storage allocation of Packed decimal 4528.

byte 0 holds 45 (thousands, hundreds)
  within byte 0:
    byte 0 bits 0-3 holds 5 (low order of pair)
    byte 0 bits 4-7 holds 4 (high order of pair)

byte 1 holds 28 (tens, ones)
  within byte 0:
    byte 1 bits 0-3 holds 8 (low order of pair)
    byte 1 bits 4-7 holds 2 (high order of pair)

.eli

In summary, if you scan a Packed decimal array from low address
to high address (low subscript to high subscript), the highest
order digit pair (45) will come first, followed the lower
order digit pair (28).  Looking at each pair, the lower order
digit of the pair (5 of 45) will come first, followed by the
higher order digit of the pair (4 of 45).  So if you have a Packed
decimal array containing the number 4528, array element 1 will be
a 5, array element 2 a 4, element 3 an 8, and element 4 a 2.

By convention, Packed decimal arrays must have an even number of
digits.  It doesn't make any sense to have an odd number, since that
means you have a low order digit of a pair, and not the high order
digit, and so you cannot assume the high order digit is a zero.  For example,
the above array truncated to 3 elements, would resolve into 45x8 where
"x" is the missing element.  If a Packed decimal array is supplied by
the caller, it will be ignored, and an error returned.

Datatrieve appears to go one step further with Packed decimal.  For all I
know, it may be the "official" definition.  When Datatrieve allocates space
for a Packed decimal, it increased in by 2 digits, placing a leading "0"
digit in front, and a trailing "F" (17 octal) digit at the end.
The AMI communication protocol does not implement the leading 0 and trailing
F digits.

If this routine is called with an array that is not a valid or a POS that
is out of range, the ERROR routine will be called, emitting a warning message
on "output" with the following errors.

.lit

Error -1: POS out of range, truncation not even
            possible, param = value of POS
Error -2: Odd number of elements (digits) in Packed
            decimal array PK, 
            param = number of elements

.eli

The ascii string ASC is given to the string routine SLEN for validation.
So an invalid string will result in SLEN warnings.

}


procedure cpktas;

VAR
  plen: integer;    { number of digits in packed decimal array }
  len: integer;    { number of characters in ASC string }
  start: integer;  { start of writing in ASC string }
  fin: integer;    { end of writing in ASC string }
  offset, i: integer;   { miscellaneous }
  err, param: integer;  { for error message }
  high_digit: boolean;  { for flip flop between high/low order digits }
  
BEGIN    { cpktas }
err:= 0;
{ get length of packed decimal to convert }
plen:= phigh - plow + 1;
if plen mod 2 = 1
  then begin
    { An odd number of Packed decimal digits - not possible - ignore and
      write out a warning message. }
    err:= -2;
    param:= plen;
    end
  else begin
    { an even number of digits - that's expected.  Now get the 
      length of the ASC string, if ASC not type0 or type1, SLEN
      will print error message }
    len:= slen(asc);
    if pos = 0
      then begin
        { we append converted number to string ASC }
        start:= len + 1;
        fin:= len + plen;
        if start > hi then start:= 0;
        if fin > hi then fin:= hi;
        end
      else begin
        if pos > 0
          then begin
            { left justify starting at POS in string }
            start:= pos;
            fin:= pos + plen - 1;
            end
          else begin
            { right justify with -POS being the rightmost digit }
            start:= (-pos) - plen + 1;
            fin:= (-pos);
            end;
        if start < 0 then start:= 0;
        if start > len then start:= 0;
        if fin > len then fin:= len;    
        end;
    { if start is 0, there is an error, if start is non-zero, we can start doing
      the conversion.  A truncation is not considered an error.  An error is
      where the value of POS resulted in a location that was completely out of
      range with respect to the ASC string. }
    if start > 0
      then begin
        { do the conversion, and if ASC is type0 string, adjust length parameter
          if needed. }
        high_digit:= true;
        offset:= start - plow;
        for i:= start to fin do
          begin
          { do the conversion, stopping prematurely if truncation }
          if high_digit
            then begin
              { remember, high order digit of pair is in higher array subscript}
              asc[i]:= chr(ord('0')+pk[i-offset+1]);
              high_digit:= false;
              end
            else begin
              { and low order digit of pair is in lower array subscipt }
              asc[i]:= chr(ord('0')+pk[i-offset-1]);
              high_digit:= true;
              end;
          if asc[i] > '9' then asc[i]:= chr(ord(asc[i])-16);
          end;
        if (lo = 0) and (fin > len) then asc[0]:= chr(fin);
        end
      else begin
        { An error - POS out of range with even a truncation not possible 
          - definitely a programmer error.  Report error on "output". }
        err:= -1;
        param:= pos;
        end;
    end;
if err <> 0
  then begin
    { An error was encountered, print warning message }
    error(err, warning_err, 'CPKTAS -- bad Packed array or pos', param);
    end;
end;
