/* Copyright (C) 1996 by Thomas Glen Smith.	All Rights Reserved. */
/* pickit APL2 V1.0.0 **************************************************
* Called from pick when it is time to pick the result.				 *
***********************************************************************/
#define INCLUDES APLCB
#include "includes.h"
Aplcb pickit(left,rite,pritep,new,final)
Aplcb left,	 /* Indices of rite to the picked element.			 */
	 rite,	 /* Variable from which item is to be picked.		 */
	 new;	 /* If sel. spec., item to replace the picked item.	 */
Aplcb **pritep; /* Pointer to rite in case it needs replacing.		 */
int final;  /* 1 if at deepest desired depth. Item picked this level. */
{
	Aplcopy;Aplnest;Dtacopy;Endoper;Getcb;Indexno;Integer;Perm;Temp;
	extern int aplerr;
	extern int indxorg;
	Aplcb out=NULL,*wrk;
	int errcode=124,p,rtype;
	void *vp;

	for (;;) {
		if (left->aplrank > 1 || left->aplcount != rite->aplrank)
			break;
		if ((left->aplflags & APLMASK) != APLINT) left = integer(left);
		if (aplerr) return(NULL);
		if (final && new && new->aplrank && !(rite->aplflags & APLAPL))
			**pritep = rite = perm(aplnest(temp(rite)));
		p = indexno(left->aplcount, NULL, left->aplptr.aplint,
			rite->apldim, indxorg);
		if (p >= rite->aplcount) break;
		rtype = rite->aplflags & (APLMASK + APLAPL);
		if (final) {
			if (rtype == APLAPL)
				if (NULL != (out = new)) {
                    	endoper(temp(*(wrk=rite->aplptr.aplapl+p)));
					*wrk = perm((new->aplflags & APLTEMP) ?
						new : aplcopy(new));
                    }
				else out = temp(aplcopy(*(rite->aplptr.aplapl+p)));
			else if (NULL != (out = new))
				vp = dtacopy(rite->aplptr.aplchar + p*rite->aplsize,
					new->aplptr.aplchar, 1, 1, rtype);
			else {
				out = getcb(NULL, 1, rtype + APLTEMP, 0, NULL);
				if (aplerr) return(NULL);
				vp = dtacopy(out->aplptr.aplchar,
					rite->aplptr.aplchar + p*rite->aplsize,
						1, 1, rtype);
			}
			errcode = 0;
			break;
		}
		else if (rtype != APLAPL) break;
		*pritep = rite->aplptr.aplapl+p; /* set riteptr */
		return(**pritep); /* return what riteptr points to */
	}
	if (errcode) aplerr = errcode;
	return(out);
}