git.squeep.com Git - muf-repository/blob - english-numbers.muf

   1 @q
   2 @program english-numbers.muf
   3 1 9999 d
   4 i
   5 $note A simple routine to render a numeric value as english words.
   6 $libdef english-number
   7 ( english-numbers.muf
   8   Dec 11 2012 - v1.000
   9   Feb  2 2012 - v1.001
  10
  11   caveats:
  12     doesn't handle floats
  13     integer variant doesn't check for integer overflow
  14     doesn't do fancy shortening, like someteen-hundred
  15 )
  16
  17 $lib-version 1.000
  18 $version 1.001
  19 $author <justin.wind@gmail.com>
  20
  21 $undef DEBUGGING
  22 $ifdef DEBUGGING
  23 ( trim some debug fluff )
  24 $def D_SAVE prog "D" flag? D_STATE !
  25 $def D_UNSET prog "!D" set
  26 $def D_RESTORE D_STATE @ if prog "D" set then
  27 lvar D_STATE
  28 $else
  29 $def D_SAVE
  30 $def D_UNSET
  31 $def D_RESTORE
  32 $endif
  33
  34 : zero_ ( -- s )
  35   "zero"
  36 ;
  37 ( the numbers, up until things become predictable )
  38 : low_numbers_ ( @ -- s )
  39   D_UNSET
  40   { "" "one" "two" "three" "four" "five" "six" "seven" "eight" "nine" "ten"
  41     "eleven" "twelve" "thirteen" "fourteen" "fifteen" "sixteen" "seventeen"
  42     "eighteen" "nineteen"
  43   } array_make
  44   swap array_getitem
  45   D_RESTORE
  46 ;
  47 ( gangs of ten )
  48 : decades_ ( @ -- s )
  49   D_UNSET
  50   { "" "" "twenty" "thirty" "forty" "fifty" "sixty" "seventy" "eighty" "ninety"
  51   } array_make
  52   swap array_getitem
  53   D_RESTORE
  54 ;
  55 ( just to keep things stylistically similar )
  56 : hundred_ ( -- s )
  57   "hundred"
  58 ;
  59 ( words for big numbers, according to wikipedia )
  60 : big_numbers_ ( @ -- s )
  61   D_UNSET
  62   { "" "thousand" "million" "billion" "trillion" "quadrillion"
  63     "quintillion" "sextillion" "septillion" "octillion" "nonillion"
  64     "decillion" "undecillion" "duodecillion" "tredecillion"
  65     "quattuordecillion" "quindecillion" "sexdecillion" "septendecillion"
  66     "octodecillion" "novemdecillion" "vigintillion" "silmarillion"
  67   } array_make
  68   swap array_getitem
  69   dup 0 = if pop "???-illion" then
  70   D_RESTORE
  71 ;
  72
  73 ( outputs the words for a number under one-thousand )
  74 : english_sub_thousand_ ( i -- s )
  75   "" var! OUT
  76   dup 1000 % 100 / var! HUNDREDS
  77   dup 100 % 10 / var! TENS
  78   dup 10 % var! ONES
  79
  80   ( show hundreds if they exist )
  81   HUNDREDS @ if
  82     OUT @
  83     HUNDREDS @ low_numbers_ strcat
  84     " " strcat
  85     hundred_ strcat
  86     ( if there's more number to show, need a word break )
  87     TENS @ ONES @ or if
  88       " " strcat
  89     then
  90     OUT !
  91   then
  92
  93   ( show remaining teens or under )
  94   TENS @ 2 < if
  95     OUT @
  96     over 20 % low_numbers_ strcat
  97     OUT !
  98   else
  99     ( otherwise show remaining tens-ones pattern )
 100       OUT @
 101       TENS @ decades_ strcat
 102       ONES @ if
 103         "-" strcat
 104         ONES @ low_numbers_ strcat
 105       then
 106       OUT !
 107   then
 108
 109   pop
 110   OUT @
 111 ;
 112
 113 : english-number ( i -- s )
 114   "i" checkargs
 115
 116   D_SAVE
 117
 118   "" var! OUT
 119   dup sign 0 < var! ISNEG
 120   abs
 121
 122   dup 0 = if
 123     pop
 124     zero_
 125     exit
 126   then
 127
 128   0 var! BIGNESS
 129   begin ( i )
 130     dup 1000 % english_sub_thousand_ ( i s )
 131     BIGNESS @ dup 1 >= if ( i s i )
 132       big_numbers_ " " swap strcat ( i s s )
 133       strcat ( i s )
 134     else
 135       pop
 136     then ( i s )
 137     OUT @ ( i s s )
 138     dup strlen if ( i s s )
 139       " " swap strcat
 140     then ( i s )
 141     strcat OUT ! ( i )
 142
 143     BIGNESS ++ ( i )
 144     1000 / dup 0 = ( i i )
 145   until
 146   pop
 147   OUT @
 148   ISNEG @ if
 149     "negative " swap strcat
 150   then
 151 ;
 152 public english-number
 153
 154 : strcut-end ( s i -- s s )
 155   over strlen swap -
 156   dup 0 <= if
 157     ( requested more than string has )
 158     pop "" swap
 159   else
 160     strcut
 161   then
 162 ;
 163
 164 ( deal with number as string )
 165 ( assumes base10 )
 166 : mpi-english-number ( s -- s )
 167   ( atoi english-number exit )
 168   0 var! ISNEG
 169   "" var! OUT
 170   0 var! BIGNESS
 171   begin ( s )
 172     dup strlen while ( s )
 173     3 strcut-end ( s s )
 174     atoi ( s i )
 175     dup sign 0 < if
 176       1 ISNEG !
 177       abs
 178     then ( s i )
 179     english_sub_thousand_ ( s s )
 180     BIGNESS @ dup 1 >= if ( s s i )
 181       big_numbers_ ( s s s )
 182       " " swap strcat ( s s s )
 183       strcat ( s s )
 184     else
 185       pop ( s s )
 186     then
 187     OUT @ ( s s s )
 188     dup strlen if ( s s s )
 189       " " swap strcat
 190     then ( s s s )
 191     strcat ( s s )
 192     OUT ! ( s )
 193
 194     BIGNESS ++ ( s )
 195   repeat ( s )
 196   pop
 197   OUT @
 198   dup strlen not if
 199     pop zero_
 200   then
 201   ISNEG @ if
 202     "negative " swap strcat
 203   then
 204 ;
 205 .
 206 c
 207 q
 208 @reg english-numbers.muf=lib/squeep/english-numbers
 209 @set $lib/squeep/english-numbers=_docs:@list english-numbers.muf=1-10
 210 @set $lib/squeep/english-numbers=L
 211 @set $lib/squeep/english-numbers=V
 212
 213 @set #0=_msgmacs/english-number:{muf:$lib/squeep/english-numbers,{:1}}