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