/*Copyright (C) 1995 by Thomas Glen Smith.  All Rights Reserved.*/
/* formatx APL2 V1.0.0 *************************************************
* Called from formatj to obtain the next value to be formatted.		 *
***********************************************************************/
#define INCLUDES APLCB+MATH
#include "includes.h"
double formatx(rite,row,col,cols,pcharlen,ps,pm)
Aplcb rite;	/* APL variable to be formatted. */
int row,col;	/* Current row and col being examined. */
int cols;		/* Total columns in each row. */
int *pcharlen;	/* To be filled with maximum length of char vector. */
int *ps;		/* Set to 1 if a negative value is found. */
int *pm;		/* Set to places right of d.p. */
{	Pow; Precisn;
	extern int apldigs, aplerr;
	double *rp=NULL,val=0e0;
	Aplcb *ap,bp;
	int i,*ip=NULL,n,precis[2];

	*pcharlen = 0; /* Default. */
	switch (rite->aplflags & (APLMASK | APLAPL)) {
		case APLINT: val=*(ip=rite->aplptr.aplint + row*cols + col);
			break;
		case APLNUMB: val=*(rp=rite->aplptr.apldata + row*cols + col);
			break;
		case APLAPL:
			ap = rite->aplptr.aplapl + col; /* start of column */
			bp = *(ap + row * cols);
			switch (bp->aplflags & (APLMASK | APLAPL)) {
				case APLCHAR:
					if (bp->aplrank > 1) aplerr=133; /* Domain */
					*pcharlen = bp->aplcount;
					return(0e0);
				case APLINT:
					if (bp->aplcount > 1) aplerr=133; /* Domain */
					val = *(ip = bp->aplptr.aplint);
					break;
				case APLNUMB:
					if (bp->aplcount > 1) aplerr=133; /* Domain */
					val = *(rp = bp->aplptr.apldata);
					break;
				default:
					aplerr = 133; /* Domain error. */
					break;
			} /* End switch. */
			break;
	} /* End switch. Get here only if numeric to return. */
	precisn(val,precis); /* Get precision for val. */
	n = *pm = precis[1]; /* Get places right of d.p. */
	if (val < 0) {
		val = -val;
		if (!(n == 0 && val < 5e-1))
			*ps = 1;  /* sign */
		else if (rp != NULL)
				*rp = val = 0e0;
			else *ip = val = 0e0;
	}
	return(val);
}