From b4c126e01ad64c3df4807d2dbfbc6a3c8b04d64f Mon Sep 17 00:00:00 2001
From: Illya Kysil <ikysil@ikysil.name>
Date: Sun, 24 Sep 2017 23:30:43 +0200
Subject: [PATCH] Refactor helper word for left and right justification -
 %EXECUTE-JL and %EXECUTE-JR - #29

---
 lib/~ik/float-output.4th | 31 +++++--------------------------
 lib/~ik/sformat.4th      | 28 ++++++++++++++++++++++++++++
 2 files changed, 33 insertions(+), 26 deletions(-)

diff --git a/lib/~ik/float-output.4th b/lib/~ik/float-output.4th
index 6854c16..26430fb 100644
--- a/lib/~ik/float-output.4th
+++ b/lib/~ik/float-output.4th
@@ -58,25 +58,14 @@ ONLY FORTH DEFINITIONS ALSO FLOAT-OUTPUT-PRIVATE
 : %FSL (S uw -- ) (F r -- )
    \G Append string representation of floating point number r to the current formatted string.
    \G The string representation is left justified in the field of minimum width uw.
-   %CURR NIP + >R
-   %FS
-   %CURR NIP R> SWAP - 0 MAX %SPACES
+   ['] %FS %EXECUTE-JL
 ;
 
 
 : %FSR (S uw -- ) (F r -- )
    \G Append string representation of floating point number r 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
-   %FS
-   %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
+   ['] %FS %EXECUTE-JR
 ;
 
 
@@ -140,25 +129,14 @@ ONLY FORTH DEFINITIONS ALSO FLOAT-OUTPUT-PRIVATE
 : %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
+   ['] %FE %EXECUTE-JL
 ;
 
 
 : %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 %EXECUTE-JR
 ;
 
 
@@ -188,6 +166,7 @@ REPORT-NEW-NAME !
 
 \EOF
 
+123.e       <% %CR '|' %c %fs  '|' %c %> 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
diff --git a/lib/~ik/sformat.4th b/lib/~ik/sformat.4th
index 3e3bf9e..51a473c 100644
--- a/lib/~ik/sformat.4th
+++ b/lib/~ik/sformat.4th
@@ -132,6 +132,34 @@ INT/COMP: %S" (S chars" -- )
 ;
 
 
+: %EXECUTE-JL (S uw xt -- )
+   \G Execute xt and append string representation produced by the execution of xt to the current formatted string.
+   \G xt is expected to produce the output to the current formatted string.
+   \G The string representation is left justified in the field of minimum width uw.
+   SWAP
+   %CURR NIP + >R
+   EXECUTE
+   %CURR NIP R> SWAP - 0 MAX %SPACES
+;
+
+
+: %EXECUTE-JR (S uw xt -- )
+   \G Execute xt and append string representation produced by the execution of xt to the current formatted string.
+   \G xt is expected to produce the output to the current formatted string.
+   \G The string representation is right justified in the field of minimum width uw.
+   %CURR CHARS + >R          \ S: uw xt              R: c-addr1
+   EXECUTE
+   %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
+;
+
+
 : %SIGN (S n -- )
    \G Append character '-' (minus) to the current formatted string if n is negative.
    0<  IF  [CHAR] - %C  THEN