src/Modules/dice.pl

   1 #!/usr/bin/perl
   2
   3 # dice rolling
   4 # hacked up by Tim Riker <Tim@Rikers.org> from Games::Dice
   5
   6 package dice;
   7
   8 use strict;
   9 use warnings;
  10
  11 sub dice::roll_array ($) {
  12     my ($line) = shift;
  13
  14     my (@throws) = ();
  15     return @throws unless $line =~ m{
  16                  ^      # beginning of line
  17                  (\d+)? # optional count in $1
  18                  [dD]   # 'd' for dice
  19                  (      # type of dice in $2:
  20                     \d+ # either one or more digits
  21                   |     # or
  22                     %   # a percent sign for d% = d100
  23                  )
  24               }x;    # whitespace allowed
  25
  26     my ($num) = $1 || 1;
  27     my ($type) = $2;
  28
  29     return @throws if $num > 100;
  30     $type = 100 if $type eq '%';
  31     return @throws if $type < 2;
  32
  33     for ( 1 .. $num ) {
  34         push @throws, int( rand $type ) + 1;
  35     }
  36
  37     return @throws;
  38 }
  39
  40 sub dice::roll ($) {
  41     my ($line) = shift;
  42
  43     $line =~ s/ //g;
  44
  45     return '' unless $line =~ m{
  46                  ^              # beginning of line
  47                  (              # dice string in $1
  48                    (?:\d+)?     # optional count
  49                    [dD]         # 'd' for dice
  50                    (?:          # type of dice:
  51                       \d+       # either one or more digits
  52                     |           # or
  53                       %         # a percent sign for d% = d100
  54                    )
  55                  )
  56                  (?:            # grouping-only parens
  57                    ([-+xX*/bB]) # a + - * / b(est) in $2
  58                    (\d+)        # an offset in $3
  59                  )?             # both of those last are optional
  60               }x;    # whitespace allowed in re
  61
  62     my ($dice_string) = $1;
  63     my ($sign)        = $2 || '';
  64     my ($offset)      = $3 || 0;
  65
  66     $sign = lc $sign;
  67
  68     my (@throws) = roll_array($dice_string);
  69     return '' unless @throws > 0;
  70     my ($retval) = "rolled " . join( ',', @throws );
  71
  72     my (@result);
  73     if ( $sign eq 'b' ) {
  74         $offset = 0       if $offset < 0;
  75         $offset = @throws if $offset > @throws;
  76
  77         @throws = sort { $b <=> $a } @throws;  # sort numerically, descending
  78         @result = @throws[ 0 .. $offset - 1 ]; # pick off the $offset first ones
  79         $retval .= " best $offset";
  80     }
  81     else {
  82         @result = @throws;
  83         $retval .= " $sign $offset" if $sign;
  84     }
  85
  86     my ($sum) = 0;
  87     $sum += $_ foreach @result;
  88     $sum += $offset if $sign eq '+';
  89     $sum -= $offset if $sign eq '-';
  90     $sum *= $offset if ( $sign eq '*' || $sign eq 'x' );
  91     do { $sum /= $offset; $sum = int $sum; } if $sign eq '/';
  92
  93     return "$retval = $sum";
  94 }
  95
  96 sub dice::dice {
  97     my ($message) = @_;
  98     srand();    # fork seems to not change rand. force it here
  99     my $retval = roll($message);
 100
 101     &::performStrictReply($retval);
 102 }
 103
 104 #print "(q)uit or die combination, ex. 4d10/4\n";
 105 #while (my $dice = <STDIN>) {
 106 #    chomp $dice;
 107 #    if (! $dice || $dice =~ m/^q(?:uit)*$/i) {
 108 #       print "done\n";
 109 #       exit;
 110 #    } else {
 111 #       print roll($dice) . "\n";
 112 #    }
 113 #}
 114
 115 1;
 116
 117 __END__
 118
 119 =pod
 120
 121 =head1 NAME
 122
 123 dice.pl - simulate die rolls
 124
 125 =head1 SYNOPSIS
 126
 127   'dice 3d6+1';
 128
 129 =head1 DESCRIPTION
 130
 131 The number and type of dice to roll is given in a style which should be
 132 familiar to players of popular role-playing games: I<a>dI<b>[+-*/b]I<c>.
 133 I<a> is optional and defaults to 1; it gives the number of dice to roll.
 134 I<b> indicates the number of sides to each die; the most common,
 135 cube-shaped die is thus a d6. % can be used instead of 100 for I<b>;
 136 hence, rolling 2d% and 2d100 is equivalent. C<roll> simulates I<a> rolls
 137 of I<b>-sided dice and adds together the results. The optional end,
 138 consisting of one of +-*/b and a number I<c>, can modify the sum of the
 139 individual dice. +-*/ are similar in that they take the sum of the rolls
 140 and add or subtract I<c>, or multiply or divide the sum by I<c>. (x can
 141 also be used instead of *.) Hence, 1d6+2 gives a number in the range
 142 3..8, and 2d4*10 gives a number in the range 20..80. (Using / truncates
 143 the result to an int after dividing.) Using b in this slot is a little
 144 different: it's short for "best" and indicates "roll a number of dice,
 145 but add together only the best few". For example, 5d6b3 rolls five six-
 146 sided dice and adds together the three best rolls. This is sometimes
 147 used, for example, in roll-playing to give higher averages.
 148
 149 =head1 AUTHOR
 150
 151 Philip Newton, <pne@cpan.org>
 152
 153 Tim Riker <Tim@Rikers.org>
 154
 155 =head1 LICENCE
 156
 157 Copyright (C) 1999, 2002 Philip Newton - All rights reserved.
 158
 159 Copyright (C) 2005 Tim Riker - All rights reserved.
 160
 161 Redistribution and use in source and binary forms, with or without
 162 modification, are permitted provided that the following conditions
 163 are met:
 164
 165 =over 4
 166
 167 =item *
 168
 169 Redistributions of source code must retain the above copyright notice,
 170 this list of conditions and the following disclaimer.
 171
 172 =item *
 173
 174 Redistributions in binary form must reproduce the above copyright notice,
 175 this list of conditions and the following disclaimer in the
 176 documentation and/or other materials provided with the distribution.
 177
 178 =back
 179
 180 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND
 181 CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
 182 INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
 183 MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
 184 DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR CONTRIBUTORS BE
 185 LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
 186 CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
 187 PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
 188 DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
 189 ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
 190 OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
 191 OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
 192 POSSIBILITY OF SUCH DAMAGE.
 193
 194 =cut
 195
 196 # vim:ts=4:sw=4:expandtab:tw=80