|
|
1.1 root 1: #include "fio.h"
2: #include "fmt.h"
3: extern int cursor;
4: mv_cur()
5: { /*buggy, could move off front of record*/
6: for(;cursor>0;cursor--) (*putn)(' ');
7: if(cursor<0)
8: {
9: if(cursor+recpos<0) err(elist->cierr,110,"left off");
10: if(curunit->useek) fseek(cf,(long)cursor,1);
11: else err(elist->cierr,106,"fmt");
12: cursor=0;
13: }
14: return(0);
15: }
16: w_ed(p,ptr,len) char *ptr; struct syl *p; ftnlen len;
17: {
18: if(mv_cur()) return(mv_cur());
19: switch(p->op)
20: {
21: default:
22: fprintf(stderr,"w_ed, unexpected code: %d\n%s\n",
23: p->op,fmtbuf);
24: abort();
25: case I: return(wrt_I(ptr,p->p1,len, 10));
26: case IM:
27: return(wrt_IM(ptr,p->p1,p->p2,len));
28: case O: return(wrt_I(ptr, p->p1, len, 8));
29: case L: return(wrt_L(ptr,p->p1));
30: case A: return(wrt_A(ptr,len));
31: case AW:
32: return(wrt_AW(ptr,p->p1,len));
33: case D:
34: case E:
35: case EE:
36: return(wrt_E(ptr,p->p1,p->p2,p->p3,len));
37: case G:
38: case GE:
39: return(wrt_G(ptr,p->p1,p->p2,p->p3,len));
40: case F: return(wrt_F(ptr,p->p1,p->p2,len));
41: }
42: }
43: w_ned(p,ptr) char *ptr; struct syl *p;
44: {
45: switch(p->op)
46: {
47: default: fprintf(stderr,"w_ned, unexpected code: %d\n%s\n",
48: p->op,fmtbuf);
49: abort();
50: case SLASH:
51: return((*donewrec)());
52: case T: cursor = p->p1-recpos - 1;
53: return(1);
54: case TL: cursor -= p->p1;
55: return(1);
56: case TR:
57: case X:
58: cursor += p->p1;
59: return(1);
60: case APOS:
61: return(wrt_AP(p->p1));
62: case H:
63: return(wrt_H(p->p1,p->p2));
64: }
65: }
66: wrt_I(n,w,len, base) uint *n; ftnlen len; register int base;
67: { int ndigit,sign,spare,i;
68: long x;
69: char *ans;
70: if(len==sizeof(short)) x=n->is;
71: else if(len == sizeof(char)) x = n->ic;
72: else x=n->il;
73: ans=icvt(x,&ndigit,&sign, base);
74: spare=w-ndigit;
75: if(sign || cplus) spare--;
76: if(spare<0)
77: for(i=0;i<w;i++) (*putn)('*');
78: else
79: { for(i=0;i<spare;i++) (*putn)(' ');
80: if(sign) (*putn)('-');
81: else if(cplus) (*putn)('+');
82: for(i=0;i<ndigit;i++) (*putn)(*ans++);
83: }
84: return(0);
85: }
86: wrt_IM(n,w,m,len) uint *n; ftnlen len;
87: { int ndigit,sign,spare,i,xsign;
88: long x;
89: char *ans;
90: if(sizeof(short)==len) x=n->is;
91: else if(len == sizeof(char)) x = n->ic;
92: else x=n->il;
93: ans=icvt(x,&ndigit,&sign, 10);
94: if(sign || cplus) xsign=1;
95: else xsign=0;
96: if(ndigit+xsign>w || m+xsign>w)
97: { for(i=0;i<w;i++) (*putn)('*');
98: return(0);
99: }
100: if(x==0 && m==0)
101: { for(i=0;i<w;i++) (*putn)(' ');
102: return(0);
103: }
104: if(ndigit>=m)
105: spare=w-ndigit-xsign;
106: else
107: spare=w-m-xsign;
108: for(i=0;i<spare;i++) (*putn)(' ');
109: if(sign) (*putn)('-');
110: else if(cplus) (*putn)('+');
111: for(i=0;i<m-ndigit;i++) (*putn)('0');
112: for(i=0;i<ndigit;i++) (*putn)(*ans++);
113: return(0);
114: }
115: wrt_AP(n)
116: { char *s,quote;
117: if(mv_cur()) return(mv_cur());
118: s=(char *)n;
119: quote = *s++;
120: for(;*s;s++)
121: { if(*s!=quote) (*putn)(*s);
122: else if(*++s==quote) (*putn)(*s);
123: else return(1);
124: }
125: return(1);
126: }
127: wrt_H(a,b)
128: { char *s=(char *)b;
129: if(mv_cur()) return(mv_cur());
130: while(a--) (*putn)(*s++);
131: return(1);
132: }
133: wrt_L(n,len) ftnint *n;
134: { int i;
135: for(i=0;i<len-1;i++)
136: (*putn)(' ');
137: if(*n) (*putn)('t');
138: else (*putn)('f');
139: return(0);
140: }
141: wrt_A(p,len) char *p; ftnlen len;
142: {
143: while(len-- > 0) (*putn)(*p++);
144: return(0);
145: }
146: wrt_AW(p,w,len) char * p; ftnlen len;
147: {
148: while(w>len)
149: { w--;
150: (*putn)(' ');
151: }
152: while(w-- > 0)
153: (*putn)(*p++);
154: return(0);
155: }
156: wrt_E(p,w,d,e,len) ufloat *p; ftnlen len;
157: { char *s;
158: int dp,sign,i,delta;
159: char *ecvt();
160: if(scale>0) d++;
161: s=ecvt( (len==sizeof(float)?p->pf:p->pd) ,d,&dp,&sign);
162: if(sign || cplus) delta=6;
163: else delta=5;
164: if(w<delta+d)
165: { for(i=0;i<w;i++) (*putn)('*');
166: return(0);
167: }
168: for(i=0;i<w-(delta+d);i++) (*putn)(' ');
169: if(sign) (*putn)('-');
170: else if(cplus) (*putn)('+');
171: if(scale<0 && scale > -d)
172: {
173: (*putn)('.');
174: for(i=0;i<-scale;i++)
175: (*putn)('0');
176: for(i=0;i<d+scale;i++)
177: (*putn)(*s++);
178: }
179: else if(scale>0 && scale<d+2)
180: { for(i=0;i<scale;i++)
181: (*putn)(*s++);
182: (*putn)('.');
183: for(i=0;i<d-scale;i++)
184: (*putn)(*s++);
185: }
186: else
187: { (*putn)('.');
188: for(i=0;i<d;i++) (*putn)(*s++);
189: }
190: if(p->pf != 0) dp -= scale;
191: else dp = 0;
192: if(dp < 100 && dp > -100) (*putn)('e');
193: if(dp<0)
194: { (*putn)('-');
195: dp = -dp;
196: }
197: else (*putn)('+');
198: if(e>=3 || dp >= 100)
199: { (*putn)(dp/100 + '0');
200: dp = dp % 100;
201: }
202: if(e!=1) (*putn)(dp/10+'0');
203: (*putn)(dp%10+'0');
204: return(0);
205: }
206: wrt_G(p,w,d,e,len) ufloat *p; ftnlen len;
207: { double up = 1,x;
208: int i,oldscale=scale,n,j;
209: x= len==sizeof(float)?p->pf:p->pd;
210: if(x < 0 ) x = -x;
211: if(x<.1) return(wrt_E(p,w,d,e,len));
212: for(i=0;i<=d;i++,up*=10)
213: { if(x>up) continue;
214: scale=0;
215: if(e==0) n=4;
216: else n=e+2;
217: i=wrt_F(p,w-n,d-i,len);
218: for(j=0;j<n;j++) (*putn)(' ');
219: scale=oldscale;
220: return(i);
221: }
222: return(wrt_E(p,w,d,e,len));
223: }
224: wrt_F(p,w,d,len) ufloat *p; ftnlen len;
225: { int i,delta,dp,sign,n;
226: double x;
227: char *s,*fcvt();
228: x= (len==sizeof(float)?p->pf:p->pd);
229: if(scale)
230: { if(scale>0)
231: for(i=0;i<scale;i++) x*=10;
232: else for(i=0;i<-scale;i++) x/=10;
233: }
234: s=fcvt(x,d,&dp,&sign);
235: if(-dp>=d) sign=0;
236: if(sign || cplus) delta=2;
237: else delta=1;
238: n= w - (d+delta+(dp>0?dp:0));
239: if(n<0)
240: {
241: for(i=0;i<w;i++) PUT('*');
242: return(0);
243: }
244: for(i=0;i<n;i++) PUT(' ');
245: if(sign) PUT('-');
246: else if(cplus) PUT('+');
247: for(i=0;i<dp;i++) PUT(*s++);
248: PUT('.');
249: for(i=0;i< -dp && i<d;i++) PUT('0');
250: for(;i<d;i++)
251: { if(*s) PUT(*s++);
252: else PUT('0');
253: }
254: return(0);
255: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.