/* Copyright (C) 1993 by Thomas Glen Smith. All Rights Reserved. */ /* formdfw APL2 V1.0.0 ************************************************* * Formdfw is called by formdfs in the special case where the input is * * a simple array. * ***********************************************************************/ #define INCLUDES STDIO+APLCB #include "includes.h" Aplcb formdfw(rite) Aplcb rite; /* Simple apl variable to be printed */ { Endoper; Errstop; Form; Formdfy; Formdfv; Getcb; Iscalar; Perm; Reshape; Temp; extern int aplerr; Aplcb cntcb,dimcb,frmcb,out,rowbl; int blanks=0,cols,i,j,k,rows,*rowblp; char *ip,*op; frmcb = perm(form(NULL,rite)); /* intermediate form */ if (frmcb->aplrank < 3) return(errstop(0,NULL,NULL,frmcb)); dimcb = formdfy(frmcb); /* Obtain intermediate shape. */ rows = *(dimcb->aplptr.aplint); /* Product of frmcb dimensions, */ /* except the last dimension. */ cols = *(dimcb->aplptr.aplint + 1); endoper(dimcb); cntcb = reshape(iscalar(frmcb->aplrank - 1), iscalar(0)); rowbl = reshape(iscalar(rows-1),iscalar(0)); /* vector set to 0 */ rowblp = rowbl->aplptr.aplint; /* 1st row spaces counter */ for (i = rowbl->aplcount; i > 0 && aplerr == 0; i--) blanks += *rowblp++ = formdfv(frmcb,cntcb); /* lines betw rows */ endoper(cntcb); out = getcb(NULL, (rows+blanks)*cols, APLCHAR + APLTEMP, 2, NULL); if (aplerr == 0) { *(out->apldim) = rows + blanks; *(out->apldim + 1) = cols; ip = frmcb->aplptr.aplchar; op = out->aplptr.aplchar; rowblp = rowbl->aplptr.aplint; /* 1st row spaces counter */ for (i = rows; i > 0; i--) { for (j = cols; j > 0; j--) *op++ = *ip++; /* copy formatted data */ if (i > 1) /* don't do after last row */ for (k = *rowblp++; k > 0; k--) for (j = cols; j > 0; j--) *op++ = ' '; /* copy blank */ } } return(errstop(0,rowbl,temp(frmcb),out)); }