Metropoli BBS
VIEWER: ravel2.c MODE: TEXT (ASCII)
/* Copyright (C) 1993 by Thomas Glen Smith.	All Rights Reserved. */
/* ravel2 APL2 V1.0.0 **************************************************
* Ravel2 accepts an axis value, where ravel doesn't.				 *
***********************************************************************/
#define INCLUDES APLCHDEF+FUNSTRUC+APLCB
#include "includes.h"
Aplcb ravel2(Aplcb rite, Aplcb axes)
{
	Errstop; Getcb; Intcopy; Integer; Mod; Ravel;
	int ravelck(int, int);
     Aplcb ravel2a(Aplcb, Aplcb, int, int, int);
	extern int aplerr;
	extern int indxorg;
	Aplcb out=NULL;
	int comcnt=0,i,*ip,j,k,lodim=rite->aplrank,m,n,newaxis=1;

	if (axes == NULL) return(ravel(rite));
	for (;;) {
		if (axes->aplrank > 1) {aplerr = 9; break;}
		if (axes->aplflags & APLNUMB && axes->aplcount == 1 &&
			mod(*(axes->aplptr.apldata),1.0) != 0.0) {
			lodim = *(axes->aplptr.apldata);
			if (ravelck(lodim,rite->aplrank))
               	break; /* bad axis */
		}
          else if (axes->aplcount == 0) break; /* all set */
		else { /* combine axes */
			if (axes->aplcount > rite->aplrank) {aplerr = 9; break;}
			if (!(axes->aplflags & APLINT)) axes = integer(axes);
			if (aplerr) break;
			ip = axes->aplptr.aplint;
			k = lodim = -1;
			comcnt = m = axes->aplcount;
			while (m--) {
				j = *ip++ - indxorg; /* next axis, rel. 0 */
				if (ravelck(j,rite->aplrank)) break;
				if (k >= 0 && k != (j - 1)) {aplerr = 9; break;}
				k = j;
				if (lodim == -1) lodim = j; /* save first axis */
                    newaxis *= *(rite->apldim + j); /* combined axis */
			}
		}
		break;
	}
	return(ravel2a(rite,axes,lodim,comcnt,newaxis));
}
[ RETURN TO DIRECTORY ]