/* Copyright (C) 1993 by Thomas Glen Smith.	All Rights Reserved. */
/* enclosf APL2 V1.0.0 *************************************************
* Called by enclose for non-NULL axes.                                 *
***********************************************************************/
#define INCLUDES APLCB
#include "includes.h"
Aplcb enclosf(Aplcb rite, Aplcb axes)
{
	Cat; Dtacopy; Enclose; Errstop; Getcbi; Indexm; Indxsub; Integer;
	Perm; Ravel; Shape; Temp; Transpos; Without;
	extern int aplerr,indxorg;
	Aplcb axeout=NULL,dimin=NULL,dimout=NULL,dimsub=NULL,*icb,out=NULL,
		tmp,*ocb;
	int cntout,cntsub,i,*ip,j,rank,ranksub,tempaxes=0,temprite,typesub;
	char *cp;

	for (;;) { /* lets me use break */
		rite->aplflags -= (temprite = rite->aplflags & APLTEMP);
		if (!(axes->aplflags & APLINT)) axes = integer(axes);
		if (aplerr) break;
		axes->aplflags -= (tempaxes = axes->aplflags & APLTEMP);
		typesub = rite->aplflags & (APLMASK + APLAPL);
		if (NULL == (dimsub = perm(indexm((dimin = perm(shape(rite))),
			enclose(ravel(axes),NULL),NULL)))) break;
		for(i = 0, cntsub = 1; i < (ranksub = dimsub->aplcount); i++)
			cntsub *= *(dimsub->aplptr.aplint + i);
		axeout = perm(ravel(without(indxsub(rite->aplrank),axes)));
		if (aplerr) break;
		if (NULL == (dimout = indexm(dimin,enclose(axeout,NULL),NULL)))
			break;
		for(i = 0, cntout = 1; i < (rank = dimout->aplcount); i++)
			cntout *= *(dimout->aplptr.aplint + i);
		if (NULL == (out = getcbi(NULL,cntout,APLAPL+APLTEMP,rank,
			dimout->aplptr.aplint))) break;
		rite->aplflags += temprite;
		temprite = 0;
		if (NULL == (rite = ravel(transpos(cat(axeout,axes,-1),rite))))
			break;
		cp = rite->aplptr.aplchar;
		for (i = 0, ocb = out->aplptr.aplapl; i < cntout; i++) {
			*ocb++ = tmp = getcbi(NULL,cntsub,typesub,ranksub,
				dimsub->aplptr.aplint);
			if (tmp != NULL)
				dtacopy(tmp->aplptr.aplchar,cp,cntsub,1,typesub);
			cp += cntsub * rite->aplsize;
		}
		break; /* get out of for loop */
	}
	endoper(temp(axeout));
	endoper(temp(dimin));
	endoper(temp(dimout));
	endoper(temp(dimsub));
	if (axes != NULL) axes->aplflags += tempaxes;
	if (rite != NULL) rite->aplflags += temprite;
	return(errstop(0,axes,rite,out));
}