Merge branch 'release-1.0'

[muf-repository] / english-numbers.muf

diff --git a/english-numbers.muf b/english-numbers.muf
new file mode 100644 (file)
index 0000000..dc2c748
--- /dev/null
+++ b/english-numbers.muf
@@ -0,0 +1,162 @@
+@q
+@program english-numbers.muf
+1 9999 d
+i
+$note A simple routine to render a numeric value as english words.
+$libdef english-number
+( english-numbers.muf
+  Dec 11 2012 - v1.000
+
+  caveats:
+    doesn't handle floats
+    doesn't check for overflow
+    doesn't do fancy shortening, like someteen-hundred
+)
+
+$lib-version 1.000
+$version 1.000
+$author <justin.wind@gmail.com>
+
+$ifdef DEBUGGING
+( trim some debug fluff )
+$def D_SAVE prog "D" flag? D_STATE !
+$def D_UNSET prog "!D" set
+$def D_RESTORE D_STATE @ if prog "D" set then
+lvar D_STATE
+$else
+$def D_SAVE
+$def D_UNSET
+$def D_RESTORE
+$endif
+
+: zero_ ( -- s )
+  "zero"
+;
+( the numbers, up until things become predictable )
+: low_numbers_ ( @ -- s )
+  D_UNSET
+  { "" "one" "two" "three" "four" "five" "six" "seven" "eight" "nine" "ten"
+    "eleven" "twelve" "thirteen" "fourteen" "fifteen" "sixteen" "seventeen"
+    "eighteen" "nineteen"
+  } array_make
+  swap array_getitem
+  D_RESTORE
+;
+( gangs of ten )
+: decades_ ( @ -- s )
+  D_UNSET
+  { "" "" "twenty" "thirty" "forty" "fifty" "sixty" "seventy" "eighty" "ninety"
+  } array_make
+  swap array_getitem
+  D_RESTORE
+;
+( just to keep things stylistically similar )
+: hundred_ ( -- s )
+  "hundred"
+;
+( words for big numbers, according to wikipedia )
+: big_numbers_ ( @ -- s )
+  D_UNSET
+  { "" "thousand" "million" "billion" "trillion" "quadrillion"
+    "quintillion" "sextillion" "septillion" "octillion" "nonillion"
+    "decillion" "undecillion" "duodecillion" "tredecillion"
+    "quattuordecillion" "quindecillion" "sexdecillion" "septendecillion"
+    "octodecillion" "novemdecillion" "vigintillion" "silmarillion"
+  } array_make
+  swap array_getitem
+  D_RESTORE
+;
+
+( outputs the words for a number under one-thousand )
+: english_sub_thousand_ ( i -- s )
+  "" var! OUT
+  dup 1000 % 100 / var! HUNDREDS
+  dup 100 % 10 / var! TENS
+  dup 10 % var! ONES
+
+  ( show hundreds if they exist )
+  HUNDREDS @ if
+    OUT @
+    HUNDREDS @ low_numbers_ strcat
+    " " strcat
+    hundred_ strcat
+    ( if there's more number to show, need a word break )
+    TENS @ ONES @ or if
+      " " strcat
+    then
+    OUT !
+  then
+
+  ( show remaining teens or under )
+  TENS @ 2 < if
+    OUT @
+    over 20 % low_numbers_ strcat
+    OUT !
+  else
+    ( otherwise show remaining tens-ones pattern )
+      OUT @
+      TENS @ decades_ strcat
+      ONES @ if
+        "-" strcat
+        ONES @ low_numbers_ strcat
+      then
+      OUT !
+  then
+
+  pop
+  OUT @
+;
+
+: english-number ( i -- s )
+  "i" checkargs
+
+  D_SAVE
+
+  "" var! OUT
+  dup sign 0 < var! ISNEG
+  abs
+
+  dup 0 = if
+    pop
+    zero_
+    exit
+  then
+
+  0 var! BIGNESS
+  begin ( i )
+    dup 1000 % english_sub_thousand_ ( i s )
+    BIGNESS @ dup 1 >= if ( i s i )
+      big_numbers_ " " swap strcat ( i s s )
+      strcat ( i s )
+    else
+      pop
+    then ( i s )
+    OUT @ ( i s s )
+    dup strlen if ( i s s )
+      " " swap strcat
+    then ( i s )
+    strcat OUT ! ( i )
+
+    BIGNESS ++ ( i )
+    1000 / dup 0 = ( i i )
+  until
+  pop
+  OUT @
+  ISNEG @ if
+    "negative " swap strcat
+  then
+;
+public english-number
+
+: mpi
+  atoi english-number
+;
+.
+c
+q
+@reg english-numbers.muf=lib/squeep/english-numbers
+@set $lib/squeep/english-numbers=_docs:@list english-numbers.muf=1-10
+@set $lib/squeep/english-numbers=L
+@set $lib/squeep/english-numbers=V
+
+@set #0=_msgmacs/english-number:{muf:$lib/squeep/english-numbers,{:1}}