Add definition for %FE and redefine FE. in terms of it - #29

Add definitions for %FEL and %FER - %FE with left and right padding - #29
ikysil · Sep 24, 2017 · 8d33007 · 8d33007
1 parent b20857b
commit 8d33007
Show file tree

Hide file tree

Showing 2 changed files with 83 additions and 25 deletions.
diff --git a/lib/~ik/float-output.4th b/lib/~ik/float-output.4th
@@ -91,12 +91,8 @@ ONLY FORTH DEFINITIONS ALSO FLOAT-OUTPUT-PRIVATE
 ;
 
 
-: FE. (F r -- ) \ 12.6.2.1513 FE.
-   \G Display, with a trailing space, the top number on the floating-point stack using engineering notation,
-   \G where the significand is greater than or equal to 1.0 and less than 1000.0 and the decimal exponent is a multiple of three.
-   \G
-   \G An ambiguous condition exists if the value of BASE is not (decimal) ten or if the character string representation exceeds
-   \G the size of the pictured numeric output string buffer.
+: %FE (F r -- )
+   \G Append string representation of floating point number r using engineering notation to the current formatted string.
    +S"BUFFER /S"BUFFER
    2DUP BL FILL
    PRECISION MIN
@@ -105,9 +101,9 @@ ONLY FORTH DEFINITIONS ALSO FLOAT-OUTPUT-PRIVATE
    2R> -TRAILING 2>R
    IF
       \ r was in the implementation-defined range of floating-point numbers.
-      IF  [CHAR] - EMIT  THEN
-      2R> DUP 0=  IF  SPACE 2DROP DROP EXIT  THEN
-      OVER C@ DUP [CHAR] 0 <> SWAP EMIT
+      %SIGN
+      2R> DUP 0=  IF  2DROP DROP EXIT  THEN
+      OVER C@ DUP [CHAR] 0 <> SWAP %C
       IF
          1 /STRING
          2>R
@@ -118,27 +114,61 @@ ONLY FORTH DEFINITIONS ALSO FLOAT-OUTPUT-PRIVATE
          WHILE
             2R>
             1 /STRING
-            OVER C@ EMIT
+            OVER C@ %C
             2>R
             1-
          REPEAT
          DROP
-         [CHAR] . EMIT
+         %DOT
          2R>
-         TYPE
+         %S
       ELSE
          2DROP
-         [CHAR] . EMIT
+         %DOT
          0
       THEN
-      [CHAR] E EMIT
-      - 1- S>D (D.)
+      [CHAR] E %C
+      - 1- %N
    ELSE
       2DROP
       2R>
-      TYPE
+      %S
    THEN
-   SPACE
+;
+
+
+: %FEL (S uw -- ) (F r -- )
+   \G Append string representation of floating point number r using engineering notation to the current formatted string.
+   \G The string representation is left justified in the field of minimum width uw.
+   %CURR NIP + >R
+   %FE
+   %CURR NIP R> SWAP - 0 MAX %SPACES
+;
+
+
+: %FER (S uw -- ) (F r -- )
+   \G Append string representation of floating point number r using engineering notation to the current formatted string.
+   \G The string representation is right justified in the field of minimum width uw.
+   %CURR CHARS + >R          \ S: uw                 R: c-addr1
+   %FE
+   %CURR CHARS +             \ S: uw c-addr2         R: c-addr1
+   DUP R@ - DUP >R           \ S: uw c-addr2 uf      R: c-addr1 uf
+   ROT CHARS SWAP - 0 MAX    \ S: c-addr2 usp        R: c-addr1
+   NIP DUP %SPACES           \ S: usp                R: c-addr1 uf
+   R> R@ ROT                 \ S: uf c-addr1 usp     R: c-addr1
+   DUP >R                    \ S: uf c-addr1 usp     R: c-addr1 usp
+   OVER + ROT MOVE           \ S:                    R: c-addr1 usp
+   R> R> SWAP BL FILL
+;
+
+
+: FE. (F r -- ) \ 12.6.2.1513 FE.
+   \G Display, with a trailing space, the top number on the floating-point stack using engineering notation,
+   \G where the significand is greater than or equal to 1.0 and less than 1000.0 and the decimal exponent is a multiple of three.
+   \G
+   \G An ambiguous condition exists if the value of BASE is not (decimal) ten or if the character string representation exceeds
+   \G the size of the pictured numeric output string buffer.
+   <% %FE BL %C %> TYPE
 ;
 
 
@@ -158,11 +188,33 @@ REPORT-NEW-NAME !
 
 \EOF
 
-123.e  25  <% '|' %c %fsl '|' %c %> cr type
-123.e  25  <% '|' %c %fsl '|' %c %> cr type
--123.e  25  <% '|' %c %fsr '|' %c %> cr type
--123.e  25  <% '|' %c %fsr '|' %c %> cr type
-123.e 15  <% '|' %c %fsl '|' %c %> cr type
-123.e 15  <% '|' %c %fsr '|' %c %> cr type
--123.e 15  <% '|' %c %fsl '|' %c %> cr type
--123.e 15  <% '|' %c %fsr '|' %c %> cr type
+123.e    25 <% %CR '|' %c %fsl '|' %c %> type
+123.e    25 <% %CR '|' %c %fsl '|' %c %> type
+-123.e   25 <% %CR '|' %c %fsr '|' %c %> type
+-123.e   25 <% %CR '|' %c %fsr '|' %c %> type
+123.e    15 <% %CR '|' %c %fsl '|' %c %> type
+123.e    15 <% %CR '|' %c %fsr '|' %c %> type
+-123.e   15 <% %CR '|' %c %fsl '|' %c %> type
+-123.e   15 <% %CR '|' %c %fsr '|' %c %> type
+-123.e    0 <% %CR '|' %c %fsl '|' %c %> type
+-123.e    0 <% %CR '|' %c %fsr '|' %c %> type
+-123.e  -15 <% %CR '|' %c %fsl '|' %c %> type
+-123.e  -15 <% %CR '|' %c %fsr '|' %c %> type
+
+CR
+
+12345.e       <% %CR '|' %c %fe  '|' %c %> type
+12345.e    25 <% %CR '|' %c %fel '|' %c %> type
+12345.e    25 <% %CR '|' %c %fel '|' %c %> type
+-12345.e   25 <% %CR '|' %c %fer '|' %c %> type
+-12345.e   25 <% %CR '|' %c %fer '|' %c %> type
+12345.e    15 <% %CR '|' %c %fel '|' %c %> type
+12345.e    15 <% %CR '|' %c %fer '|' %c %> type
+-12345.e   15 <% %CR '|' %c %fel '|' %c %> type
+-12345.e   15 <% %CR '|' %c %fer '|' %c %> type
+-12345.e    0 <% %CR '|' %c %fel '|' %c %> type
+-12345.e    0 <% %CR '|' %c %fer '|' %c %> type
+-12345.e  -15 <% %CR '|' %c %fel '|' %c %> type
+-12345.e  -15 <% %CR '|' %c %fer '|' %c %> type
+
+CR
diff --git a/lib/~ik/sformat.4th b/lib/~ik/sformat.4th
@@ -144,6 +144,12 @@ INT/COMP: %S" (S chars" -- )
 ;
 
 
+: %CR (S -- )
+   \G Append characters to the current formatted string so that the characters which follow will appeara t the beginning of the next line of output.
+   13 %C 10 %C
+;
+
+
 : (%UD) (S ud -- c-addr u )
    \G Format unsigned double ud and return string address and length.
    <# #S #>