char id_wrtfmt[] = "@(#)wrtfmt.c 1.11";
* formatted write routines
#define abs(x) (x<0?-x:x)
w_ed(p
,ptr
,len
) char *ptr
; struct syl
*p
; ftnlen len
;
if(cursor
&& (n
=wr_mvcur())) return(n
);
return(wrt_IM(ptr
,p
->p1
,p
->p2
,len
));
return(wrt_L(ptr
,p
->p1
,len
));
return(wrt_AW(ptr
,len
,len
));
return(wrt_AW(ptr
,p
->p1
,len
));
return(wrt_E(ptr
,p
->p1
,p
->p2
,2,len
,'d'));
return(wrt_E(ptr
,p
->p1
,(p
->p2
)&0xff,((p
->p2
)>>8)&0xff,len
,'d'));
return(wrt_E(ptr
,p
->p1
,p
->p2
,2,len
,'e'));
return(wrt_E(ptr
,p
->p1
,(p
->p2
)&0xff,((p
->p2
)>>8)&0xff,len
,'e'));
return(wrt_G(ptr
,p
->p1
,p
->p2
,2,len
));
return(wrt_G(ptr
,p
->p1
,(p
->p2
)&0xff,((p
->p2
)>>8)&0xff,len
));
return(wrt_F(ptr
,p
->p1
,p
->p2
,len
));
w_ned(p
,ptr
) char *ptr
; struct syl
*p
;
if(p
->p1
) cursor
= p
->p1
- recpos
- 1;
else cursor
= 8*p
->p2
- recpos
%8; /* NOT STANDARD FORT */
if ((recpos
+ cursor
) < 0) cursor
= -recpos
; /* ANSI req'd */
/* tab = (p->op == TR); this would implement destructive X */
return(wrt_AP(&s_init
[p
->p1
]));
return(wrt_H(p
->p1
,&s_init
[p
->p2
]));
if(tab
) return((*dotab
)());
if (cursor
< 0) return(errno
=F_ERSEEK
);
wrt_IM(ui
,w
,m
,len
) uint
*ui
; ftnlen len
;
{ int ndigit
,sign
,spare
,i
,xsign
,n
;
if(sizeof(short)==len
) x
=ui
->is
;
/* else if(len == sizeof(char)) x = ui->ic; */
{ for(i
=0;i
<w
;i
++) PUT(' ')
ans
=icvt(x
,&ndigit
,&sign
);
if(sign
|| cplus
) xsign
=1;
if(ndigit
+xsign
>w
|| m
+xsign
>w
)
{ for(i
=0;i
<w
;i
++) PUT('*')
for(i
=0;i
<spare
;i
++) PUT(' ')
for(i
=0;i
<m
-ndigit
;i
++) PUT('0')
for(i
=0;i
<ndigit
;i
++) PUT(*ans
++)
if(cursor
&& (n
=wr_mvcur())) return(n
);
else if(*++s
==quote
) PUT(*s
)
if(cursor
&& (n
=wr_mvcur())) return(n
);
wrt_L(l
,width
,len
) uint
*l
; ftnlen len
;
for(i
=0;i
<width
-1;i
++) PUT(' ')
if(len
== sizeof (short))
wrt_AW(p
,w
,len
) char * p
; ftnlen len
;
wrt_E(p
,w
,d
,e
,len
,expch
) ufloat
*p
; ftnlen len
; char expch
;
int dd
,dp
,sign
,i
,delta
,pad
,n
;
if((len
==sizeof(float)?p
->pf
:p
->pd
)==0.0)
cblank
= 1; /* force '0' fill */
/* for(i=0;i<(e-1);i++)PUT(' ')
/* added */ for(i
=0;i
<e
;i
++) PUT('0')
if (scale
> 0) { /* insane ANSI requirement */
if (dd
<= 0 || d
< 0) goto E_badfield
;
s
=ecvt( (len
==sizeof(float)?(double)p
->pf
:p
->pd
) ,dd
,&dp
,&sign
);
pad
=w
-(delta
+d
)-(scale
>0? scale
:0);
for(i
=0;i
<w
;i
++) PUT('*')
for(i
=0;i
<(pad
-(scale
<=0?1:0));i
++) PUT(' ')
if(scale
<=0 && pad
) PUT('0')
if(scale
<0 && scale
> -d
)
sprintf(ex
,"%d",abs(dp
));
for(i
=0;i
<e
;i
++) PUT('*')
for(i
=0;i
<(e
-pad
);i
++) PUT('0') /* was ' ' */
wrt_G(p
,w
,d
,e
,len
) ufloat
*p
; ftnlen len
;
x
=(len
==sizeof(float)?(double)p
->pf
:p
->pd
);
for(i
=0; i
<=d
; i
++, uplim
*=10.0)
if(n
= wrt_F(p
,w
-ne
,d
-i
,len
)) return(n
);
for(j
=0; j
<ne
; j
++) PUT(' ')
/* falling off the bottom implies E format */
return(wrt_E(p
,w
,d
,e
,len
,'e'));
wrt_F(p
,w
,d
,len
) ufloat
*p
; ftnlen len
;
{ int i
,delta
,dp
,sign
,n
,nf
;
x
= (len
==sizeof(float)?(double)p
->pf
:p
->pd
);
for(i
=0;i
<scale
;i
++) x
*=10;
else for(i
=0;i
<-scale
;i
++) x
/=10;
/* if(-dp>=d) sign=0; ?? */
if(sign
|| cplus
) delta
++;
nf
= w
- (d
+ delta
+ (dp
>0?dp
:0));
for(i
=0;i
<w
;i
++) PUT('*')
if(nf
>0) for(i
=0; i
<(nf
-(dp
<=0?1:0)); i
++) PUT(' ')
if(dp
>0) for(i
=0;i
<dp
;i
++) PUT(*s
++)
for(i
=0; i
< -dp
&& i
<d
; i
++) PUT('0')
{ if(x
==0.0 && !cblank
) PUT(' ') /* exactly zero */