/* Copyright (C) 1993 by Thomas Glen Smith.  All Rights Reserved. */
/* formdfs APL2 V1.0.0 *************************************************
* Formdfs is called by formdft and formdfu to obtain the formatted	*
* representation of a nested array, including interdimensional	    *
* spacing.  The argument to formdfs is guaranteed to be nested.	   *
***********************************************************************/
#define INCLUDES STDIO+APLCB
#include "includes.h"
Aplcb formdfs(rite)
Aplcb rite; /* apl variable to be printed, marked permanent. */
{
#include "formdft.h" /* Common declarations. */
	Errstop; Formdfu; Formdfw; Formdfy; Getcb; Intcopy; Iscalar; Perm;
	Reshape; Temp;
	extern int aplerr,indxorg;
	Aplcb out,   /* Final output.					 */
		 dimcb; /* Dimensions for frmcb.			   */
	int *ip,*rowblp,*rowhip,v;

	if (!(rite->aplflags & APLAPL))
		return(formdfw(rite)); /* simple array */
	dimcb = formdfy(rite); /* Obtain intermediate shape. */
	if (aplerr) return(errstop(0,NULL,NULL,dimcb));
	frmcb = getcb(NULL, rite->aplcount, APLAPL + APLTEMP, 2, NULL);
	ip = intcopy(frmcb->apldim, dimcb->aplptr.aplint, 2, 1);
	endoper(dimcb); /* free after copying dimensions */
	rows = *(frmcb->apldim); /* rows in frmcb */
	cols = *(frmcb->apldim + 1); /* columns in frmcb */
	if (2 < (dimcnt = rite->aplrank))
		cntcb = reshape(iscalar(rite->aplrank-1),iscalar(0));
	else cntcb = NULL; /* See formdfv for description of cntcb usage. */
	colwi = perm(reshape(iscalar(cols),  iscalar(0))); /* vector of 0s */
	colbl = perm(reshape(iscalar(cols-1),iscalar(0))); /* vector of 0s */
	rowhi = reshape(iscalar(rows),  iscalar(0)); /* vector of 0s */
	rowbl = reshape(iscalar(rows-1),iscalar(0)); /* vector of 0s */
	numcb = reshape(iscalar(cols),  iscalar(1)); /* vector of 1s */
	chrcb = reshape(iscalar(cols),  iscalar(1)); /* vector of 1s */
	icb = rcb = rite->aplptr.aplapl; /* point to 1st input element */
	ocb = frmcb->aplptr.aplapl; /* point to 1st intermediate element */
	if (aplerr == 0)
		if (frmcb->aplcount) {
			v = (dimcnt < 2); /* v = 1 if output is vector. */
			rowblp = rowbl->aplptr.aplint; /* row spaces counters */
			rowhip = rowhi->aplptr.aplint; /* row height counters */
			out = formdfu(cols,rows,dimcnt,v,rowblp,rowhip,icb,ocb,rcb,
				chrcb,cntcb,colbl,colwi,frmcb,numcb,rite,rowbl,rowhi);
		}
		else {
			out = frmcb; /* return empty */
			frmcb = NULL;
		}
	endoper(temp(colbl)); endoper(temp(colwi)); endoper(chrcb);
	endoper(cntcb); endoper(frmcb); endoper(rowbl); endoper(rowhi);
	return(errstop(0,numcb,rite,out));
}