Metropoli BBS
VIEWER: drop2.c MODE: TEXT (ASCII)
/* Copyright (C) 1993 by Thomas Glen Smith.	All Rights Reserved. */
/* drop2 APL2 V1.0.0 ***************************************************
* APL2 drop.												 *
***********************************************************************/
#define INCLUDES APLCB
#include "includes.h"
Aplcb drop2(left, rite, axes)
Aplcb left, rite, axes;
{
	Drop; Endoper; Errinit; Errstop; Getcb; Intcopy; Integer; Iscalar;
    Ravel; Reshape; Shape; Vectin;
    extern int aplerr, indxorg;
    Aplcb newleft=NULL,out=NULL;
    int i,*ip,j,k,rank;
    static int izero=0;

	if (axes == NULL) return(drop(left,rite));
	for(;;) {
		if (errinit()) break;
		if (left->aplrank > 1) {aplerr = 15; break;}
		if (!(APLINT & left->aplflags))
			if (NULL == (left = integer(left))) break;
		if (!(APLINT & axes->aplflags))
			if (NULL == (axes = integer(axes))) break;
		if (left->aplcount != axes->aplcount ||
			left->aplcount > rite->aplrank) {aplerr = 16; break;}
		newleft = getcb(NULL,rite->aplrank,APLINT+APLTEMP,1,NULL);
		if (newleft == NULL) break;
		ip = intcopy(newleft->aplptr.aplint,&izero,newleft->aplcount,0);
		for(i = 0; i < axes->aplcount; i++) {
			j = *(axes->aplptr.aplint + i) - indxorg; /* axis, rel 0 */
			if (j < 0 || j >= rite->aplrank) aplerr = 9; /* bad axis */
			else if (0 != *(ip = newleft->aplptr.aplint + j)) aplerr = 9;
			else *ip = *(left->aplptr.aplint + i);
		}
		if (aplerr) break;
		endoper(left);
		endoper(axes);
		return(drop(newleft,rite));
	}
	endoper(newleft);
	endoper(axes);
	return(errstop(0,left,rite,NULL));
}
[ RETURN TO DIRECTORY ]