WEll... I keep meaning to write a full RPG character generator in perl but never seem to get to the point where I have finished. This is one routine that I used over and over. It generates dice rolls.
Its claim to fame is that it understands gamer's notation for dice. So need to simulate 100 six sided dice? give it a string "100d6", need only the top 40 of those rolls? use "100d6k40", or maybe you don't like 1's and 2's ? use "100d6r2"
Docs in pod. Module was originally designed to work with a single phrase .. but it appears that since I parse it with re that it works for larger phrases. A phrase being a single dice command. so a phrase like "4d6r1k3"( roll 4 six sided dice, reroll any 1's and keep the 3 highest die rolls) should work but I haven't extensively tested it yet.
Multiple definitions of the same phrase ... like constants will only be effective for the last phrase defined in the string.
Any suggestions for enhancements or confirmation testing that longer phrases work are welcome.
package dice;
#
# Copyright 2003 Steven Swenson
# License is granted to use or create derivitive works
# without royalty for personal, academic, or
# other non-profit use.
#
# Government use is restricted to the Federal, State, and
# Territory Governments of the United States of America.
#
# Contact the author for commercial use.
use strict;
use warnings;
BEGIN {
use Exporter ();
our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
# set the version for version checking
$VERSION = 1.00;
@ISA = qw(Exporter);
@EXPORT = qw(&rolldice);
%EXPORT_TAGS = ( ); # eg: TAG => [ qw!name1 name2! ],
# your exported package globals go here,
# as well as any optionally exported functions
@EXPORT_OK = qw();
}
=head1 Routines
=cut
=head2 rolldice()
This routine rolls dice. It takes a $scalar parameter that specifies
+how many dice, what type of dice,
how many dice should be totalled, and whether any should be re-rolled.
example print "\nRolling 4d6r2->".I<rolldice("4d6r2")>."\n";
=over 4
=item *
n1_d_n2 n1 = Dice, n2 = Sides of Die -- 3d6 (roll 3 6 sided dice)
=cut
=item *
k_n n = # Dice kept (highest rolling dice); -- 4d6k3 ( roll 4 6s
+ided dice keep total of 3 highest)
=cut
=item *
l n n = # lowest rolling dice kept -- 4d6l3 ( roll 4 6sided dice
+keep total of 3 lowest)
=cut
=item *
r_n n = If a result is less than or equal to n it is rerolled, re
+placing the low roll. 4d6k3r2 -- Keep 3 highest 6 sided dice, reroll
+any 1's or 2's
=cut
=item *
x_n n = If a result is greater than or equal to n it is rerolled,
+ an added to the total. 4d6k3x5 -- Keep 3 highest 6 sided dice, rerol
+l any 5's or 6's
=cut
=item *
+ add a constant to the result 3d6+4 Total 3 6 sided dice, add 4 t
+o result
=item *
- subtract a constant from the result 3d6-4 Total 3 6 sided dice, ad
+d 4 to result
=back
=cut
=cut
=cut
#Sort Routines
sub highest { $b <=> $a }
sub lowest { $a <=> $b }
#--------
sub rolldice ($) {
my $I = 0;
my ( $total,$highest,$lowest ) = 0;
my $parameter = shift;
my $n_dice = 0;
my $n_sides = 0;
my $n_rolls = 0;
my $rerolls = 0;
my @rolls = ();
my $constant = 0;
my $rolladd = 0;
# Read the Command String with regex
die "No roll command passed to rolldice \n" unless ( $parameter );
#print "Recieved '$parameter' to roll\n";
$_ = $parameter;
$parameter =~ /^([0-9]+)d([0-9]+)/;
$n_dice = $1;
$n_sides = $2;
if ($parameter =~ /k([0-9]+)/) {
$highest = $1;
}
if ($parameter =~ /l([0-9]+)/) {
$lowest = $1;
}
if ($parameter =~ /r([0-9]+)/) {
$rerolls = $1;
}
if ($parameter =~ /x([0-9]+)/) {
$rolladd = $1;
}
if ($parameter =~ /\+([0-9]+)/) {
$constant = $1;
}
if ($parameter =~ /\-([0-9]+)/) {
$constant -= $1;
}
# End Commands
# Roll the dice Put into a list
for (my $I=1; $I <= $n_dice; $I++){
$rolls [$I-1] = int(rand($n_sides))+1;
while ( ($rolls [$I-1] ) <= $rerolls){
#print "rolled a $rolls[$I-1] -- re-rolling\n";
$rolls [$I-1] = int(rand($n_sides))+1;
}
while (( ( $rolls [$I-1] )>= $rolladd ) && ($rolladd) ){
print "rolled a $rolls[$I-1] -- re-rolling and adding to t
+otal\n";
$total += $rolls[$I-1];
$rolls [$I-1] = int(rand($n_sides))+1;
}
}
# Keep Highest only
if ( $highest ){
@rolls = sort highest @rolls;
$n_dice = $highest;
}
# Keep Lowest only
if ( $lowest ){
@rolls = sort lowest @rolls;
$n_dice = $lowest;
}
# Total the dice rolled
for ($I=0;$I <= ($n_dice-1); $I++){
$total += $rolls [$I];
}
$total += $constant;
}
END { } # module clean-up code here (global destructor)
1;
