Files
harbour-core/harbour/source/rtl/transfrm.c
1999-06-13 13:52:54 +00:00

690 lines
22 KiB
C

/*
* $Id$
*/
#include <extend.h>
#include <ctoharb.h>
#include <ctype.h>
#include <set.h>
/* */
/* Transform( xValue, cPicture ) */
/* */
/* Date : 29/04/1999 */
/* */
extern STACK stack;
void StackPop( void ); /* TOFIX: Should go away */
/* Function flags */
#define PF_LEFT 0x0001 /* @B */
#define PF_CREDIT 0x0002 /* @C */
#define PF_DEBIT 0x0004 /* @D */
#define PF_ZERO 0x0008 /* @0 */
#define PF_PARNEG 0x0010 /* @( */
#define PF_REMAIN 0x0020 /* @R */
#define PF_UPPER 0x0040 /* @! */
#define PF_DATE 0x0080 /* @D */
#define PF_BRITISH 0x0100 /* @E */
#define PF_EXCHANG 0x0100 /* @E. Also means exchange . and , */
#define PF_EMPTY 0x0200 /* @Z */
#define PF_NUMDATE 0x0400 /* Internal flag. Ignore decimal dot */
/* Date settings */
#define DF_CENTOFF 0
#define DF_CENTURY 1
#define DF_DMY 0
#define DF_MDY 1
#define DF_YMD 2
#define DF_EOT 3 /* End of table for Century */
BYTE bCentury = DF_CENTURY; /* Century on */
/* Multiplication factors for different formats. */
long lFactDay [] = { 10000, 100, 1, 1000000, 10000, 1 };
long lFactMonth[] = { 100, 10000, 100, 10000, 1000000, 100 };
long lFactYear [] = { 1, 1, 10000, 1, 1, 10000 };
char *szDatePict = "DD/MM/YYYY"; /* TODO:Drop SET DATE */
char *szBritish[] = { "DD/MM/YY", "DD/MM/YYYY" }; /* For @E */
/*
PictFunc -> Analyze function flags and return binary flags bits
szPict : Pointer to the picture
lPicLen : Pointer to the length. Changed during execution.
*/
int PictFunc( char **szPict, long *lPicLen )
{
int bDone = FALSE;
int iPicFlags = 0;
char *szPic = *szPict;
szPic++;
(*lPicLen)--;
while( *lPicLen && !bDone )
{
switch( toupper(*szPic) )
{
case ' ': /* End of function string */
bDone = TRUE;
break;
case '!':
iPicFlags |= PF_UPPER;
break;
case '(':
iPicFlags |= PF_PARNEG;
break;
case '0':
iPicFlags |= PF_ZERO;
break;
case 'B':
iPicFlags |= PF_LEFT;
break;
case 'C':
iPicFlags |= PF_CREDIT;
break;
case 'D':
iPicFlags |= PF_DATE;
break;
case 'E':
iPicFlags |= PF_BRITISH;
break;
case 'R':
iPicFlags |= PF_REMAIN;
break;
case 'X':
iPicFlags |= PF_DEBIT;
break;
case 'Z':
iPicFlags |= PF_EMPTY;
break;
}
szPic++;
(*lPicLen)--;
}
return( iPicFlags );
}
/*
NumPicture -> Handle a numeric picture.
This function is ALSO called by DatePicture.
szPic : Picture
lPic : Length of picture
iPicFlags : Function flags. NUM_DATE tells whether its a number or date
dValue : Number to picture
lRetSize : The size of the returned string is passed here !
*/
char *NumPicture( char *szPic, long lPic, int iPicFlags, double dValue,
long *lRetSize )
{
int iWidth; /* Width of string */
int iDecimals; /* Number of decimals */
int i;
int iCount;
char *szRet;
char *szStr;
char cPic;
PHB_ITEM pItem;
BYTE bFound = FALSE;
BYTE bEmpty; /* Suppress empty string */
double dPush;
iCount = 0;
szRet = (char *) _xgrab( lPic+4 ); /* Grab enough */
*szRet = 0;
for( i=0; i<lPic && !bFound; i++ ) /* Count number in front */
{
if( szPic[i] == '.' )
bFound = !(iPicFlags & PF_NUMDATE); /* Exit when numeric */
else if( szPic[i] == '9' || szPic[i] == '#' ||
szPic[i] == '$' || szPic[i] == '*' )
iCount++;
}
iWidth = iCount;
if( bFound ) /* Did we find a dot */
{
iDecimals = 0;
iWidth++; /* Also adjust iWidth */
for( ; i<lPic; i++ )
{
if( szPic[i] == '9' || szPic[i] == '#' ||
szPic[i] == '$' || szPic[i] == '*' )
{
iWidth++;
iDecimals++;
}
}
}
else
iDecimals = 0;
if( ( iPicFlags & (PF_DEBIT + PF_PARNEG) ) && ( dValue < 0 ) )
dPush = -dValue; /* Always push absolute val */
else
dPush = dValue;
bEmpty = !dPush && ( iPicFlags & PF_EMPTY ); /* Suppress 0 */
PushSymbol ( GetDynSym( "STR" )->pSymbol ); /* Push STR function */
PushNil (); /* Function call. No object */
PushDouble ( dPush, iDecimals ); /* Push value to transform */
PushInteger( iWidth ); /* Push numbers width */
PushInteger( iDecimals ); /* Push decimals */
Function( 3 ); /* 3 Parameters */
pItem = &stack.Return;
if( IS_STRING( pItem ) ) /* Is it a string */
{
szStr = pItem->value.szText;
iCount = 0;
if( iPicFlags & PF_ZERO ) /* Pad with Zero's */
{
for( i=0; szStr[i] == ' ' && i < iWidth; i++ )
szStr[i] = '0';
}
if( bEmpty && pItem->wLength ) /* Suppress empty value */
{
szStr[pItem->wLength - 1] = ' ';
}
if( iPicFlags & PF_LEFT ) /* Left align */
{
for( i=0; szStr[i] == ' ' && i < iWidth; i++ );
/* Find first non-space */
if( i && i != iWidth ) /* Any found or end of str */
{
memcpy(szStr, szStr+i, iWidth-i);
for( i = iWidth-i; i < iWidth; i++ )
szStr[i] = ' '; /* Pad with spaces */
}
}
for( i=0; i < lPic; i++ )
{
cPic = szPic[i];
if( cPic == '9' || cPic == '#' )
szRet[i] = szStr[iCount++]; /* Just copy */
else if( cPic == '.' )
{
if( iPicFlags & PF_NUMDATE ) /* Dot in date */
szRet[i] = cPic;
else /* Dot in number */
{
if( iPicFlags & PF_EXCHANG ) /* Exchange . and , */
{
szRet[i] = ',';
iCount++;
}
else
szRet[i] = szStr[iCount++];
}
}
else if( cPic == '$' || cPic == '*' )
{
if( szStr[iCount] == ' ' )
{
szRet[i] = cPic;
iCount++;
}
else
szRet[i] = szStr[iCount++];
}
else if( cPic == ',' ) /* Comma */
{
if( iCount && isdigit(szStr[iCount-1]) ) /* May we place it */
{
if( iPicFlags & PF_EXCHANG )
szRet[i] = '.';
else
szRet[i] = ',';
}
else
szRet[i] = ' ';
}
else
szRet[i] = cPic;
}
if( (iPicFlags & PF_CREDIT) && (dValue >= 0) )
{
szRet[i++] = ' ';
szRet[i++] = 'C';
szRet[i++] = 'R';
}
if( (iPicFlags & PF_DEBIT) && (dValue < 0) )
{
szRet[i++] = ' ';
szRet[i++] = 'D';
szRet[i++] = 'B';
}
if( (iPicFlags & PF_PARNEG) && (dValue < 0) )
{
if( isdigit(*szRet) ) /* Overflow */
{
for( iCount = 1; iCount < i; iCount++ )
{
if( isdigit( szRet[iCount] ) )
szRet[iCount] = '*';
}
}
*szRet = '(';
szRet[i++] = ')';
}
*lRetSize = i;
szRet[i] = 0;
}
else
{
printf( "\nNUMPICTURE: STR does not return string" );
_exit(1);
}
return(szRet);
}
/*
NumDefault -> Handle default numerics.
dValue : Number to picture
lRetSize : The size of the returned string is passed here !
*/
PHB_ITEM NumDefault( double dValue )
{ /* Default number */
/* TODO: Change to str call */
PushSymbol ( GetDynSym( "STR" )->pSymbol ); /* Push STR function */
PushNil (); /* Function call. No object */
PushDouble ( dValue, hb_set.HB_SET_DECIMALS ); /* Push value to transform */
Function ( 1 ); /* 1 Parameter */
StackPop (); /* Pop return value */
if( stack.pPos->wType != IT_STRING ) /* Is it a string */
{
printf( "\nNUMDEFAULT: STR does not return string" );
_exit(1);
}
return( stack.pPos );
}
/*
DatePicture -> Handle dates.
lDate : Date to handle
iPicFlags : Function flags
lRetSize : The size of the returned string is passed here !
*/
char *DatePicture( long lDate, int iPicFlags, long *lRetSize )
{
BYTE bFormat;
int n;
int iLenPic; /* Length picture */
char *szDateFormat; /* Date format to be used */
char *szIntPicture; /* Internal picture used */
char *szResult;
char c;
long lDay;
long lMonth;
long lYear;
double dIn;
if( iPicFlags & PF_BRITISH )
{
bFormat = DF_DMY; /* Just use british */
szDateFormat = szBritish[ bCentury ];
}
else
{
szDateFormat = szDatePict; /* Analyze date format */
c = toupper( *szDateFormat );
if( c == 'D' )
bFormat = DF_DMY;
else if ( c == 'M' )
bFormat = DF_MDY;
else if ( c == 'Y' )
bFormat = DF_YMD;
else /* QUESTION: Error ? */
bFormat = DF_DMY;
}
if( lDate <= 0 ) /* Missing date */
{
lDay = 0;
lMonth = 0;
lYear = 0;
iPicFlags |= PF_EMPTY; /* Suppress empty */
}
else
{
iPicFlags |= PF_ZERO; /* Pad with zeros */
hb_dateDecode( lDate, &lDay, &lMonth, &lYear );
/* Calculate d/m/y */
}
iLenPic = strlen( szDateFormat );
szIntPicture = (char *) _xgrab( iLenPic+1 );
for( n = 0; n < iLenPic; n++ ) /* Create internal picture */
{
c = toupper(szDateFormat[n]);
if( c == 'D' || c == 'M' || c == 'Y' ) /* Change format markers */
{
szIntPicture[n] = lDay ? '9' : ' '; /* Empty date -> No picture */
}
else
szIntPicture[n] = szDateFormat[n]; /* Copy the pattern */
}
szIntPicture[n] = 0; /* Close the string */
iPicFlags |= PF_NUMDATE; /* Internal date flag */
if( bCentury )
bFormat += DF_EOT; /* Use the second part */
/* */
/* Transfer the date to a number. Example : */
/* */
/* bFormat == DMY 12/05/1925 => 12051925 d*1M + m*10K + y */
/* bFormat == YMD 1998.05.25 => 19980525 d + m*100 + y*10K */
/* */
dIn = ( (double) lDay ) * lFactDay [ bFormat ];
dIn += ( (double) lMonth ) * lFactMonth[ bFormat ];
if( iLenPic == 8 ) /* 2 digit year. Y2K? */
dIn += ( (double) (lYear % 100) ) * lFactYear [ bFormat ];
else /* 4 digit year */
dIn += ( (double) lYear ) * lFactYear [ bFormat ];
szResult = NumPicture( szIntPicture, iLenPic, iPicFlags, dIn, lRetSize );
/* And give to NumPicture */
_xfree( szIntPicture );
return( szResult );
}
HARBOUR HB_TRANSFORM( void )
{
PHB_ITEM pPic = _param( 2, IT_STRING); /* Picture string */
PHB_ITEM pExp = _param( 1, IT_ANY ); /* Input parameter */
char *szPic = pPic->value.szText;
char *szTemp;
char *szResult;
char *szExp;
PHB_ITEM pItem;
long lPic = pPic->wLength;
long lPicStart = 0; /* Start of template */
long lExpPos = 0;
long lResultPos = 0;
int iPicFlags = 0; /* Function flags */
int n;
BYTE bDone = FALSE;
if( lPic )
{
if( pPic->wLength )
{
if( *szPic == '@' ) /* Function marker found */
{
iPicFlags = PictFunc( &szPic, &lPic ); /* Get length of function*/
lPicStart = pPic->wLength - lPic; /* Get start of template */
}
switch( pExp->wType & ~IT_BYREF )
{
case IT_STRING:
{
szExp = pExp->value.szText;
szResult = (char *)_xgrab( ( (lPic-lPicStart) > pExp->wLength) ?
(lPic-lPicStart) + 1 : pExp->wLength + 1 );
/* Grab enough */
szPic += lPicStart; /* Skip functions */
if( iPicFlags & PF_UPPER ) /* Function : @! */
{
szTemp = szExp; /* Convert to upper */
for( n = pExp->wLength; n ; n--)
{
*szTemp = toupper( *szTemp );
szTemp++;
}
}
if( lPic ) /* Template string */
{
while( lPic && lExpPos < pExp->wLength )
{ /* Analyze picture mask */
switch( *szPic )
{
case '!': /* Upper */
{
szResult[lResultPos++] = toupper(szExp[lExpPos++]);
break;
}
case 'L': /* Ignored */
case 'Y':
case '*':
case '$':
case '.':
case ',':
break;
case '#': /* Out the character */
case '9':
case 'A':
case 'N':
case 'X':
case ' ':
{
szResult[lResultPos++] = szExp[lExpPos++];
break;
}
default: /* Other choices */
{
szResult[lResultPos++] = *szPic;
lExpPos++;
}
}
szPic++;
lPic--;
}
}
else if( iPicFlags & (PF_UPPER + PF_REMAIN) )
{ /* Without template */
for( n = pExp->wLength; n; n--)
szResult[lResultPos++] = *szExp++;
}
if( ( iPicFlags & PF_REMAIN ) && lPic ) /* Any chars left */
{
for( n = lPic; n; n--)
szResult[lResultPos++] = *szPic; /* Export remainder */
}
_retclen(szResult, lResultPos);
_xfree(szResult);
break;
}
case IT_LOGICAL:
{
szResult = (char *) _xgrab( lPic + 1 );
/* That's all folks */
szPic += lPicStart; /* Skip functions */
lResultPos = 1;
if( lPic ) /* Template string */
{
switch( *szPic )
{
case 'Y': /* Yes/No */
{
*szResult = pExp->value.iLogical ? 'Y' : 'N';
szPic++;
lPic--;
bDone = TRUE; /* Logical written */
break;
}
case '#':
case 'L': /* True/False */
{
*szResult = pExp->value.iLogical ? 'T' : 'F';
szPic++;
lPic--;
bDone = TRUE;
break;
}
default:
{
*szResult = *szPic++;
lPic--;
}
}
}
if( ( iPicFlags & PF_REMAIN ) && lPic ) /* Any chars left */
{
for( n = lPic; n; n--) /* Copy remainder */
szResult[lResultPos++] = *szPic++;
if( !bDone ) /* Logical written ? */
szResult[lResultPos++] = pExp->value.iLogical ? 'T' : 'F';
}
_retclen( szResult, lResultPos );
_xfree( szResult );
break;
}
case IT_INTEGER:
{
szResult = NumPicture( szPic + lPicStart, lPic, iPicFlags,
(double) pExp->value.iNumber, &lResultPos );
_retclen( szResult, lResultPos );
_xfree( szResult );
break;
}
case IT_LONG:
{
szResult = NumPicture( szPic + lPicStart, lPic, iPicFlags,
(double) pExp->value.lNumber, &lResultPos );
_retclen( szResult, lResultPos );
_xfree( szResult );
break;
}
case IT_DOUBLE:
{
szResult = NumPicture( szPic + lPicStart, lPic, iPicFlags,
(double) pExp->value.dNumber, &lResultPos );
_retclen( szResult, lResultPos);
_xfree( szResult );
break;
}
case IT_DATE:
{ /* Date is currently British; Century is on */
szResult = DatePicture( pExp->value.lDate, iPicFlags, &lResultPos );
_retclen( szResult, lResultPos );
_xfree( szResult );
break;
}
default:
{
PHB_ITEM pError = _errNew();
_errPutDescription(pError, "Argument error: TRANSFORM");
_errLaunch(pError);
_errRelease(pError);
_retc("");
}
}
}
else
{
PHB_ITEM pError = _errNew();
_errPutDescription(pError, "Argument error: TRANSFORM");
_errLaunch(pError);
_errRelease(pError);
_retc("");
}
}
else /* No picture supplied */
{
switch( pExp->wType & ~IT_BYREF ) /* Default behaviour */
{
case IT_STRING:
{
_retclen( pExp->value.szText, pExp->wLength);
break;
}
case IT_LOGICAL:
{
_retclen( pExp->value.iLogical ? "T" : "F", 1);
break;
}
case IT_INTEGER:
{
pItem = NumDefault( (double) pExp->value.iNumber );
_retclen( pItem->value.szText, pItem->wLength );
ItemRelease( pItem );
break;
}
case IT_LONG:
{
pItem = NumDefault( (double) pExp->value.lNumber );
_retclen( pItem->value.szText, pItem->wLength );
ItemRelease( pItem );
break;
}
case IT_DOUBLE:
{
pItem = NumDefault( (double) pExp->value.dNumber );
_retclen( pItem->value.szText, pItem->wLength );
ItemRelease( pItem );
break;
}
case IT_DATE:
{
szResult = DatePicture( pExp->value.lDate, iPicFlags, &lResultPos );
_retclen( szResult, lResultPos );
_xfree( szResult );
break;
}
default:
{
PHB_ITEM pError = _errNew();
_errPutDescription(pError, "Argument error: TRANSFORM");
_errLaunch(pError);
_errRelease(pError);
_retc("");
}
}
}
}