view release on metacpan or  search on metacpan

lib/Acme/Dice.pm  view on Meta::CPAN

package Acme::Dice;

use 5.008008;
use strict;
use warnings;

use Carp;
use Data::Dumper;

BEGIN {
    use Exporter ();
    use vars qw(@ISA @EXPORT_OK);
    @ISA = qw(Exporter);

    @EXPORT_OK = qw( roll_dice roll_craps );
}

$Acme::Dice::VERSION = '1.01';

my $defaults = {
    dice  => 1,
    sides => 6,
    favor => 0,
    bias  => 20,
};

sub roll_dice {
    my $raw_args = @_ == 1 ? shift : {@_};

    # no need to check params if coming from roll_craps
    my $args =
      delete( $raw_args->{skip_validate} )
      ? $raw_args
      : _validate_params($raw_args);

    my @rolls;
    my $roll_total = 0;
    for ( 1 .. $args->{dice} ) {
        my $roll = ( int( rand( $args->{sides} ) ) + 1 );
        _apply_bias( \$roll, $args ) if $args->{favor} && $args->{bias};
        push( @rolls, $roll );
        $roll_total += $roll;
    }

    return wantarray ? @rolls : $roll_total;
}

sub roll_craps {
    my $raw_args = @_ == 1 ? shift : {@_};

    croak "param present but undefined: bias"
      if exists( $raw_args->{bias} ) && !defined( $raw_args->{bias} );

    my $bias = delete( $raw_args->{bias} ) || 0;

    croak "Illegal value for 'bias': $bias" if $bias < 0 || $bias > 100;
    croak 'RTFM! Unknown params: ' . join( ', ', keys( %{$raw_args} ) )
      if keys( %{$raw_args} );

    # hey, this is Acme, remember? you were TOLD not to look inside!
    return ( wantarray ? ( 3, 4 ) : 7 ) if rand(100) < 5;

    my @rolls;
    push(
        @rolls,
        roll_dice(
            skip_validate => 1,
            dice          => 1,
            sides         => 6,
            favor         => 3,
            bias          => $bias
        )
    );
    push(
        @rolls,
        roll_dice(
            skip_validate => 1,
            dice          => 1,
            sides         => 6,
            favor         => 4,
            bias          => $bias
        )
    );

    return wantarray ? @rolls : $rolls[0] + $rolls[1];
}

sub _validate_params {
    my $raw_args = @_ == 1 ? shift : {@_};

    my $args = {};
    my @errors;

    # put put defaults in place for missing params
    # and detect incoming undefined params
    for ( keys( %{$defaults} ) ) {
        $raw_args->{$_} = $defaults->{$_} if !exists( $raw_args->{$_} );
        push( @errors, "param present but undefined: $_" )
          unless defined $raw_args->{$_};
        $args->{$_} = delete( $raw_args->{$_} );
        push( @errors, "$_ must be a non-negative integer: $args->{$_}" )
          if defined( $args->{$_} ) && $args->{$_} !~ m/^\d+$/;
    }
    push( @errors,
        'RTFM! Unknown params: ' . join( ', ', keys( %{$raw_args} ) ) )
      if keys( %{$raw_args} );

    croak join( "\n", @errors ) if @errors;

    # validate individual params now
    push( @errors, "Illegal value for 'dice': $args->{dice}" )
      if $args->{dice} < 1;
    push( @errors, "Really? Roll $args->{dice} dice?" ) if $args->{dice} > 100;

    push( @errors, "Illegal value for 'sides': $args->{sides}" )
      if $args->{sides} < 1;

    push( @errors, "Illegal value for 'favor': $args->{favor}" )
      if $args->{favor} < 0 || $args->{favor} > $args->{sides};
    push( @errors, "Illegal value for 'bias': $args->{bias}" )
      if $args->{bias} < 0 || $args->{bias} > 100;

    croak join( "\n", @errors ) if @errors;

    return $args;
}

sub _apply_bias {
    my $roll_src = shift;
    my $args     = shift;

    ${$roll_src} = $args->{favor}
      if ${$roll_src} != $args->{favor} && rand(100) < $args->{bias};

    return;
}

1;
__END__

=head1 NAME

Acme::Dice - The finest in croo ..., uhhh, precision dice!

=head1 SYNOPSIS

 use Acme::Dice qw(roll_dice roll_craps);
   
 my $total = roll_dice( dice => 3, sides => 6, favor => 6, bias => 30 );
 my @dice = roll_dice( dice => 3, sides => 6, favor => 6, bias => 30 );
   
 my $craps_roll = roll_craps( bias => 30 );
 my @craps_dice = roll_craps( bias => 30 );

=head1 DESCRIPTION

Acme knows that sometimes one needs more flexibility in one's rolls than
using normal dice normally allows. Here at last is a package that gives one
exactly the flexibility that has been lacking.

With Acme::Dice, not only can one specify the number and type of dice to be
rolled, not only can one choose to have just the total number or the
individual die results returned, but one can exert some amount of influence
over the outcome as well!

=head1 FUNCTIONS

Nothing is C<EXPORT>ed by default, However, the following functions are
available as imports.