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     } else {
  81         @result = @throws;
  82         $retval .= " $sign $offset" if $sign;
  83     }
  84
  85     my($sum) = 0;
  86     $sum += $_ foreach @result;
  87     $sum += $offset if  $sign eq '+';
  88     $sum -= $offset if  $sign eq '-';
  89     $sum *= $offset if ($sign eq '*' || $sign eq 'x');
  90     do { $sum /= $offset; $sum = int $sum; } if $sign eq '/';
  91
  92     return "$retval = $sum";
  93 }
  94
  95 sub dice::dice {
  96     my ($message) = @_;
  97     srand(); # fork seems to not change rand. force it here
  98     my $retval = roll($message);
  99
 100     &::performStrictReply($retval);
 101 }
 102
 103 #print "(q)uit or die combination, ex. 4d10/4\n";
 104 #while (my $dice = <STDIN>) {
 105 #    chomp $dice;
 106 #    if (! $dice || $dice =~ m/^q(?:uit)*$/i) {
 107 #       print "done\n";
 108 #       exit;
 109 #    } else {
 110 #       print roll($dice) . "\n";
 111 #    }
 112 #}
 113
 114 1;
 115
 116 __END__
 117
 118 =pod
 119
 120 =head1 NAME
 121
 122 dice.pl - simulate die rolls
 123
 124 =head1 SYNOPSIS
 125
 126   'dice 3d6+1';
 127
 128 =head1 DESCRIPTION
 129
 130 The number and type of dice to roll is given in a style which should be
 131 familiar to players of popular role-playing games: I<a>dI<b>[+-*/b]I<c>.
 132 I<a> is optional and defaults to 1; it gives the number of dice to roll.
 133 I<b> indicates the number of sides to each die; the most common,
 134 cube-shaped die is thus a d6. % can be used instead of 100 for I<b>;
 135 hence, rolling 2d% and 2d100 is equivalent. C<roll> simulates I<a> rolls
 136 of I<b>-sided dice and adds together the results. The optional end,
 137 consisting of one of +-*/b and a number I<c>, can modify the sum of the
 138 individual dice. +-*/ are similar in that they take the sum of the rolls
 139 and add or subtract I<c>, or multiply or divide the sum by I<c>. (x can
 140 also be used instead of *.) Hence, 1d6+2 gives a number in the range
 141 3..8, and 2d4*10 gives a number in the range 20..80. (Using / truncates
 142 the result to an int after dividing.) Using b in this slot is a little
 143 different: it's short for "best" and indicates "roll a number of dice,
 144 but add together only the best few". For example, 5d6b3 rolls five six-
 145 sided dice and adds together the three best rolls. This is sometimes
 146 used, for example, in roll-playing to give higher averages.
 147
 148 =head1 AUTHOR
 149
 150 Philip Newton, <pne@cpan.org>
 151
 152 Tim Riker <Tim@Rikers.org>
 153
 154 =head1 LICENCE
 155
 156 Copyright (C) 1999, 2002 Philip Newton - All rights reserved.
 157
 158 Copyright (C) 2005 Tim Riker - All rights reserved.
 159
 160 Redistribution and use in source and binary forms, with or without
 161 modification, are permitted provided that the following conditions
 162 are met:
 163
 164 =over 4
 165
 166 =item *
 167
 168 Redistributions of source code must retain the above copyright notice,
 169 this list of conditions and the following disclaimer.
 170
 171 =item *
 172
 173 Redistributions in binary form must reproduce the above copyright notice,
 174 this list of conditions and the following disclaimer in the
 175 documentation and/or other materials provided with the distribution.
 176
 177 =back
 178
 179 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND
 180 CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
 181 INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
 182 MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
 183 DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR CONTRIBUTORS BE
 184 LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
 185 CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
 186 PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
 187 DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
 188 ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
 189 OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
 190 OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
 191 POSSIBILITY OF SUCH DAMAGE.
 192
 193 =cut
 194
 195 # vim:ts=4:sw=4:expandtab:tw=80