Commit | Line | Data |
---|---|---|
36a45446 KT |
1 | # |
2 | ||
3 | /* | |
4 | * monadic epsilon and encode /rww | |
5 | */ | |
6 | ||
7 | #include "apl.h" | |
8 | ||
9 | ex_meps() | |
10 | { | |
11 | register struct item *p; | |
12 | register i,j; | |
13 | struct item *mark; | |
14 | ||
15 | char *a,*b,*c; | |
16 | int dim0,dim1; | |
17 | int xpcp; | |
18 | ||
19 | p = fetch1(); | |
20 | if(p->rank>2 || p->type!=CH) | |
21 | error("execute C"); | |
22 | if(!p->size) { | |
23 | pop(); | |
24 | push(newdat(DA,1,0)); | |
25 | return; | |
26 | } | |
27 | b = p->datap; | |
28 | dim0 = p->rank<2 ? 1 : p->dim[0]; | |
29 | dim1 = p->rank<2 ? p->size : p->dim[1]; | |
30 | a = alloc(dim1+1); | |
31 | xpcp = pcp; | |
32 | mark = sp; | |
33 | for(i=0; i<dim0; i++){ | |
34 | for(j=0; j<dim1; j++) | |
35 | a[j] = b[j]; | |
36 | a[j] = '\n'; | |
37 | c = compile(a,1); | |
38 | execute(c); | |
39 | afree(c); | |
40 | b =+ dim1; | |
41 | if(i < dim0-1) | |
42 | pop(); | |
43 | } | |
44 | afree(a); | |
45 | pcp = xpcp; | |
46 | while(sp>mark) | |
47 | dealloc(*--sp); | |
48 | pop(); | |
49 | push(newdat(DA,1,0)); | |
50 | } | |
51 | ||
52 | ex_menc() | |
53 | { | |
54 | struct item *p; | |
55 | ||
56 | p = fetch1(); | |
57 | if(p->type == CH) | |
58 | menc0(); | |
59 | else | |
60 | menc1(); | |
61 | } | |
62 | ||
63 | menc0() /* dredge up a function and put it into an array*/ | |
64 | { | |
65 | int oifile; | |
66 | char name[NAMS]; | |
67 | char *c, *c2; | |
68 | struct nlist *np; | |
69 | struct item *p; | |
70 | int len, dim0, dim1; | |
71 | register i; | |
72 | register char *dp; | |
73 | ||
74 | p = fetch1(); | |
75 | if(p->size == 0 || p->rank >1 || p->size >= NAMS) | |
76 | error("menc C"); | |
77 | /* set up the name in search format */ | |
78 | copy(CH, p->datap, name, p->size); | |
79 | name[p->size] = '\0'; | |
80 | /* search for name among the functions */ | |
81 | for(np = nlist; np->namep; np++) | |
82 | if(equal(np->namep,name)) | |
83 | break; | |
84 | /* if not found then domain error */ | |
85 | if(!np->namep) | |
86 | error("menc D"); | |
87 | /* set up new array */ | |
88 | dim0 = 0; | |
89 | dim1 = 0; | |
90 | oifile = ifile; | |
91 | ifile = dup(wfile); | |
92 | lseek(ifile, np->label, 0); /* look up function */ | |
93 | /* compute max width and height */ | |
94 | while(c2 = c = rline(0)) | |
95 | { while(*c2++ != '\n'); | |
96 | dim0++; | |
97 | len = c2 - c - 1; | |
98 | dim1 = dim1 < len ? len : dim1; | |
99 | afree(c); | |
100 | } | |
101 | afree(p); /* release old variable */ | |
102 | /* create new array and put function in */ | |
103 | p = newdat(CH, 2, dim0*dim1); | |
104 | p->rank = 2; | |
105 | p->dim[0] = dim0; | |
106 | p->dim[1] = dim1; | |
107 | dp = p->datap; | |
108 | lseek(ifile, np->label, 0); | |
109 | while(c2 = c = rline(0)) | |
110 | { for(i=0; i<dim1; i++) | |
111 | if(*c != '\n') | |
112 | *dp++ = *c++; | |
113 | else | |
114 | *dp++ = ' '; /* fill w/blanks*/ | |
115 | afree(c2); | |
116 | } | |
117 | /* put the new array on the stack */ | |
118 | push(p); | |
119 | /* reset the current file */ | |
120 | ifile = oifile; | |
121 | } | |
122 | ||
123 | menc1()/* change numbers into characters */ | |
124 | { | |
125 | struct item *p, *q; | |
126 | register i,j,numsz; | |
127 | data *dp; | |
128 | int total,param[4]; | |
129 | ||
130 | /* zeroize size information vector */ | |
131 | for(i=0; i<4; i++) | |
132 | param[i] = 0; | |
133 | /* pick up the argument */ | |
134 | p = fetch1(); | |
135 | dp = p->datap; | |
136 | /* find the maximum # of chars in any # */ | |
137 | for(i=0; i<p->size; i++) | |
138 | epr1(*dp++, param); | |
139 | numsz = param[1] + param[2] + !!param[2] + param[3] + 1; | |
140 | /* rowsize is max # size x last dim */ | |
141 | rowsz = p->rank ? p->dim[p->rank-1] : 1; | |
142 | rowsz *= numsz; | |
143 | /* row size x # of rows(incl blank)*/ | |
144 | total = p->size * numsz; | |
145 | for(j=i=0; i<p->rank; i++) | |
146 | if(p->dim[i] != 1) | |
147 | if(j++ > 1) | |
148 | total =+ rowsz; | |
149 | /* make new data and fill with blanks */ | |
150 | q = newdat(CH, 2, total); | |
151 | q->dim[0] = total/rowsz; | |
152 | q->dim[1] = rowsz; | |
153 | mencptr = q->datap; | |
154 | for(i=0; i<total; i++) | |
155 | *mencptr++ = ' '; | |
156 | mencptr = q->datap; | |
157 | /* use putchar()to fill up the array */ | |
158 | mencflg = 2; | |
159 | ex_hprint(); | |
160 | mencflg = 0; | |
161 | /* put it on the stack */ | |
162 | push(q); | |
163 | } |