fork download
copy 
  1. \ generic words.
  2.  
  3. : <range> ( nnn-) swap within abort" range" ;
  4. : only ( n-n1|0) ?dup 0<> ;
  5. : except ( n-n0|1) ?dup 0= ;
  6. : c@+ ( a-ca) dup c@ swap 1+ ;
  7.  
  8. \ fixed string arrays with offset indexing.
  9. \ c1 item width, c2 starting index.
  10.  
  11. 0 Value ds-width
  12. : Digits ( cc-) create c, dup to ds-width 1+ c,
  13.   does> ( u-) c@+ >r - r> c@+ >r * r> + count type ;
  14. : ds" ( "-) '"' parse ds-width min dup c,
  15.   here swap ds-width allot move ;
  16.  
  17. cr .( decimal number names: )
  18.  
  19. 5 1 Digits th-unit
  20.   ds" one"   ds" two"   ds" three"
  21.   ds" four"  ds" five"  ds" six"
  22.   ds" seven" ds" eight" ds" nine"
  23.  
  24. 9 10 Digits th-teen
  25.   ds" ten"       ds" eleven"    ds" twelve"
  26.   ds" thirteen"  ds" fourteen"  ds" fifteen"
  27.   ds" sixteen"   ds" seventeen" ds" eighteen"
  28.   ds" nineteen"
  29.  
  30. 7 2 Digits th-ten
  31.   ds" twenty" ds" thirty"  ds" forty"
  32.   ds" fifty"  ds" sixty"   ds" seventy"
  33.   ds" eighty" ds" ninety"
  34.  
  35. \ example: types "forty".
  36. cr 4 th-ten
  37.  
  38. : zero ." zero " ;
  39. : hundred ." hundred " ;
  40. : thousand ." thousand " ;
  41. : dash ( u-u) dup IF '-' emit ELSE space THEN ;
  42. : triple ( u-) except IF exit THEN
  43.   100 /mod only IF th-unit space hundred THEN
  44.   dup 10 20 within IF th-teen space exit THEN
  45.   10 /mod only IF th-ten dash THEN
  46.   only IF th-unit space THEN ;
  47. : say-deci ( u-) dup 0 1000000 <range>
  48.   except IF zero exit THEN
  49.   1000 /mod only IF triple thousand THEN
  50.   triple ;
  51.  
  52. cr 12 say-deci
  53. cr 69 say-deci
  54. cr 420 say-deci
  55. cr 105 say-deci
  56. cr 100010 say-deci
  57. cr
  58. cr .( seximal number names: )
  59.  
  60. #6 base !
  61.  
  62. 10 1 Digits th-unit
  63.   ds" one"   ds" two"    ds" three"
  64.   ds" four"  ds" five"   ds" six"
  65.   ds" seven" ds" eight"  ds" nine"
  66.   ds" ten"   ds" eleven" ds" twelve"
  67.  
  68. 10 2 Digits th-six
  69.   ds" dozen" ds" thirsy"
  70.   ds" forsy" ds" fifsy"
  71.  
  72. : nif ." nif " ;
  73. : unexian ." unexian " ;
  74. : pair ( u-) except IF exit THEN
  75.   dup 21 < IF th-unit space exit THEN
  76.   10 /mod only IF th-six dash THEN  
  77.   only IF th-unit THEN ;
  78. : nifs ( u-) except IF exit THEN
  79.   dup 1 = IF drop ELSE pair THEN nif ;
  80. : quad ( u-) except IF exit THEN  
  81.   100 /mod nifs pair ;
  82. : say-sexi ( u-) dup 0 1000000 <range>
  83.   except IF zero exit THEN
  84.   10000 /mod only IF quad unexian THEN quad ;
  85.  
  86. cr 12 say-sexi
  87. cr 153 say-sexi \ equals sixty-nine.
  88. cr 420 say-sexi
  89. cr 105 say-sexi
  90. cr 1540 say-sexi \ equals four hundred twenty.
  91. cr 101425 say-sexi
  92. cr
Success #stdin #stdout #stderr 0.01s 5284KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
decimal number names: 
forty
twelve 
sixty-nine 
four hundred twenty 
one hundred five 
one hundred thousand ten 

seximal number names: 
eight 
nif fifsy-three
four nif twelve 
nif five 
eleven nif forsy 
six unexian ten nif dozen-five
stderr
copy 
redefined Only with only  redefined c@+  redefined th-unit
https://ideone.com/ZgpWRD
language:
Forth (gforth 0.7.3)
created:
4 days ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!