#include "f2c.h"
#include "fio.h"

#ifndef KR_headers
#undef abs
#undef min
#undef max
#include "stdlib.h"
#include "string.h"
#endif

#include "fmt.h"
#include "fp.h"
#ifndef VAX
#include "ctype.h"
#ifdef __cplusplus
extern "C" {
#endif
#endif

 int
#ifdef KR_headers
wrt_E(p,w,d,e,len) ufloat *p; ftnlen len;
#else
wrt_E(ufloat *p, int w, int d, int e, ftnlen len)
#endif
{
  char buf[FMAX+EXPMAXDIGS+4], *s, *se;
  int d1, delta, e1, i, sign, signspace;
  double dd;
#ifdef WANT_LEAD_0
  int insert0 = 0;
#endif
#ifndef VAX
  int e0 = e;
#endif

  if(e <= 0)
         e = 2;
  if(f__scale) {
         if(f__scale >= d + 2 || f__scale <= -d)
                goto nogood;
         }
  if(f__scale <= 0)
         --d;
  if(len == sizeof(real))
         dd = p->pf;
  else
         dd = p->pd;
  if(dd < 0.) {
         signspace = sign = 1;
         dd = -dd;
         }
  else {
         sign = 0;
         signspace = (int)f__cplus;
#ifndef VAX
         if(!dd) {
#ifdef SIGNED_ZEROS
                if(signbit_f2c(&dd))
                       signspace = sign = 1;
#endif
                dd = 0.;       /* avoid -0 */
                }
#endif
         }
  delta = w - (2 /* for the . and the d adjustment above */
                + 2 /* for the E+ */ + signspace + d + e);
#ifdef WANT_LEAD_0
  if(f__scale <= 0 && delta > 0) {
         delta--;
         insert0 = 1;
         }
  else
#endif
  if(delta < 0) {
nogood:
         while(--w >= 0)
                PUT('*');
         return(0);
         }
  if(f__scale < 0)
         d += f__scale;
  if(d > FMAX) {
         d1 = d - FMAX;
         d = FMAX;
         }
  else
         d1 = 0;
  sprintf(buf,"%#.*E", d, dd);
#ifndef VAX
  /* check for NaN, Infinity */
  if(!isdigit(buf[0])) {
         switch(buf[0]) {
                case 'n':
                case 'N':
                       signspace = 0;       /* no sign for NaNs */
                }
         delta = w - strlen(buf) - signspace;
         if(delta < 0)
                goto nogood;
         while(--delta >= 0)
                PUT(' ');
         if(signspace)
                PUT(sign ? '-' : '+');
         for(s = buf; *s; s++)
                PUT(*s);
         return 0;
         }
#endif
  se = buf + d + 3;
#ifdef GOOD_SPRINTF_EXPONENT /* When possible, exponent has 2 digits. */
  if(f__scale != 1 && dd)
         sprintf(se, "%+.2d", atoi(se) + 1 - f__scale);
#else
  if(dd)
         sprintf(se, "%+.2d", atoi(se) + 1 - f__scale);
  else
         strcpy(se, "+00");
#endif
  s = ++se;
  if(e < 2) {
         if(*s != '0')
                goto nogood;
         }
#ifndef VAX
  /* accommodate 3 significant digits in exponent */
  if(s[2]) {
#ifdef Pedantic
         if(!e0 && !s[3])
                for(s -= 2, e1 = 2; s[0] = s[1]; s++);

  /* Pedantic gives the behavior that Fortran 77 specifies,       */
  /* i.e., requires that E be specified for exponent fields       */
  /* of more than 3 digits.  With Pedantic undefined, we get       */
  /* the behavior that Cray displays -- you get a bigger              */
  /* exponent field if it fits.       */
#else
         if(!e0) {
                for(s -= 2, e1 = 2; (s[0] = s[1]); s++)
#ifdef CRAY
                       delta--;
                if((delta += 4) < 0)
                       goto nogood
#endif
                       ;
                }
#endif
         else if(e0 >= 0)
                goto shift;
         else
                e1 = e;
         }
  else
 shift:
#endif
         for(s += 2, e1 = 2; *s; ++e1, ++s)
                if(e1 >= e)
                       goto nogood;
  while(--delta >= 0)
         PUT(' ');
  if(signspace)
         PUT(sign ? '-' : '+');
  s = buf;
  i = f__scale;
  if(f__scale <= 0) {
#ifdef WANT_LEAD_0
         if(insert0)
                PUT('0');
#endif
         PUT('.');
         for(; i < 0; ++i)
                PUT('0');
         PUT(*s);
         s += 2;
         }
  else if(f__scale > 1) {
         PUT(*s);
         s += 2;
         while(--i > 0)
                PUT(*s++);
         PUT('.');
         }
  if(d1) {
         se -= 2;
         while(s < se) PUT(*s++);
         se += 2;
         do PUT('0'); while(--d1 > 0);
         }
  while(s < se)
         PUT(*s++);
  if(e < 2)
         PUT(s[1]);
  else {
         while(++e1 <= e)
                PUT('0');
         while(*s)
                PUT(*s++);
         }
  return 0;
  }

 int
#ifdef KR_headers
wrt_F(p,w,d,len) ufloat *p; ftnlen len;
#else
wrt_F(ufloat *p, int w, int d, ftnlen len)
#endif
{
  int d1, sign, n;
  double x;
  char *b, buf[MAXINTDIGS+MAXFRACDIGS+4], *s;

  x= (len==sizeof(real)?p->pf:p->pd);
  if(d < MAXFRACDIGS)
         d1 = 0;
  else {
         d1 = d - MAXFRACDIGS;
         d = MAXFRACDIGS;
         }
  if(x < 0.)
         { x = -x; sign = 1; }
  else {
         sign = 0;
#ifndef VAX
         if(!x) {
#ifdef SIGNED_ZEROS
                if(signbit_f2c(&x))
                       sign = 2;
#endif
                x = 0.;
                }
#endif
         }

  if((n = f__scale)) {
         if(n > 0)
                do x *= 10.; while(--n > 0);
         else
                do x *= 0.1; while(++n < 0);
  }

#ifdef USE_STRLEN
  sprintf(b = buf, "%#.*f", d, x);
  n = strlen(b) + d1;
#else
  n = sprintf(b = buf, "%#.*f", d, x) + d1;
#endif

#ifndef WANT_LEAD_0
  if(buf[0] == '0' && d)
         { ++b; --n; }
#endif
  if(sign == 1) {
         /* check for all zeros */
         for(s = b;;) {
                while(*s == '0') s++;
                switch(*s) {
                       case '.':
                              s++; continue;
                       case 0:
                              sign = 0;
                       }
                break;
                }
         }
  if(sign || f__cplus)
         ++n;
  if(n > w) {
#ifdef WANT_LEAD_0
         if(buf[0] == '0' && --n == w)
                ++b;
         else
#endif
         {
                while(--w >= 0)
                       PUT('*');
                return 0;
                }
         }
  for(w -= n; --w >= 0; )
         PUT(' ');
  if(sign)
         PUT('-');
  else if(f__cplus)
         PUT('+');
  while((n = *b++))
         PUT(n);
  while(--d1 >= 0)
         PUT('0');
  return 0;
  }
#ifdef __cplusplus
}
#endif
