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";
|
Back to
Code Catacombs