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
  10   caveats:
  11     doesn't handle floats
  12     doesn't check for overflow
  13     doesn't do fancy shortening, like someteen-hundred
  14 )
  15
  16 $lib-version 1.000
  17 $version 1.000
  18 $author <justin.wind@gmail.com>
  19
  20 $ifdef DEBUGGING
  21 ( trim some debug fluff )
  22 $def D_SAVE prog "D" flag? D_STATE !
  23 $def D_UNSET prog "!D" set
  24 $def D_RESTORE D_STATE @ if prog "D" set then
  25 lvar D_STATE
  26 $else
  27 $def D_SAVE
  28 $def D_UNSET
  29 $def D_RESTORE
  30 $endif
  31
  32 : zero_ ( -- s )
  33   "zero"
  34 ;
  35 ( the numbers, up until things become predictable )
  36 : low_numbers_ ( @ -- s )
  37   D_UNSET
  38   { "" "one" "two" "three" "four" "five" "six" "seven" "eight" "nine" "ten"
  39     "eleven" "twelve" "thirteen" "fourteen" "fifteen" "sixteen" "seventeen"
  40     "eighteen" "nineteen"
  41   } array_make
  42   swap array_getitem
  43   D_RESTORE
  44 ;
  45 ( gangs of ten )
  46 : decades_ ( @ -- s )
  47   D_UNSET
  48   { "" "" "twenty" "thirty" "forty" "fifty" "sixty" "seventy" "eighty" "ninety"
  49   } array_make
  50   swap array_getitem
  51   D_RESTORE
  52 ;
  53 ( just to keep things stylistically similar )
  54 : hundred_ ( -- s )
  55   "hundred"
  56 ;
  57 ( words for big numbers, according to wikipedia )
  58 : big_numbers_ ( @ -- s )
  59   D_UNSET
  60   { "" "thousand" "million" "billion" "trillion" "quadrillion"
  61     "quintillion" "sextillion" "septillion" "octillion" "nonillion"
  62     "decillion" "undecillion" "duodecillion" "tredecillion"
  63     "quattuordecillion" "quindecillion" "sexdecillion" "septendecillion"
  64     "octodecillion" "novemdecillion" "vigintillion" "silmarillion"
  65   } array_make
  66   swap array_getitem
  67   D_RESTORE
  68 ;
  69
  70 ( outputs the words for a number under one-thousand )
  71 : english_sub_thousand_ ( i -- s )
  72   "" var! OUT
  73   dup 1000 % 100 / var! HUNDREDS
  74   dup 100 % 10 / var! TENS
  75   dup 10 % var! ONES
  76
  77   ( show hundreds if they exist )
  78   HUNDREDS @ if
  79     OUT @
  80     HUNDREDS @ low_numbers_ strcat
  81     " " strcat
  82     hundred_ strcat
  83     ( if there's more number to show, need a word break )
  84     TENS @ ONES @ or if
  85       " " strcat
  86     then
  87     OUT !
  88   then
  89
  90   ( show remaining teens or under )
  91   TENS @ 2 < if
  92     OUT @
  93     over 20 % low_numbers_ strcat
  94     OUT !
  95   else
  96     ( otherwise show remaining tens-ones pattern )
  97       OUT @
  98       TENS @ decades_ strcat
  99       ONES @ if
 100         "-" strcat
 101         ONES @ low_numbers_ strcat
 102       then
 103       OUT !
 104   then
 105
 106   pop
 107   OUT @
 108 ;
 109
 110 : english-number ( i -- s )
 111   "i" checkargs
 112
 113   D_SAVE
 114
 115   "" var! OUT
 116   dup sign 0 < var! ISNEG
 117   abs
 118
 119   dup 0 = if
 120     pop
 121     zero_
 122     exit
 123   then
 124
 125   0 var! BIGNESS
 126   begin ( i )
 127     dup 1000 % english_sub_thousand_ ( i s )
 128     BIGNESS @ dup 1 >= if ( i s i )
 129       big_numbers_ " " swap strcat ( i s s )
 130       strcat ( i s )
 131     else
 132       pop
 133     then ( i s )
 134     OUT @ ( i s s )
 135     dup strlen if ( i s s )
 136       " " swap strcat
 137     then ( i s )
 138     strcat OUT ! ( i )
 139
 140     BIGNESS ++ ( i )
 141     1000 / dup 0 = ( i i )
 142   until
 143   pop
 144   OUT @
 145   ISNEG @ if
 146     "negative " swap strcat
 147   then
 148 ;
 149 public english-number
 150
 151 : mpi
 152   atoi english-number
 153 ;
 154 .
 155 c
 156 q
 157 @reg english-numbers.muf=lib/squeep/english-numbers
 158 @set $lib/squeep/english-numbers=_docs:@list english-numbers.muf=1-10
 159 @set $lib/squeep/english-numbers=L
 160 @set $lib/squeep/english-numbers=V
 161
 162 @set #0=_msgmacs/english-number:{muf:$lib/squeep/english-numbers,{:1}}