about summary refs log tree commit diff
path: root/output.e
diff options
context:
space:
mode:
Diffstat (limited to 'output.e')
-rw-r--r--output.e64
1 files changed, 62 insertions, 2 deletions
diff --git a/output.e b/output.e
index b5414d4..45a29b7 100644
--- a/output.e
+++ b/output.e
@@ -103,8 +103,6 @@
 ~ recursion, and lets us stick entirely with the trivial control-flow
 ~ constructs we already have.
 ~
-~ TODO add a variant that writes to a string
-~
 ~ (integer to print, base to print in, width to zero-pad to --)
 : .base-unsigned
   ~ (input, base, width)
@@ -190,3 +188,65 @@
 ~ (integer to print, width --)
 : .hexn 16 swap .base-unsigned ;
 
+
+
+~   The control structure here is the same as .base-unsigned, but it outputs
+~ to a string.
+~
+~   The use of the "pack" nomenclature here is a little odd in that most other
+~ uses are for binary structures rather than text, but compare packstring.
+~
+~ (output point, integer to print, base to print in, width to zero-pad to
+~  -- output point)
+: pack-base-unsigned
+  3unroll swap 2dup logfloor 1 +
+  4 roll 2dup > {
+    swap drop
+  } {
+    drop
+  } if-else
+
+  {
+    ~ (output point, base, input, number of digits remaining)
+    2dup 1 -
+    5 roll dup 6 unroll swap
+    pow /% swap drop
+    4 roll dup 5 unroll
+    /% drop
+
+    dup 10 > {
+      0x30                                         ~ ASCII "0"
+    } {
+      10 - 0x61                                    ~ ASCII "a"
+    } if-else
+    +
+    ~ (output point, base, input, number of digits remaining, character)
+    5 roll swap pack8 4 unroll
+
+    1 -
+    dup { drop drop drop exit } unless
+  } forever ;
+
+
+~ (output point, integer to print, base to print in -- output point)
+: pack-base
+  swap
+
+  dup 0 > {
+    -1 *
+    3roll s" -" packstring 3unroll
+  } if
+
+  swap 0 .base-unsigned ;
+
+
+~ (output point, integer to print -- output point)
+: pack-decimal 10 pack-base ;
+: pack-hex 16 0 pack-base-unsigned ;
+: pack-hex8 16 2 pack-base-unsigned ;
+: pack-hex16 16 4 pack-base-unsigned ;
+: pack-hex32 16 8 pack-base-unsigned ;
+: pack-hex64 16 16 pack-base-unsigned ;
+
+~ (output point, integer to print, width -- output point)
+: pack-hexn 16 swap pack-base-unsigned ;