/* 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));
}