Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl: the Markov chain saw
 
PerlMonks  

Re^3: D20 dice throw parser

by thor (Priest)
on Dec 17, 2004 at 15:47 UTC ( #415669=note: print w/replies, xml ) Need Help??


in reply to Re^2: D20 dice throw parser
in thread D20 dice throw parser

What about this:
use Game::Die::Dice; my $input = "1D4x10"; my ($pass_to_module, $mult) = split('x', $input); $mult = defined($mult) ? $mult : 1; my $dice = new Games::Die::Dice($pass_to_module); my $treasure -= $mult * $dice->roll();

Alternatively, submit a patch to the maintainers of that module so that it accepts multipliers. Something to consider though: what about rolls like "1d4x10+10"? Your current approach probably doesn't handle this...

thor

Feel the white light, the light within
Be your own disciple, fan the sparks of will
For all of us waiting, your kingdom will come

Replies are listed 'Best First'.
Re^4: D20 dice throw parser
by jryan (Vicar) on Dec 17, 2004 at 19:27 UTC

    I took a look on the CPAN at Games::Dice::Die, and then at Games::Dice. It seemed like Games::Dice had many more features. So, I took a look at the code, and realized it was easy to add the support that you wanted. I only needed to slightly change the regex and 2 lines of code!

    --- Games/Dice.pm.old 2004-12-17 14:17:54.172707400 -0500 +++ Games/Dice.pm.new 2004-12-17 15:56:22.599186000 -0500 @@ -19,7 +19,7 @@ sub roll ($) { - my($line, $dice_string, $sign, $offset, $sum, @throws, @result); + my($line, $dice_string, @throws); $line = shift; @@ -34,38 +34,29 @@ % # a percent sign for d% = d100 ) ) - (?: # grouping-only parens - ([-+xX*/bB]) # a + - * / b(est) in $2 - (\d+) # an offset in $3 - )? # both of those last are optional + ((?: # capture + [-+xX*/bB] # a modifier + \d+ # a, number + )*) # capture }x; # whitespace allowed - $dice_string = $1; - $sign = $2 || ''; - $offset = $3 || 0; + @throws = roll_array( $1 ); + return unless @throws; - $sign = lc $sign; - - @throws = roll_array( $dice_string ); - return undef unless @throws; - - if( $sign eq 'b' ) { + my $mod = $2; + if( my($offset) = ($mod =~ /[bB](\d+)/) ) { $offset = 0 if $offset < 0; $offset = @throws if $offset > @throws; @throws = sort { $b <=> $a } @throws; # sort numerically, d +escending - @result = @throws[ 0 .. $offset-1 ]; # pick off the $offse +t first ones - } else { - @result = @throws; + @throws = @throws[ 0 .. $offset-1 ]; # pick off the $offse +t first ones + $mod = ''; } - $sum = 0; - $sum += $_ foreach @result; - $sum += $offset if $sign eq '+'; - $sum -= $offset if $sign eq '-'; - $sum *= $offset if ($sign eq '*' || $sign eq 'x'); - do { $sum /= $offset; $sum = int $sum; } if $sign eq '/'; - + my $sum = 0; + $sum += $_ foreach @throws; + (my $expr = $mod) =~ tr/Xx/**/; + $sum = int eval "$sum $expr" if $expr; return $sum; }

    Update: Looking at this node again, I realized that the patch would break the b syntax, and so I, uh, fixed that. I also trimmed the original author's code a bit.

Re^4: D20 dice throw parser
by jryan (Vicar) on Dec 17, 2004 at 19:03 UTC

    Neither does yours. :)

      You're right, but I didn't intend for it to either. I'm just saying that as long as you're mucking, you may as well muck it correctly. :)

      thor

      Feel the white light, the light within
      Be your own disciple, fan the sparks of will
      For all of us waiting, your kingdom will come

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://415669]
help
Chatterbox?
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others wandering the Monastery: (10)
As of 2018-06-25 14:54 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    Should cpanminus be part of the standard Perl release?



    Results (127 votes). Check out past polls.

    Notices?