extra/dice/dice.factor

   1 ! Copyright (C) 2010 John Benediktsson
   2 ! See http://factorcode.org/license.txt for BSD license
   3 USING: kernel lexer math math.parser namespaces
   4 random random.private sequences splitting ;
   5 IN: dice
   6
   7 : (random-roll) ( #dice #sides obj -- n )
   8     [ 0 ] 3dip '[ _ _ (random-integer) + 1 + ] times ;
   9
  10 : random-roll ( #dice #sides -- n )
  11     random-generator get (random-roll) ;
  12
  13 : random-rolls ( length #dice #sides -- seq )
  14     random-generator get '[ _ _ _ (random-roll) ] replicate ;
  15
  16 : parse-roll ( string -- #dice #sides #added )
  17     "d" split1 "+" split1 [ string>number ] tri@ ;
  18
  19 : roll ( string -- n )
  20     parse-roll [ random-roll ] dip [ + ] when* ;
  21
  22 : roll-quot ( string -- quot: ( -- n ) )
  23     parse-roll [
  24         '[ _ _ random-roll _ + ]
  25     ] [
  26         '[ _ _ random-roll ]
  27     ] if* ;
  28
  29 SYNTAX: ROLL: scan-token roll-quot append! ;