Commit | Line | Data |
---|---|---|
be4e9b86 | 1 | /* |
0d3e2fa7 | 2 | char id_wrtfmt[] = "@(#)wrtfmt.c 1.3"; |
be4e9b86 DW |
3 | * |
4 | * formatted write routines | |
5 | */ | |
6 | ||
7 | #include "fio.h" | |
43666f58 | 8 | #include "format.h" |
be4e9b86 DW |
9 | |
10 | extern char *icvt(); | |
11 | ||
12 | #define abs(x) (x<0?-x:x) | |
13 | ||
14 | w_ed(p,ptr,len) char *ptr; struct syl *p; ftnlen len; | |
15 | { int n; | |
16 | if(cursor && (n=wr_mvcur())) return(n); | |
17 | switch(p->op) | |
18 | { | |
19 | case I: | |
20 | case IM: | |
21 | return(wrt_IM(ptr,p->p1,p->p2,len)); | |
22 | case L: | |
23 | return(wrt_L(ptr,p->p1)); | |
24 | case A: | |
25 | p->p1 = len; /* cheap trick */ | |
26 | case AW: | |
27 | return(wrt_AW(ptr,p->p1,len)); | |
28 | case D: | |
29 | case DE: | |
30 | case E: | |
31 | case EE: | |
32 | return(wrt_E(ptr,p->p1,p->p2,p->p3,len)); | |
33 | case G: | |
34 | case GE: | |
35 | return(wrt_G(ptr,p->p1,p->p2,p->p3,len)); | |
36 | case F: | |
37 | return(wrt_F(ptr,p->p1,p->p2,len)); | |
38 | default: | |
43666f58 | 39 | return(errno=F_ERFMT); |
be4e9b86 DW |
40 | } |
41 | } | |
42 | ||
43 | w_ned(p,ptr) char *ptr; struct syl *p; | |
44 | { | |
45 | switch(p->op) | |
46 | { | |
47 | case SLASH: | |
48 | return((*donewrec)()); | |
49 | case T: | |
50 | if(p->p1) cursor = p->p1 - recpos - 1; | |
51 | #ifndef KOSHER | |
52 | else cursor = 8*p->p2 - recpos%8; /* NOT STANDARD FORT */ | |
53 | #endif | |
54 | tab = YES; | |
55 | return(OK); | |
56 | case TL: | |
57 | cursor -= p->p1; | |
58 | tab = YES; | |
59 | return(OK); | |
60 | case TR: | |
61 | case X: | |
62 | cursor += p->p1; | |
63 | tab = (p->op == TR); | |
64 | return(OK); | |
65 | case APOS: | |
66 | return(wrt_AP(p->p1)); | |
67 | case H: | |
68 | return(wrt_H(p->p1,p->p2)); | |
69 | default: | |
43666f58 | 70 | return(errno=F_ERFMT); |
be4e9b86 DW |
71 | } |
72 | } | |
73 | ||
74 | wr_mvcur() | |
75 | { int n; | |
76 | if(tab) return((*dotab)()); | |
77 | while(cursor--) PUT(' ') | |
78 | return(cursor=0); | |
79 | } | |
80 | ||
81 | wrt_IM(ui,w,m,len) uint *ui; ftnlen len; | |
82 | { int ndigit,sign,spare,i,xsign,n; | |
83 | long x; | |
84 | char *ans; | |
85 | if(sizeof(short)==len) x=ui->is; | |
86 | /* else if(len == sizeof(char)) x = ui->ic; */ | |
87 | else x=ui->il; | |
88 | if(x==0 && m==0) | |
89 | { for(i=0;i<w;i++) PUT(' ') | |
90 | return(OK); | |
91 | } | |
92 | ans=icvt(x,&ndigit,&sign); | |
93 | if(sign || cplus) xsign=1; | |
94 | else xsign=0; | |
95 | if(ndigit+xsign>w || m+xsign>w) | |
96 | { for(i=0;i<w;i++) PUT('*') | |
97 | return(OK); | |
98 | } | |
99 | if(ndigit>=m) | |
100 | spare=w-ndigit-xsign; | |
101 | else | |
102 | spare=w-m-xsign; | |
103 | for(i=0;i<spare;i++) PUT(' ') | |
104 | if(sign) PUT('-') | |
105 | else if(cplus) PUT('+') | |
106 | for(i=0;i<m-ndigit;i++) PUT('0') | |
107 | for(i=0;i<ndigit;i++) PUT(*ans++) | |
108 | return(OK); | |
109 | } | |
110 | ||
111 | wrt_AP(p) | |
112 | { char *s,quote; | |
113 | int n; | |
114 | if(cursor && (n=wr_mvcur())) return(n); | |
115 | s=(char *)p; | |
116 | quote = *s++; | |
117 | for(; *s; s++) | |
118 | { if(*s!=quote) PUT(*s) | |
119 | else if(*++s==quote) PUT(*s) | |
120 | else return(OK); | |
121 | } | |
122 | return(OK); | |
123 | } | |
124 | ||
125 | wrt_H(a,b) | |
126 | { char *s=(char *)b; | |
127 | int n; | |
128 | if(cursor && (n=wr_mvcur())) return(n); | |
129 | while(a--) PUT(*s++) | |
130 | return(OK); | |
131 | } | |
132 | ||
133 | wrt_L(l,len) ftnint *l; | |
134 | { int i,n; | |
135 | for(i=0;i<len-1;i++) PUT(' ') | |
136 | if(*l) PUT('t') | |
137 | else PUT('f') | |
138 | return(OK); | |
139 | } | |
140 | ||
141 | wrt_AW(p,w,len) char * p; ftnlen len; | |
142 | { int n; | |
143 | while(w>len) | |
144 | { w--; | |
145 | PUT(' ') | |
146 | } | |
147 | while(w-- > 0) | |
148 | PUT(*p++) | |
149 | return(OK); | |
150 | } | |
151 | ||
152 | wrt_E(p,w,d,e,len) ufloat *p; ftnlen len; | |
153 | { char *s,ex[4],expch; | |
154 | int dd,dp,sign,i,delta,pad,n; | |
155 | char *ecvt(); | |
156 | expch=(len==sizeof(float)?'e':'d'); | |
157 | if((len==sizeof(float)?p->pf:p->pd)==0.0) | |
158 | { | |
159 | wrt_F(p,w-(e+2),d,len); | |
160 | PUT(expch) | |
161 | PUT('+') | |
162 | /* for(i=0;i<(e-1);i++)PUT(' ') | |
163 | deleted PUT('0') | |
164 | */ | |
165 | /* added */ for(i=0;i<e;i++) PUT('0') | |
166 | return(OK); | |
167 | } | |
168 | dd = d + scale; | |
169 | s=ecvt( (len==sizeof(float)?(double)p->pf:p->pd) ,dd,&dp,&sign); | |
170 | delta = 3+e; | |
171 | if(sign||cplus) delta++; | |
172 | pad=w-(delta+d)-(scale>0? scale:0); | |
173 | if(pad<0) | |
174 | { for(i=0;i<w;i++) PUT('*') | |
175 | return(OK); | |
176 | } | |
177 | for(i=0;i<(pad-(scale<=0?1:0));i++) PUT(' ') | |
178 | if(sign) PUT('-') | |
179 | else if(cplus) PUT('+') | |
180 | if(scale<=0 && pad) PUT('0') | |
181 | if(scale<0 && scale > -d) | |
182 | { | |
183 | PUT('.') | |
184 | for(i=0;i<-scale;i++) | |
185 | PUT('0') | |
186 | for(i=0;i<d+scale;i++) | |
187 | PUT(*s++) | |
188 | } | |
189 | else | |
190 | { | |
191 | if(scale>0) | |
192 | for(i=0;i<scale;i++) | |
193 | PUT(*s++) | |
194 | PUT('.') | |
195 | for(i=0;i<d;i++) | |
196 | PUT(*s++) | |
197 | } | |
198 | dp -= scale; | |
199 | sprintf(ex,"%d",abs(dp)); | |
200 | if((pad=strlen(ex))>e) | |
201 | { if(pad>(++e)) | |
202 | { PUT(expch) | |
203 | for(i=0;i<e;i++) PUT('*') | |
204 | return(OK); | |
205 | } | |
206 | } | |
207 | else PUT(expch) | |
208 | PUT(dp<0?'-':'+') | |
209 | for(i=0;i<(e-pad);i++) PUT('0') /* was ' ' */ | |
210 | s= &ex[0]; | |
211 | while(*s) PUT(*s++) | |
212 | return(OK); | |
213 | } | |
214 | ||
215 | wrt_G(p,w,d,e,len) ufloat *p; ftnlen len; | |
216 | { double uplim = 1.0, x; | |
217 | int i,oldscale,n,j,ne; | |
218 | x=(len==sizeof(float)?(double)p->pf:p->pd); | |
219 | i=d; | |
220 | if(x==0.0) goto zero; | |
221 | x = abs(x); | |
222 | if(x>=0.1) | |
223 | { | |
224 | for(i=0; i<=d; i++, uplim*=10.0) | |
225 | { if(x>uplim) continue; | |
226 | zero: oldscale=scale; | |
227 | scale=0; | |
228 | ne = e+2; | |
229 | if(n = wrt_F(p,w-ne,d-i,len)) return(n); | |
230 | for(j=0; j<ne; j++) PUT(' ') | |
231 | scale=oldscale; | |
232 | return(OK); | |
233 | } | |
234 | /* falling off the bottom implies E format */ | |
235 | } | |
236 | return(wrt_E(p,w,d,e,len)); | |
237 | } | |
238 | ||
239 | wrt_F(p,w,d,len) ufloat *p; ftnlen len; | |
240 | { int i,delta,dp,sign,n,nf; | |
241 | double x; | |
242 | char *s,*fcvt(); | |
243 | x= (len==sizeof(float)?(double)p->pf:p->pd); | |
244 | if(scale && x!=0.0) | |
245 | { if(scale>0) | |
246 | for(i=0;i<scale;i++) x*=10; | |
247 | else for(i=0;i<-scale;i++) x/=10; | |
248 | } | |
249 | s=fcvt(x,d,&dp,&sign); | |
250 | /* if(-dp>=d) sign=0; ?? */ | |
251 | delta=1; | |
252 | if(sign || cplus) delta++; | |
253 | nf = w - (d + delta + (dp>0?dp:0)); | |
254 | if(nf<0) | |
255 | { | |
256 | for(i=0;i<w;i++) PUT('*') | |
257 | return(OK); | |
258 | } | |
259 | if(nf>0) for(i=0; i<(nf-(dp<=0?1:0)); i++) PUT(' ') | |
260 | if(sign) PUT('-') | |
261 | else if(cplus) PUT('+') | |
262 | if(dp>0) for(i=0;i<dp;i++) PUT(*s++) | |
263 | else if(nf>0) PUT('0') | |
264 | PUT('.') | |
265 | for(i=0; i< -dp && i<d; i++) PUT('0') | |
266 | for(;i<d;i++) | |
0d3e2fa7 | 267 | { if(x==0.0 && !cblank) PUT(' ') /* exactly zero */ |
be4e9b86 DW |
268 | else if(*s) PUT(*s++) |
269 | else PUT('0') | |
270 | } | |
271 | return(OK); | |
272 | } |