Metropoli BBS
VIEWER: takesub.c MODE: TEXT (ASCII)
/* Copyright (C) 1993 by Thomas Glen Smith.	All Rights Reserved. */
/* takesub APL2 V1.0.0 *************************************************
* Called by takeit.                                                    *
* Recursively called to copy input to output during take operations.	 *
***********************************************************************/
#define INCLUDES APLCB
#include "includes.h"
#include "takeincl.h"
takesub(level,p)
int level; /* current dimension */
struct takeparm *p;
{
	Dtacopy; Takefill;
	int headcnt,headmax,iels,inamt,incnt,ix,oels,outcnt,rix,subcnt,
		takecnt;
	char *cp,*dp,*ep,*fp,*gp,*hp;

	outcnt = *(p->pout->apldim + level); /* outcnt = output dim. */
	takecnt = *(p->pleft->aplptr.aplint + level); /* takecnt = take value */
	if (p->prite->aplrank)
		incnt = *(p->prite->apldim + level);
	else incnt = 1; /* incnt = current input dimension */
	ix = p->pout->aplrank - 1 - level;
	iels = *(p->pilvl->aplptr.aplint + ix);
		/* # els indexed by this input dim. */
	oels = *(p->polvl->aplptr.aplint + ix);
		/* # els indexed by this output dim. */
	cp = p->datain.aplchar; /* save current datain ptr */
	if (0 > takecnt) { /* take from right */
		if (0 > (takecnt += incnt)) { /* Front fill? */
			p->dataout.aplchar = dtacopy(p->dataout.aplchar,
				takefill(p), (-takecnt) * oels, 0, p->ptype);
			outcnt += takecnt; /* Note: takecnt < 0. */
		}
		else { /* skip some input */
			cp += takecnt * iels * p->pout->aplsize;
			incnt -= takecnt;
		}
	}
	inamt = imin(outcnt,incnt); /* amount obtained from input */
	if (level+1 < p->pout->aplrank)
		for (rix = 0; rix < inamt; rix++) {
			p->datain.aplchar = cp + rix * iels * p->pout->aplsize;
			takesub(level+1, p); /* recurse */
		}
	else /* bottom level */
		p->dataout.aplchar =
			dtacopy(p->dataout.aplchar, cp, inamt, 1, p->ptype);
	if (outcnt -= inamt) /* Back fill? */
		/* outcnt == # subarrays along this axis to fill. */
          p->dataout.aplchar = dtacopy(p->dataout.aplchar,
               takefill(p), outcnt * oels, 0, p->ptype);
}
[ RETURN TO DIRECTORY ]