Metropoli BBS
VIEWER: decode.c MODE: TEXT (ASCII)
/*Copyright (C) 1992, 1996 by Thomas Glen Smith.  All Rights Reserved.*/
/* decode APL2 V1.0.0 **************************************************
* RITE treated as vectors along its first axis, each vector converted  *
* to scalar according to the vector of radices along last axis of LEFT.*
***********************************************************************/
#define INCLUDES APLCB
#include "includes.h"
Aplcb decode(left,rite)
Aplcb left,rite;
{
#define Copy(A,B) {A[0]=B[0]; if (datatyp==APLCPLX) A[1]=B[1];}
	Errstop; Innrcom; Matchok; Plusp; Plusx; Timesp; Timesx;
	void (*plus)(double *, double *, double*);
	void (*times)(double *, double *, double*);
	int axicnt,bump,datatyp,i,j,k,m,n,p,r,laxicnt,laxis,lbotcnt,lincr,
		ltopcnt,raxicnt,rbotcnt,rincr,rtopcnt;
	double *dataout,*ldata,*rdata,*ip,*jp,*kp,*mp,*np,radix[2],
		wrka[2],wrkb[2],wrkc[2];
	static double one[2]={1e0,0e0},zero[2]={0e0,0e0};
	Aplcb out;

	if (!matchok(&left, &rite, APLCPLX + APLNUMB)) return(NULL);
	out = innrcom(0,left,rite,&laxis,&laxicnt,&lbotcnt,&ltopcnt,
			&lincr,&raxicnt,&rbotcnt,&rtopcnt,&rincr,&datatyp,
			(char**)&dataout,(char**)&ldata,(char**)&rdata);
	if (out == NULL) return(NULL);
	switch (datatyp) {
		case APLNUMB: plus = plusp; times = timesp; bump=1; break;
		case APLCPLX: plus = plusx; times = timesx; bump=2; break;
	} /* end switch */
	axicnt = raxicnt;
	for (i = 0; i < ltopcnt; i++) {
		/* ip = ldata + i*axicnt*lincr*bump; */
        ip = ldata + i*bump*(lincr ? axicnt : 1);
		for (j = 0; j < lbotcnt; j++) {
			jp = ip + j*bump;
			for (k = 0; k < rtopcnt; k++) {
				kp = rdata + k*axicnt*rincr*bump;
				for (m = 0; m < rbotcnt; m++) {
					mp = kp + (m + axicnt*rincr)*bump;
					np = jp + axicnt*lincr*bump;
					Copy(radix,one)
					Copy(wrka,zero)
					for (n = 0; n < axicnt; n++) {
						Copy(wrkb,radix)
						mp -= rincr*bump;
						(*times)(wrkb,mp,wrkc);
						Copy(wrkb,wrka)
						(*plus)(wrkb,wrkc,wrka);
						np -= lincr*bump;
						Copy(wrkc,radix)
						(*times)(wrkc,np,radix);
					}
					Copy(dataout,wrka)
					dataout += bump;
	}	}	}	}
	return(errstop(0,left,rite,out));
}
[ RETURN TO DIRECTORY ]