Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl Monk, Perl Meditation
 
PerlMonks  

Reinventing Dice...

by osfameron (Hermit)
on Dec 08, 2001 at 03:40 UTC ( #130356=sourcecode: print w/ replies, xml ) Need Help??

Category: Fun Stuff
Author/Contact Info hakim@earthling.net
Description: OK I discovered Dice::Dice and RPG::Dice here on Perlmonks but this wheel was such fun to reinvent... this code is more like RPG::Dice, but written in a different way, so I thought it might be worth posting.

update: I quited liked the way I was handling tt clauses, but it was unnecessary. Combined parsing of template into one regex substitution and put the logic into the _roll sub.

package Dice::Simple;

=head1 NAME

Dice::Simple - a simple module to throw dice

=head1 SYNOPSIS

    use Dice::Simple qw(roll);

    my $total=roll '3d6';            # simple die roll
    print "You threw $total\n";

    my @roll=roll '(2d4+d6)/2+20';   # more complicated dice expressio
+n
    my ($total, $template, @dice)=@roll;

=head1 DESCRIPTION

There are a number of Dice throwing modules (L<Dice::Dice>, L<RPG::Dic
+e>).
Dice::Dice has an OO interface and allows some interesting possibiliti
+es but
I didn't feel I needed its complexity.  This module, Dice::Simple does
+n't 
really do anything that RPG::Dice does apart from more flexible dice t
+emplates.

However, if you are going to use the function a lot C<roll> is a lot q
+uicker to
type than C<computeDice> ;->

This was a surprisingly fun wheel to reinvent.

=cut

use strict; use warnings;

BEGIN {
    use Exporter;
    our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
    $VERSION     = 0.02;
    @ISA         = qw(Exporter);
    @EXPORT      = qw();
    %EXPORT_TAGS = ();   
    @EXPORT_OK   = qw(roll);
}

=head1 FUNCTIONS

No functions are exported by default.  The only function that can be i
+mported is
C<roll>.  To do this insert C<use Dice::Simple qw(roll)> at the beginn
+ing of 
your script.

If you don't want to import the function you can still call it using 
C<Dice::Simple::roll()>.

=over 4

=item C<roll>

Roll takes a dice template corresponding to the standard Role Playing 
+Game
dice conventions

    d4       4-sided dice
    d6       6-sided dice
    d100   100-sided dice

Each dice may be optionally prefaced by a number indicating how many t
+imes
to roll the dice.

    3d6      Roll 3 six-sided dice, (total between 3 and 18)

And may have a simple arithmetic modifier

    2d4+2    Roll 2 four-sided dice, and add 2 to the total

Other arithmetic can be performed using the symbols 

    + - * / ( )
    for example: (3d6+2d4)/2 

And we can optionally choose only the best dice using the notation C<t
+t>

    tt3 6d6  Roll 6 six-sided dice and keep the best 3

I<NB:> we are not bound by those troublesome laws of reality we can cr
+eate C<d5>, C<d7> etc.

If called in a scalar context, C<roll> returns the total of the expres
+sion requested.

    my $total=roll '2d4+4';

If called in a list context, C<roll> returns 

=over 4

=item 1

the sum

=item 2

the template (e.g. the first value passed to C<roll>)

=item 3

the results of each die, in order they were thrown (e.g. as specified 
+by the template).

=back

For example, C<2d4 + d6 + 3> might return

    (13, "2d4 + d6 + 3", 3, 2, 5)

    Total:     13
    Template:  "2d4 + d6 + 3"
    Dice:      3, 2, 5

Note that the dice rolls do not retain any memory of which dice rolled
+ them.

=for undocumented
I<NB:> C<roll> may optionally be passed a list of dice rolls which wil
+l be used
B<in stead> of a randomly rolled integer.  No error checking is curren
+tly
done to check that the value passed could have rolled by the dice spec
+ified.  
This is not necessarily useful just yet..., however it means that the 
+result of 
a C<roll> call in list context can be passed back to C<roll> just by s
+hifting 
off the result.

=back

=cut

use vars qw(@DICE);

sub roll {
    my $template=shift || $_;
    @DICE=@_;
    my @scores;
    (my $dice=$template)=~
      s{(?:tt(\d+)\s+)?(\d+)?d(\d+)} # e.g. tt{n}? d4, 3d6, 2d8
       {my($tot,@sc)                 # get total & dice for that role
        =_roll($2||1,$3,$1);
        push@scores,@sc;             # add to overall dice.
        $tot                         # replace #d# expression with tot
+al 
       }egx;                         # eg modifiers: apply this functi
+on to 
                                     #   each occurrence of the #d# pa
+ttern
    if ($dice=~/^[0-9+*()\/ -]*$/) { # eval should be safe because onl
+y 
        my $eval=eval($dice);    #   accept specified characters   

        return wantarray ?  ($eval, $template, @scores) : $eval
    } 
    undef;                           # return undef on failure
}

sub _roll {
    my ($count, $die, $topn)=@_;
    my $total=0;
    my @scores=map {shift @DICE || int(rand $die)+1} 1..$count;
    if ($topn) { # restrict to best dice only
        @scores=(sort {$b<=>$a} @scores)[0..$topn-1]
                 # In v0.01 I made sure that the dice were returned
                 # in the order thrown.  Don't think this is needed
                 # so just returning sorted values.
    }
    $total+=$_ for @scores;
    return $total, @scores;
}

=head1 AUTHOR, BUGS, LICENSE

 Version: 0.02  7th Dec 2001
 Untested.  No warranty implied.
 May be distributed under the same terms as Perl itself.

 (c) hakim@earthling.net
 http://www.perlmonks.org     /msg osfameron

=cut

int(rand 6)+1;

Comment on Reinventing Dice...
Download Code
Submit to CPAN? Re: Reinventing Dice...
by osfameron (Hermit) on Dec 08, 2001 at 15:54 UTC
    Maybe this should be a meditation? I've checked on CPAN and discovered that maybe I didn't need to be worried about reinventing the wheel, as no Dice (or Die) modules have been submitted there.

    Is it worth submitting this there? I'm not too clear on the how-to etc., but I can always RTFM on http://www.cpan.org, though other pointers gratefully received.

    But the bigger question is should I? I'm not too worried about replicating functionality in Dice::Dice because it is so different a problem area it's looking at, but would it be common practise to check with the author of RPG::Dice (Syrkres) before submitting?

    Update: Thanks Ovid, I've now read the FAQ and requested a PAUSE id! I think that when it comes to actually preparing a distribution a question or 2 to Perlmonks might be in order..

    Cheerio!
    Osfameron

      If you wish to submit modules to the CPAN, read through their module submission FAQ. The process is fairly simple: request a PAUSE ID. Once you're received that, you can upload your module and you'll also need to apply for your name space. In uploading a module, please use H2XS to create it. Make sure that you write tests for the module and create a proper bundle. "make dist" will do that for you. If you follow all of those steps, you will have a professional distribution that Perl programmers will appreciate.

      Cheers,
      Ovid

      Join the Perlmonks Setiathome Group or just click on the the link and check out our stats.

Dice::Simpler with Filter::Simple (Re: Reinventing Dice...)
by osfameron (Hermit) on Dec 08, 2001 at 23:58 UTC
    Was thinking about how to improve this, and wondered if it was possible to make 'd' a binary operator, e.g. just write 3d6 in your Perl code and have the d operator get passed 3 and 6 as parameters, but having checked out overload and TheDamian's OO book I think it can't be done.

    I then wrote a version that overloaded strings, so you could type $x='3d6' but really I think that's not that much more intuitive. So...

    As I've played recently with TheDamian's Filter::Simple I wrote a helper module that allows you to write $x=3d6 in your script. As always comments welcome...
    package Dice::Simpler; use strict; use warnings; use Filter::Simple; use Dice::Simple qw(roll); our @ISA=qw(Exporter); our @EXPORT=qw(roll); FILTER_ONLY code => sub { s{((?:\btt\d+\s+)?(?:\d+|\b)d\d+)} # note use of \b. We don't want to filter other expressions # that ending in 'd' and a number {roll('$1')}g; } __DATA__ =head1 NAME Dice::Simpler - an even simpler interface to RPG style dice. =head1 SYNOPSIS use Dice::Simpler; my $str= tt3 6d6; # best 3 of 6 6-sided dice my $dex= 3d8; # 3 8-sided dice my $cha= 4d4+1; # 4 4-sided dice + 1 print <<CHARACTER; Your new character has: Strength: $str Dexterity: $dex Charisma: $cha =============== CHARACTER print "You attack the Orc:\n"; if (3d6 < $str) { print "You killed the Orc"; } else { print "You hit the Orc but it glanced off his armour"; } =head1 DESCRIPTION Uses L<Dice::Simple> and the very funky L<Filter::Simple> to allow you + to use the RPG style '3d6' syntax for dice rolling directly in Perl. See the + Dice::Simple documentation for more details. =head1 AUTHOR, LICENSE Version: 0.01 8th Dec 2001 Untested. No warranty implied. May be distributed under the same terms as Perl itself. (c) hakim@earthling.net http://www.perlmonks.org /msg osfameron =head1 BUGS =over 4 =item 1 (OPEN 2001/12/8) '3d6' notation isn't filtered in quotelikes like double quoted strings. But it *does* seem to be in <<heredocs. Not s +ure why. B<Update:> but Damian Conway himself is aware of it, and it +is on his looooong todo list, thanks! =back =cut int(rand 6)+1;
    Cheerio!
    Osfameron
      '3d6' notation isn't filtered in quotelikes like double quoted strings. But it *does* seem to be in heredocs. Not sure why.

      Looks like a deep and mysterious bug in Text::Balanced's parsing of heredocs. I'm working on it but, due to the current number of ToDo's vastly exceeding the available supply of Damians, the fix may be some time coming.

Back to Code Catacombs

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://130356]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others chilling in the Monastery: (3)
As of 2014-07-13 01:41 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    When choosing user names for websites, I prefer to use:








    Results (244 votes), past polls