| 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 | } |