extra/money/money.factor

   1 ! Copyright (C) 2008 Doug Coleman.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: grouping io kernel lexer math math.functions math.parser
   4 namespaces sequences splitting ;
   5 IN: money
   6
   7 SYMBOL: currency-token
   8 CHAR: $ currency-token set-global
   9
  10 : dollars/cents ( dollars -- dollars cents )
  11     100 * 100 /mod round >integer ;
  12
  13 : format-money ( dollars cents -- string )
  14     [ number>string ] bi@
  15     [ <reversed> 3 group "," join <reversed> ]
  16     [ 2 CHAR: 0 pad-head ] bi* "." glue ;
  17
  18 : money>string ( number -- string )
  19     dollars/cents format-money currency-token get prefix ;
  20
  21 : money. ( number -- ) money>string print ;
  22
  23 ERROR: not-an-integer x ;
  24
  25 : split-decimal ( str -- neg? dollars cents )
  26     "." split1 [ "-" ?head swap ] dip ;
  27
  28 : parse-decimal ( str -- ratio )
  29     split-decimal [ [ "0" ] when-empty ] bi@
  30     [
  31         [ dup string>number [ ] [ not-an-integer ] ?if ] bi@
  32     ] keep length 10^ / + swap [ neg ] when ;
  33
  34 SYNTAX: DECIMAL: scan-token parse-decimal suffix! ;