/* Copyright (C) 1993 by Thomas Glen Smith.	All Rights Reserved. */
/* indexv APL2 V1.0.0 ***************************************************
* Called by transpot.                                                   *
* Left points to an APL variable from, and perhaps to, which values are *
* to be indexed.  Indices identifies the index values to be used.  If   *
* rite isn't NULL, it contains values to be stored in the indexed	  *
* elements of left.  The actual shape of left is ignored, and the	  *
* indices must be chosen as though left were a vector.				  *
************************************************************************/
#define INCLUDES APLCB
#include "includes.h"
Aplcb indexv(left,indices,rite)
Aplcb left, indices, rite;
{
	Dtacopy; Errinit; Errstop; Getcb; Matchok; Temp; Vectin;
	extern int aplerr, indxorg;
	Aplcb ixcb,out=NULL;
	int datatyp,i,*ix,j,riteincr=0;
	char *cp,*dp,*outdata,*ritedata;

	if (errinit())
		return(errstop(0,left,indices,rite));
	if (rite == NULL)
		ritedata = NULL;
	else {
		if (!matchok(&left,&rite,APLMASK+APLAPL))
			return(errstop(0,NULL,indices,NULL));
		if (rite->aplcount > 1) {
			if (rite->aplcount != indices->aplcount)
				return(errstop(35,left,indices,rite)); /* bad data count */
			riteincr=rite->aplsize;
		}
		ritedata = rite->aplptr.aplchar;
	}
	if (NULL == (ixcb=temp(vectin(indices)))) /* get integer vector */
		return(errstop(0,left,rite,NULL));
	datatyp = left->aplflags & (APLMASK | APLAPL);
	out=getcb(NULL,ixcb->aplcount,datatyp + APLTEMP,1,NULL);
	outdata = out->aplptr.aplchar;
	ix = ixcb->aplptr.aplint;
	for(i=0; i<ixcb->aplcount; i++) {
		j=*ix++ - indxorg; /* next index */
		if (j > left->aplcount - indxorg || j < 0)
			aplerr=34; /* index out of range */
		else {
			cp = left->aplptr.aplchar + left->aplsize * j;
				/* cp is ptr to data to update/extract */
			if (rite != NULL) { /* is there update data? */
				dp=dtacopy(cp,ritedata,1,1,datatyp); /* update */
				ritedata += riteincr; /* increment update data ptr */
			}
			outdata=dtacopy(outdata,cp,1,1,datatyp); /* extract */
		}
	}
	endoper(ixcb);
	return(errstop(0,left,rite,out));
}