+/*
+ * formatted write routines
+ */
+
+#include "fio.h"
+#include "fmt.h"
+
+extern char *icvt();
+
+#define abs(x) (x<0?-x:x)
+
+w_ed(p,ptr,len) char *ptr; struct syl *p; ftnlen len;
+{ int n;
+ if(cursor && (n=wr_mvcur())) return(n);
+ switch(p->op)
+ {
+ case I:
+ case IM:
+ return(wrt_IM(ptr,p->p1,p->p2,len));
+ case L:
+ return(wrt_L(ptr,p->p1));
+ case A:
+ p->p1 = len; /* cheap trick */
+ case AW:
+ return(wrt_AW(ptr,p->p1,len));
+ case D:
+ case DE:
+ case E:
+ case EE:
+ return(wrt_E(ptr,p->p1,p->p2,p->p3,len));
+ case G:
+ case GE:
+ return(wrt_G(ptr,p->p1,p->p2,p->p3,len));
+ case F:
+ return(wrt_F(ptr,p->p1,p->p2,len));
+ default:
+ return(errno=100);
+ }
+}
+
+w_ned(p,ptr) char *ptr; struct syl *p;
+{
+ switch(p->op)
+ {
+ case SLASH:
+ return((*donewrec)());
+ case T:
+ if(p->p1) cursor = p->p1 - recpos - 1;
+#ifndef KOSHER
+ else cursor = 8*p->p2 - recpos%8; /* NOT STANDARD FORT */
+#endif
+ tab = YES;
+ return(OK);
+ case TL:
+ cursor -= p->p1;
+ tab = YES;
+ return(OK);
+ case TR:
+ case X:
+ cursor += p->p1;
+ tab = (p->op == TR);
+ return(OK);
+ case APOS:
+ return(wrt_AP(p->p1));
+ case H:
+ return(wrt_H(p->p1,p->p2));
+ default:
+ return(errno=100);
+ }
+}
+
+wr_mvcur()
+{ int n;
+ if(tab) return((*dotab)());
+ while(cursor--) PUT(' ')
+ return(cursor=0);
+}
+
+wrt_IM(ui,w,m,len) uint *ui; ftnlen len;
+{ int ndigit,sign,spare,i,xsign,n;
+ long x;
+ char *ans;
+ if(sizeof(short)==len) x=ui->is;
+/* else if(len == sizeof(char)) x = ui->ic; */
+ else x=ui->il;
+ if(x==0 && m==0)
+ { for(i=0;i<w;i++) PUT(' ')
+ return(OK);
+ }
+ ans=icvt(x,&ndigit,&sign);
+ if(sign || cplus) xsign=1;
+ else xsign=0;
+ if(ndigit+xsign>w || m+xsign>w)
+ { for(i=0;i<w;i++) PUT('*')
+ return(OK);
+ }
+ if(ndigit>=m)
+ spare=w-ndigit-xsign;
+ else
+ spare=w-m-xsign;
+ for(i=0;i<spare;i++) PUT(' ')
+ if(sign) PUT('-')
+ else if(cplus) PUT('+')
+ for(i=0;i<m-ndigit;i++) PUT('0')
+ for(i=0;i<ndigit;i++) PUT(*ans++)
+ return(OK);
+}
+
+wrt_AP(p)
+{ char *s,quote;
+ int n;
+ if(cursor && (n=wr_mvcur())) return(n);
+ s=(char *)p;
+ quote = *s++;
+ for(; *s; s++)
+ { if(*s!=quote) PUT(*s)
+ else if(*++s==quote) PUT(*s)
+ else return(OK);
+ }
+ return(OK);
+}
+
+wrt_H(a,b)
+{ char *s=(char *)b;
+ int n;
+ if(cursor && (n=wr_mvcur())) return(n);
+ while(a--) PUT(*s++)
+ return(OK);
+}
+
+wrt_L(l,len) ftnint *l;
+{ int i,n;
+ for(i=0;i<len-1;i++) PUT(' ')
+ if(*l) PUT('t')
+ else PUT('f')
+ return(OK);
+}
+
+wrt_AW(p,w,len) char * p; ftnlen len;
+{ int n;
+ while(w>len)
+ { w--;
+ PUT(' ')
+ }
+ while(w-- > 0)
+ PUT(*p++)
+ return(OK);
+}
+
+wrt_E(p,w,d,e,len) ufloat *p; ftnlen len;
+{ char *s,ex[4],expch;
+ int dd,dp,sign,i,delta,pad,n;
+ char *ecvt();
+ expch=(len==sizeof(float)?'e':'d');
+ if((len==sizeof(float)?p->pf:p->pd)==0.0)
+ {
+ wrt_F(p,w-(e+2),d,len);
+ PUT(expch)
+ PUT('+')
+/* for(i=0;i<(e-1);i++)PUT(' ')
+deleted PUT('0')
+ */
+/* added */ for(i=0;i<e;i++) PUT('0')
+ return(OK);
+ }
+ dd = d + scale;
+ s=ecvt( (len==sizeof(float)?(double)p->pf:p->pd) ,dd,&dp,&sign);
+ delta = 3+e;
+ if(sign||cplus) delta++;
+ pad=w-(delta+d);
+ if(pad<0)
+ { for(i=0;i<w;i++) PUT('*')
+ return(OK);
+ }
+ for(i=0;i<(pad-(scale<=0?1:0));i++) PUT(' ')
+ if(sign) PUT('-')
+ else if(cplus) PUT('+')
+ if(scale<=0 && pad) PUT('0')
+ if(scale<0 && scale > -d)
+ {
+ PUT('.')
+ for(i=0;i<-scale;i++)
+ PUT('0')
+ for(i=0;i<d+scale;i++)
+ PUT(*s++)
+ }
+ else if(scale>0)
+ { for(i=0;i<scale;i++)
+ PUT(*s++)
+ PUT('.')
+ for(i=0;i<d-scale;i++)
+ PUT(*s++)
+ }
+ else
+ { PUT('.')
+ for(i=0;i<d;i++) PUT(*s++)
+ }
+ dp -= scale;
+ sprintf(ex,"%d",abs(dp));
+ if((pad=strlen(ex))>e)
+ { if(pad>(++e))
+ { PUT(expch)
+ for(i=0;i<e;i++) PUT('*')
+ return(OK);
+ }
+ }
+ else PUT(expch)
+ PUT(dp<0?'-':'+')
+ for(i=0;i<(e-pad);i++) PUT('0') /* was ' ' */
+ s= &ex[0];
+ while(*s) PUT(*s++)
+ return(OK);
+}
+
+wrt_G(p,w,d,e,len) ufloat *p; ftnlen len;
+{ double uplim = 1.0, x;
+ int i,oldscale,n,j,ne;
+ x=(len==sizeof(float)?(double)p->pf:p->pd);
+ i=d;
+ if(x==0.0) goto zero;
+ x = abs(x);
+ if(x>=0.1)
+ {
+ for(i=0; i<=d; i++, uplim*=10.0)
+ { if(x>uplim) continue;
+zero: oldscale=scale;
+ scale=0;
+ ne = e+2;
+ if(n = wrt_F(p,w-ne,d-i,len)) return(n);
+ for(j=0; j<ne; j++) PUT(' ')
+ scale=oldscale;
+ return(OK);
+ }
+ /* falling off the bottom implies E format */
+ }
+ return(wrt_E(p,w,d,e,len));
+}
+
+wrt_F(p,w,d,len) ufloat *p; ftnlen len;
+{ int i,delta,dp,sign,n,nf;
+ double x;
+ char *s,*fcvt();
+ x= (len==sizeof(float)?(double)p->pf:p->pd);
+ if(scale && x!=0.0)
+ { if(scale>0)
+ for(i=0;i<scale;i++) x*=10;
+ else for(i=0;i<-scale;i++) x/=10;
+ }
+ s=fcvt(x,d,&dp,&sign);
+/* if(-dp>=d) sign=0; ?? */
+ delta=1;
+ if(sign || cplus) delta++;
+ nf = w - (d + delta + (dp>0?dp:0));
+ if(nf<0)
+ {
+ for(i=0;i<w;i++) PUT('*')
+ return(OK);
+ }
+ if(nf>0) for(i=0; i<(nf-(dp<=0?1:0)); i++) PUT(' ')
+ if(sign) PUT('-')
+ else if(cplus) PUT('+')
+ if(dp>0) for(i=0;i<dp;i++) PUT(*s++)
+ else if(nf>0) PUT('0')
+ PUT('.')
+ for(i=0; i< -dp && i<d; i++) PUT('0')
+ for(;i<d;i++)
+ { if(x==0.0) PUT(' ') /* exactly zero */
+ else if(*s) PUT(*s++)
+ else PUT('0')
+ }
+ return(OK);
+}
projects / unix-history / commitdiff