home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / sharew / f_2_c / libi77 / lwrite.c < prev    next >
Encoding:
C/C++ Source or Header  |  1991-06-10  |  2.5 KB  |  149 lines
  1. #include "f2c.h"
  2. #include "fio.h"
  3. #include "fmt.h"
  4. #include "lio.h"
  5. int L_len;
  6.  
  7. t_putc(c)
  8. {
  9.     recpos++;
  10.     putc(c,cf);
  11.     return(0);
  12. }
  13. lwrt_I(n) ftnint n;
  14. {
  15.     char buf[LINTW],*p;
  16. #ifdef USE_STRLEN
  17.     (void) sprintf(buf," %ld",(long)n);
  18.     if(recpos+strlen(buf)>=L_len)
  19. #else
  20.     if(recpos + sprintf(buf," %ld",(long)n) >= L_len)
  21. #endif
  22.         (*donewrec)();
  23.     for(p=buf;*p;PUT(*p++));
  24. }
  25. lwrt_L(n, len) ftnint n; ftnlen len;
  26. {
  27.     if(recpos+LLOGW>=L_len)
  28.         (*donewrec)();
  29.     (void) wrt_L((uint *)&n,LLOGW, len);
  30. }
  31. lwrt_A(p,len) char *p; ftnlen len;
  32. {
  33.     int i;
  34.     if(recpos+len>=L_len)
  35.         (*donewrec)();
  36.     if (!recpos)
  37.         { PUT(' '); ++recpos; }
  38.     for(i=0;i<len;i++) PUT(*p++);
  39. }
  40.  
  41.  static int
  42. l_g(buf, absn) char *buf; double absn;
  43. {
  44.     doublereal n;
  45.     char *fmt;
  46.  
  47.     n = absn;
  48.     if (absn < 0)
  49.         absn = -absn;
  50.     fmt = LLOW <= absn && absn < LHIGH ? LFFMT : LEFMT;
  51. #ifdef USE_STRLEN
  52.     sprintf(buf, fmt, n);
  53.     return strlen(buf);
  54. #else
  55.     return sprintf(buf, fmt, n);
  56. #endif
  57.     }
  58.  
  59.  static void
  60. l_put(s) register char *s;
  61. {
  62.     register int c, (*pn)() = putn;
  63.     while(c = *s++)
  64.         (*pn)(c);
  65.     }
  66.  
  67. lwrt_F(n) double n;
  68. {
  69.     char buf[LEFBL];
  70.  
  71.     if(recpos + l_g(buf,n) >= L_len)
  72.         (*donewrec)();
  73.     l_put(buf);
  74. }
  75. lwrt_C(a,b) double a,b;
  76. {
  77.     char *ba, *bb, bufa[LEFBL], bufb[LEFBL];
  78.     int al, bl;
  79.  
  80.     al = l_g(bufa, a);
  81.     for(ba = bufa; *ba == ' '; ba++)
  82.         --al;
  83.     bl = l_g(bufb, b) + 1;    /* intentionally high by 1 */
  84.     for(bb = bufb; *bb == ' '; bb++)
  85.         --bl;
  86.     if(recpos + al + bl + 3 >= L_len && recpos)
  87.         (*donewrec)();
  88.     PUT(' ');
  89.     PUT('(');
  90.     l_put(ba);
  91.     PUT(',');
  92.     if (recpos + bl >= L_len) {
  93.         (*donewrec)();
  94.         PUT(' ');
  95.         }
  96.     l_put(bb);
  97.     PUT(')');
  98. }
  99. l_write(number,ptr,len,type) ftnint *number,type; char *ptr; ftnlen len;
  100. {
  101. #define Ptr ((flex *)ptr)
  102.     int i;
  103.     ftnint x;
  104.     double y,z;
  105.     real *xx;
  106.     doublereal *yy;
  107.     for(i=0;i< *number; i++)
  108.     {
  109.         switch((int)type)
  110.         {
  111.         default: fatal(204,"unknown type in lio");
  112.         case TYSHORT:
  113.             x=Ptr->flshort;
  114.             goto xint;
  115.         case TYLONG:
  116.             x=Ptr->flint;
  117.         xint:    lwrt_I(x);
  118.             break;
  119.         case TYREAL:
  120.             y=Ptr->flreal;
  121.             goto xfloat;
  122.         case TYDREAL:
  123.             y=Ptr->fldouble;
  124.         xfloat: lwrt_F(y);
  125.             break;
  126.         case TYCOMPLEX:
  127.             xx= &Ptr->flreal;
  128.             y = *xx++;
  129.             z = *xx;
  130.             goto xcomplex;
  131.         case TYDCOMPLEX:
  132.             yy = &Ptr->fldouble;
  133.             y= *yy++;
  134.             z = *yy;
  135.         xcomplex:
  136.             lwrt_C(y,z);
  137.             break;
  138.         case TYLOGICAL:
  139.             lwrt_L(Ptr->flint, len);
  140.             break;
  141.         case TYCHAR:
  142.             lwrt_A(ptr,len);
  143.             break;
  144.         }
  145.         ptr += len;
  146.     }
  147.     return(0);
  148. }
  149.