http://qs321.pair.com?node_id=50302
Category: Fun
Author/Contact Info Coreolyn
Description:

Creates, stores and reuses customized sets of random integers.

Version .08 eliminates the dependency for ::Die class and adds two new (unrefined methods) qroll and reRoll.

I look forward to any wisdom bestowed

package Dice;

use strict;
use Carp;

use vars qw($VERSION @EXPORTER @ISA);

@ISA        = qw(Exporter);
@EXPORTER  = qw(rolls reRoll qroll grab faces);
$VERSION   = '0.08';

sub grab {
   my $class = shift;
   unless( shift =~ m/(^\d+)[dD](\d+)$/ ) {
      croak "Invalid parameters passed to $class->grab";
   }

   return bless { type => $2, qty => $1 }, $class;
}

sub rolls {
   my $self = shift;

   my @faces = map { $self->roll } 1..$self->{qty};
   $self->{faces} = \@faces; 

   return $self->total;
}

sub qroll {
   my $self = shift;
   return map { $self->roll } 1..shift;
}

sub roll {
   return int( rand( shift->{type} ) + 1 );
}

sub total {
   my $total = 0;
   foreach my $face ( (shift->faces) ) {
      $total += $face;
   }
   return $total;
}

sub faces {
   my $diRef = shift->{faces};
   return @$diRef;
}

sub reRoll {
   my ( $self, $type, @dice ) = @_;
    
   sub numeric { $a <=> $b }
   my @faces = $self->faces;

   my $i = 1;
   unless ( $type =~ m/^die$/i ) {
      @faces = sort numeric ($self->faces);

      while ( $i <= $dice[0] ) {
         if ( $type =~m/^high$/i ) {
            pop(@faces);
         } elsif ( $type =~ m/^low$/i ) {
            shift(@faces);
         }
         $i++; 
      }
      while ( $i > 1 ) {
         push(@faces, $self->roll );
         $i--;
      }
   } 
   if ( $type =~ m/^die$/i ) {
      VALUE : foreach my $value (@dice) {
         FACE : foreach my $face (@faces) {
            if ( $value == $face ) {
               $face = $self->roll;
               last FACE;
            }
         }
      }
   } 

   $self->{faces} = \@faces;
   return $self->faces;
}

1;
__END__

=head1 NAME

Dice - Perl extension for creating reusable sets of Dice

=head1 SYNOPSIS

  use Dice;

  Dice->grab($dietype)    Constructor takes arguments in the form 
                          of '$dieQty d $dieType' as in the 
                          expression '3d6'. ( Reads 3 six sided 
                          die)

   Dice->rolls()          Rolls new random values for each die in 
                          the Dice object. 

   Dice->faces()          Returns an array with the Dice values

   

   Dice->reRoll('die'|'high'|'low', @faceValues|$qty);

                          The reRoll() method supports three types
                          of re-rolls. The first parameter specifies
                          the type of re-roll.

                   'die'  Signifies that defined face values will be 
                          supplied in @faceValues to be rerolled.

                          [Note: Still needs an exception generated
                           if supplied value is not found in the
                           objects @faces]
 
                  'high'  Signifies that highest dies as specified by 
                          the quantity of dice specified in $qty will 
                          be reRolled.

                  'low'   Same as 'high' except lowest dice.


   Dice->qroll($qty)      Returns a non stored array of dice of the 
                          same 'type' as the object. The number of 
                          dice rolled = $qty.
                            

=head1 DESCRIPTION

   Dice objects are extensible and reusable.  They are of value in 
   programatic re-use, maintenance, and convenience but NOT performanc
+e. 

=head1 AUTHOR

   coreolyn@bereth.com

=head1 SEE ALSO

   

=cut

Test Script
#! /usr/bin/perl -w
use strict;
use lib ('./');
use Dice;

my $dieType = 10;
my $rollQty  = 6;
my $dice = "$rollQty\d$dieType";

system("clear");
print "\n\$dice = $dice\n";

my $MagicMissles = Dice->grab("$dice");
my $total = $MagicMissles->rolls(1);
my @rolls = $MagicMissles->faces;

my $theoreticalAve = ($dieType)  / 2;
my $average = $total / $rollQty;

sub numeric { $a <=> $b }
@rolls = sort numeric (@rolls);
print "\nHere are the di rolls\n@rolls\n";
$total = $MagicMissles->total;
print "Total = $total\n";

@rolls = sort numeric ( $MagicMissles->reRoll('high', '3') );
print "\nAfter re-rolling the top 3 die\n@rolls\n";
$total = $MagicMissles->total;
print "Total = $total\n";

@rolls = sort numeric ( $MagicMissles->reRoll('low', '2') );
print "\nAfter re-rolling the bottom 2 die\n@rolls\n";
$total = $MagicMissles->total;
print "Total = $total\n";

print "\nInput the value of the Die you wish to re-roll: ";
my $values = <STDIN>;
my @values = split(/ /,$values);
@rolls = sort numeric ( $MagicMissles->reRoll('die', @values ) );
print "\nNew rolls now look like this\n@rolls\n";

$total = $MagicMissles->total;
print "\nTotal damage = $total\n";

print "\nQuick rolls (unremembered any qty): ";
my $qty = <STDIN>;
@rolls = $MagicMissles->qroll($qty);
print "You rolled\n@rolls\n";

print "\nAverage should equal $theoreticalAve\nActual Average = $avera
+ge\n\n";