/* Copyright (C) 1994 by Thomas Glen Smith. All Rights Reserved. */ /* formatq APL2 V1.0.0 ************************************************* * Called by formatp to finish format-by-example processing. * ***********************************************************************/ #define INCLUDES APLCB+STDIO+STRING #include "includes.h" Aplcb formatq(left,rite,cols,rows,width,cnt,field) Aplcb left; /* Format Control */ Aplcb rite; /* Values to format. */ int cols, /* Number of columns of output. */ rows, /* Number of rows of output. */ width, /* Number of characters in a row of output. */ cnt; /* Cnt = cols or 1. */ char *field; /* Buffer in which to format. */ { Chrcopy; Getcb; Formatl; Formatr; Formaty; Intcopy; Treesrch; extern int aplerr; int colt,i,*ip,rank; Aplcb fc,out; char *bp,buf[80],*ce,ch,*cp,*fch=NULL,*op,*oq,*start=NULL; double *dp; if (0 == (rank = rite->aplrank)) rank = 1; out = getcb(NULL,rows*width,APLTEMP+APLCHAR,rank,NULL); if (out == NULL) return(NULL); if (rank > 1) { ip = intcopy(out->apldim,rite->apldim,rank-1,1); *ip = width; } for (i = 0; i < out->aplcount; i++) /* Initialize out to blanks. */ *(out->aplptr.aplchar + i) = ' '; fch = formaty(); op = out->aplptr.aplchar; /* Next place to store output. */ dp = rite->aplptr.apldata; /* Next value to format. */ while(rows-- && aplerr == 0) { /* Once for each row. */ cp = left->aplptr.aplchar; /* Ptr to format control. */ ce = left->aplcount + cp; /* Ptr to end format control. */ colt = cols; while(colt-- && aplerr == 0) { /* Once for each col. */ if (cnt == 1) /* replicate a single field. */ cp = left->aplptr.aplchar; for (;;) { cp = formatl(field,cp,&start); /* Next field. */ if (start != NULL) break; /* Break if not decorator */ op = chrcopy(op,field,strlen(field),1); /* Copy dec. */ } op = formatr(op,field,*dp++,fch); } if (cp < ce && aplerr == 0) { /* must be a trailing decorator */ cp = formatl(field,cp,&start); /* get decorator */ op = chrcopy(op,field,strlen(field),1); /* copy */ } } return(out); }