/* Copyright (C) 1993 by Thomas Glen Smith.	All Rights Reserved. */
/* takepset APL2 V1.0.0 ************************************************
* Called by takeit.  Initializes takeparm for take.                    *
***********************************************************************/
#define INCLUDES APLCB
#include "includes.h"
#include "takeincl.h"
Aplcb takepset(left,rite,p)
Aplcb left,rite;
struct takeparm *p;
{
	Cat; Errstop; Getcb; Iabs; Imonadic; Intcopy; Ireduce; Iscalar;
	Iscan; Itimes; Ivalue; Reverse; Shape;
	extern int aplerr, indxorg;
	Aplcb dimcb,out=NULL;
	int datatyp,*ip,itimesid=0,tempsave;

	p->pilvl = p->polvl = NULL;
	datatyp = rite->aplflags & (APLMASK | APLAPL);
	if (left->aplcount == 0) /* Output w/b scalar. */
		out = getcb(NULL, 1, datatyp + APLTEMP, 0, NULL);
	else { /* Output will have rank > 0. */
		dimcb = imonadic(iabs,left); /* get new dimensions */
		if (aplerr)
			return(errstop(0,left,rite,dimcb));
		dimcb->aplflags -= APLTEMP; /* mark nontemporary */
		out=getcb(NULL,
			ivalue(ireduce(itimes,&itimesid,dimcb,indxorg)),
			datatyp + APLTEMP,dimcb->aplcount,NULL);
		if (out == NULL)
			return(errstop(0,left,rite,out));
		if (dimcb->aplcount) /* dimensions to copy? */
			ip=intcopy(out->apldim,dimcb->aplptr.aplint,dimcb->aplcount,1);
		dimcb->aplflags += APLTEMP;
		p->polvl = cat(iscalar(1),iscan(itimes,&itimesid,
			reverse(dimcb,indxorg),indxorg),indxorg);
		if (aplerr) return(errstop(0,left,rite,out));
		p->pilvl = cat(iscalar(1),iscan(itimes,&itimesid,
			reverse(shape(rite),indxorg),indxorg),indxorg);
		if (aplerr) return(errstop(0,left,rite,out));
	}
	p->pleft = left;
	p->prite = rite;
	p->pout = out;
	p->datain.apldata = rite->aplptr.apldata;
	p->dataout.apldata = out->aplptr.apldata;
	p->ptype = out->aplflags & (APLMASK + APLAPL);
	p->dblfill = 0.0;
	p->intfill = 0;
	p->chrfill = ' ';
	p->aplfill = NULL;
	switch (p->ptype) {
		case APLNUMB: p->fillptr.apldata=&p->dblfill; break;
		case APLINT : p->fillptr.aplint =&p->intfill; break;
		case APLCHAR: p->fillptr.aplchar=&p->chrfill; break;
		case APLAPL:  p->fillptr.aplapl =NULL;		 break;
	} /* end switch */
	return(out);
}