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 performance. =head1 AUTHOR coreolyn@bereth.com =head1 SEE ALSO =cut #### #! /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 = ; 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 = ; @rolls = $MagicMissles->qroll($qty); print "You rolled\n@rolls\n"; print "\nAverage should equal $theoreticalAve\nActual Average = $average\n\n";