Metropoli BBS
VIEWER: form.c MODE: TEXT (ASCII)
/* Copyright (C) 1992 by Thomas Glen Smith.	All Rights Reserved. */
/* form APL2 V1.0.0 ****************************************************
* The main function is to format numeric data in character form for	 *
* display.  There are two arguments, left and rite, left being either  *
* NULL or a scalar/vector containing format specifications.  Rite is	 *
* the data to be formatted, and may be character only if left is NULL, *
* in which case an exact copy is returned.						 *
***********************************************************************/
#define INCLUDES APLCB+FORM
#include "includes.h"
Aplcb form(left,rite)
Aplcb left,rite;
{
	Endoper; Errinit; Errstop; Formata; Formatb; Formatc; Formatd;
	Formatg; Formati; Formatj; Formatk; Formatp; Getcb; Intcopy; Perm;
	Real; Temp;
	extern int aplerr;
	Aplcb cba,dimcb=NULL,out;
	int cols,i,*ip,tempsave;
	char *cp;

	if (errinit()) return(errstop(0,left,rite,NULL));
	if (0==rite->aplcount)
		return(formata(left,rite)); /* return empty */
	if (rite->aplflags & APLCHAR)
		return(formatb(left,rite)); /* return copy of char */
	if (left != NULL)
		if (left->aplflags & APLCHAR)
			return(formatp(left,rite)); /* format by example */
	for(;;) {
		if (rite->aplflags & APLINT) rite = real(rite);
		if (aplerr) break;
		rite=formati(rite,&dimcb); /* Save dimensions, make rite matrix. */
		break;
	}
	if (aplerr) return(errstop(0,left,rite,NULL));
	if (rite->aplflags & APLCPLX)
		return(formatk(left,rite,dimcb)); /* complex numbers */
	cols = *(rite->apldim + 1);
	cba = getcb(NULL,CBALEN*cols,APLINT,2,NULL); /* Work area. */
	if (cba == NULL) return(errstop(0,left,rite,NULL));
	*(cba->apldim) = CBALEN;
	*(cba->apldim + 1) = cols;
	formatj(rite,cba);
	if (aplerr) out=NULL;
	else if (left==NULL)
		formatc(cba);
	else {
		tempsave = left->aplflags & APLTEMP;
		formatd(perm(left),rite,cba);
		left->aplflags += tempsave;
	}
	if (aplerr) out=NULL;
	else out=formatg(rite,cba,dimcb); /* Final format. */
	endoper(temp(dimcb));
	endoper(temp(cba));
	return(errstop(0,left,temp(rite),out));
}
[ RETURN TO DIRECTORY ]