rexx/lstring/format.c

   1 /*
   2  * $Header$
   3  * $Log$
   4  * Revision 1.1  2001/04/04 05:43:37  wang
   5  * First commit: compiles on Linux, Amiga, Windows, Windows CE, generic gcc
   6  *
   7  * Revision 1.3  1999/11/26 09:56:55  bnv
   8  * Changed: Use of swprintf in CE version.
   9  *
  10  * Revision 1.2  1999/06/10 14:09:24  bnv
  11  * Added the possibility to use the E,F or G format of C printf
  12  *
  13  * Revision 1.1  1998/07/02 17:18:00  bnv
  14  * Initial Version
  15  *
  16  */
  17
  18 #include <lstring.h>
  19
  20 /* ---------------- Lformat ------------------ */
  21 void
  22 Lformat( const PLstr to, const PLstr from,
  23         long before, long after, long expp, long expt )
  24 {
  25 /****************
  26         Lstr tmp,Integer,Befo,Afte,Mantissa,Exponent;
  27         long i,j,Point,Afters;
  28         int  Sign,ShowExp;
  29
  30         LINITSTR(tmp);
  31         LINITSTR(Integer);
  32         LINITSTR(Befo);
  33         LINITSTR(Afte);
  34         LINITSTR(Mantissa);
  35         LINITSTR(Exponent);
  36
  37         Lspace(&tmp,from,0,' ');        // * trim spaces *
  38
  39         for (i=0; i<LLEN(tmp); i++)     // * split in Mantissa 'E' Exponent *
  40                 if (LSTR(tmp)[i]=='e' || LSTR(tmp)[i]=='E') {
  41                         Lsubstr(&Exponent,&tmp,i+2,0,' ');
  42                         Lsubstr(&Mantissa,&tmp,1,i,' ');
  43                         goto Lfo10;
  44                 }
  45         Lstrcpy(&Mantissa,&tmp);
  46 Lfo10:
  47         Sign = (LLSTR(Mantissa)[0] == '-');
  48         if (Sign) {
  49                 Lstrcpy(&tmp,&Mantissa);
  50                 Lsubstr(&Mantissa,&tmp,2,0,' ');
  51         }
  52
  53         for (i=0; i<LLEN(Mantissa); i++)
  54                 if (LSTR(Mantissa)[i]=='.') {
  55                         Lleft(&Befo,&Mantissa,i,' ');
  56                         Lsubstr(&Afte,&Mantissa,i+2,0,' ');
  57                         goto Lfo20;
  58                 }
  59         Lstrcpy(&Befo,&Mantissa);
  60 Lfo20:
  61         Point = LLEN(Befo);
  62
  63         // * Sign, Mantissa and Exponent now reflect the number. Befo, Afte
  64         // * and Point reflect Mantissa *
  65
  66         // * The fourth and fifth argument allow for exponential notation.
  67         // * Decide whether exponential form to be used, setting ShowExp. *
  68
  69         ShowExp = 0;
  70         L2INT(&Exponent);
  71
  72         if (expp>=0 || expt>=0) {
  73                 if (expt<0) expt = digits.level;
  74                 // * decide whether exponential form to be used. *
  75                 if ((Point + LINT(Exponent)) > expt)
  76                         ShowExp = 1;    // * Digits before rule. *
  77                 LeftOfPoint = 0;
  78                 if (LLEN(Befo) > 0)
  79                         LeftOfPoint = Befo;     // * Value left of the point *
  80
  81                 // * Digits after point rule for exponentiation *
  82                 // * Count zeros to right of point *
  83                 z = 0;
  84                 while (LSTR(Afte)[z] == '0') z++;
  85                 if ((LeftOfPoint=0) && ((z-LINT(Exponent)) > 5)) ShowExp = 1
  86
  87                 // * An extra rule for exponential form *
  88                 if (expp=0) ShowExp = 0;
  89
  90                 // * Construct the exponential part of the result. *
  91                 if (ShowExp) {
  92                         LINT(Exponent) = LINT(Exponent) + (Point-1);
  93                         Point = 1;      // * As required for scientific *
  94                         if (digits.form = ENGINEERING)
  95                                 while (LINT(Exponent)%3 != 0) {
  96                                         Point++;
  97                                         LINT(Exponent) -= 1;
  98                                 }
  99                 } else
 100                         Point += LINT(Exponent);
 101         } else {
 102                 // * If expp and expt are not given, exponential notation
 103                 // *  will be used if the original number+0 done by
 104                 // *  checkArgs led to it. *
 105                 if (LINT(Exponent))
 106                         ShowExp = 1;
 107         }
 108
 109         Lstrcpy(&Integer,&Befo);
 110         Lstrcat(&Integer,&Afte);
 111         if (Point<1) {  // * Add extra zeros on the left *
 112                 Lstrcpy(&tmp,&Integer);
 113                 Lstrset(&Integer,1-Point,'0');
 114                 Lstrcat(&Integer,&tmp);
 115                 Point = 1;
 116         }
 117
 118         If (Point>LLEN(Integer)) {      // * and maybe on the right *
 119                 Lleft(&tmp,&Integer,Point,'0');
 120                 Lstrcpy(&Integer,&tmp);
 121         }
 122         // *  Deal with right of decimal point first since that can affect
 123         //   the left. Ensure the requested number of digits there. *
 124         Afters = LLEN(Integer) - Point;
 125         if (after==0) after = Afters;
 126         // * make Afters match the requested after *
 127         if (Afters<after) {
 128                 Lleft(&tmp,&Integer,LLEN(Integer)+after-Afters,'0');
 129                 Lstrcpy(&Integer,&tmp);
 130         }
 131
 132 ......
 133
 134         LFREESTR(tmp);
 135         LFREESTR(Integer);
 136         LFREESTR(befo);
 137         LFREESTR(afte);
 138         LFREESTR(mantissa);
 139         LFREESTR(exponent);
 140 *********************/
 141         double  r;
 142
 143         r = Lrdreal(from);
 144         Lfx(to,(size_t)(before+after+10));
 145         LTYPE(*to) = LSTRING_TY;
 146
 147         if (before<0) before = 0;
 148         if (after<0)  after  = 0;
 149         if (after) before += (after+1);
 150 #ifndef WCE
 151         sprintf(LSTR(*to),
 152                 (expp<=0)? "%#*.*lf":
 153                         (expp==1)? "%#*.*lG" : "%#*.*lE",
 154                 (int)before,(int)after,r);
 155         LLEN(*to) = STRLEN(LSTR(*to));
 156 #else
 157         {
 158                 TCHAR   buf[20];
 159 //      GCVT(r,before,LSTR(*to));
 160                 swprintf(buf,(expp<=0)? TEXT("%#*.*lf"):
 161                         (expp==1)? TEXT("%#*.*lG") : TEXT("%#*.*lE"),
 162                         (int)before,(int)after,r);
 163                 wcstombs(LSTR(*to),buf,LLEN(*to)=wcslen(buf));
 164         }
 165 #endif
 166 } /* Lformat */