[unix-history] / usr / src / cmd / apl / ak.c

#include "apl.h"

ex_scn0()
{
	fetch1();
	scan0(0);
}

ex_scan()
{
	register struct item *p;

	p = fetch1();
	scan0(p->rank-1);
}

ex_scnk()
{
	register i;

	i = topfix() - thread.iorg;
	scan0(i);
}

scan0(k)
{
	register struct item *p, *q;
	int param[2];
	int scan1();

	p = fetch1();
	if(p->type != DA)
		error("scan T");

	bidx(p);
	colapse(k);
	if(idx.dimk == 0) {
/*
 *  scan identities - ets/jrl 5/76
 */
		q = newdat(DA,0,1);
		q->dim[0] = 1;
		switch(*pcp++) {
	case ADD:
	case SUB:
	case OR:
			q->datap[0] = 0;
			break;
	case AND:
	case MUL:
	case DIV:
			q->datap[0] = 1;
			break;
	case MIN:
			q->datap[0] = 1.0e38;
			break;
	case MAX:
			q->datap[0] = -1.0e38;
			break;
	default:
			error("reduce identity");
		}
		pop();
		push(q);
		return;
	}
	param[0] = p->datap;
	param[1] = exop[*pcp++];
	forloop(scan1, param);
}

scan1(param)
int param[];
{
	register i;
	register data *dp;
	data d;
	data (*f)();

	dp = param[0];
	f = param[1];
	dp =+ access();
	d = *dp;
	for(i = 1; i < idx.dimk; i++) {
		dp =+ idx.delk;
		*dp = d = (*f)(*dp, d);
	}
}

data scalex  453.;
data scaley  453.;
data origx  0.0;
data origy  0.0;

ex_plot()
{
	register struct item *p;
	register data *dp;
	register i;
	int ic;
	int x, y;

	p = fetch1();
	if(p->type != DA)
		error("plot T");
	if(p->rank != 2)
		error("plot R");
	if(p->dim[1] != 2)
		error("plot C");

	dp = p->datap;
	if ((i = p->dim[0]) == 0) return;
	ic=0;
	while(i--) {
		x = scalex*(*dp++ - origx);
		y = 454-(scaley*(*dp++ - origy));
		if(x<0 || x >= 576 ||
		 y<0 || y>=454)
			error("plot off screen");
		if(ic)
			line(x,y);
		else {
			move(x,y);
			ic=1;
		}
	}
}
Commit	Line	Data
957bb13d BJ	1	#include "apl.h"
	2
	3	ex_scn0()
	4	{
	5	fetch1();
	6	scan0(0);
	7	}
	8
	9	ex_scan()
	10	{
	11	register struct item *p;
	12
	13	p = fetch1();
	14	scan0(p->rank-1);
	15	}
	16
	17	ex_scnk()
	18	{
	19	register i;
	20
	21	i = topfix() - thread.iorg;
	22	scan0(i);
	23	}
	24
	25	scan0(k)
	26	{
	27	register struct item p, q;
	28	int param[2];
	29	int scan1();
	30
	31	p = fetch1();
	32	if(p->type != DA)
	33	error("scan T");
	34
	35	bidx(p);
	36	colapse(k);
	37	if(idx.dimk == 0) {
	38	/*
	39	* scan identities - ets/jrl 5/76
	40	*/
	41	q = newdat(DA,0,1);
	42	q->dim[0] = 1;
	43	switch(*pcp++) {
	44	case ADD:
	45	case SUB:
	46	case OR:
	47	q->datap[0] = 0;
	48	break;
	49	case AND:
	50	case MUL:
	51	case DIV:
	52	q->datap[0] = 1;
	53	break;
	54	case MIN:
	55	q->datap[0] = 1.0e38;
	56	break;
	57	case MAX:
	58	q->datap[0] = -1.0e38;
	59	break;
	60	default:
	61	error("reduce identity");
	62	}
	63	pop();
	64	push(q);
65	return;
66	}
67	param[0] = p->datap;
68	param[1] = exop[*pcp++];
69	forloop(scan1, param);
70	}
71
72	scan1(param)
73	int param[];
74	{
75	register i;
76	register data *dp;
77	data d;
78	data (*f)();
79
80	dp = param[0];
81	f = param[1];
82	dp =+ access();
83	d = *dp;
84	for(i = 1; i < idx.dimk; i++) {
85	dp =+ idx.delk;
86	dp = d = (f)(*dp, d);
87	}
88	}
89
90	data scalex 453.;
91	data scaley 453.;
92	data origx 0.0;
93	data origy 0.0;
94
95	ex_plot()
96	{
97	register struct item *p;
98	register data *dp;
99	register i;
100	int ic;
101	int x, y;
102
103	p = fetch1();
104	if(p->type != DA)
105	error("plot T");
106	if(p->rank != 2)
107	error("plot R");
108	if(p->dim[1] != 2)
109	error("plot C");
110
111	dp = p->datap;
112	if ((i = p->dim[0]) == 0) return;
113	ic=0;
114	while(i--) {
115	x = scalex(dp++ - origx);
116	y = 454-(scaley(dp++ - origy));
117	if(x<0 \|\| x >= 576 \|\|
118	y<0 \|\| y>=454)
119	error("plot off screen");
120	if(ic)
121	line(x,y);
122	else {
123	move(x,y);
124	ic=1;
125	}
126	}
127	}