]> git.donarmstrong.com Git - infobot.git/commitdiff
dice
authortimriker <timriker@c11ca15a-4712-0410-83d8-924469b57eb5>
Thu, 12 May 2005 21:28:15 +0000 (21:28 +0000)
committertimriker <timriker@c11ca15a-4712-0410-83d8-924469b57eb5>
Thu, 12 May 2005 21:28:15 +0000 (21:28 +0000)
git-svn-id: https://svn.code.sf.net/p/infobot/code/trunk/blootbot@1219 c11ca15a-4712-0410-83d8-924469b57eb5

src/CommandStubs.pl
src/Modules/dice.pl [new file with mode: 0755]

index 1beb9e0a6e899ac97fe7ac3eb5e67d0801ee1839..c4d590b14dace7ab180e6ce8e6bc0787a30376c7 100644 (file)
@@ -858,6 +858,7 @@ sub nullski {
 &addCmdHook('d?bugs', ('CODEREF' => 'DebianExtra::Parse', 'Forker' => 1, 'Identifier' => 'DebianExtra', 'Cmdstats' => 'Debian Bugs') );
 &addCmdHook('d?contents', ('CODEREF' => 'Debian::searchContents', 'Forker' => 1, 'Identifier' => 'Debian', 'Cmdstats' => 'Debian Contents Search', 'Help' => 'contents' ) );
 &addCmdHook('d?find', ('CODEREF' => 'Debian::DebianFind', 'Forker' => 1, 'Identifier' => 'Debian', 'Cmdstats' => 'Debian Search', 'Help' => 'find' ) );
+&addCmdHook('dice', ('CODEREF' => 'dice::dice', 'Identifier' => 'dice', 'Cmdstats' => 'dice', 'Forker' => 1, 'Module' => 'dice') );
 &addCmdHook('Dict', ('CODEREF' => 'Dict::Dict', 'Identifier' => 'Dict', 'Help' => 'dict', 'Forker' => 1, 'Cmdstats' => 'Dict') );
 &addCmdHook('dincoming', ('CODEREF' => 'Debian::generateIncoming', 'Forker' => 1, 'Identifier' => 'Debian' ) );
 &addCmdHook('dnew', ('CODEREF' => 'DebianNew', 'Identifier' => 'Debian' ) );
diff --git a/src/Modules/dice.pl b/src/Modules/dice.pl
new file mode 100755 (executable)
index 0000000..0a8876b
--- /dev/null
@@ -0,0 +1,193 @@
+#!/usr/bin/perl
+
+# dice rolling
+# hacked up by Tim Riker <Tim@Rikers.org> from Games::Dice
+
+package dice;
+
+use strict;
+use warnings;
+
+sub dice::roll_array ($) {
+    my($line) = shift;
+
+    my(@throws) = ();
+    return @throws unless $line =~ m{
+                 ^      # beginning of line
+                 (\d+)? # optional count in $1
+                 [dD]   # 'd' for dice
+                 (      # type of dice in $2:
+                    \d+ # either one or more digits
+                  |     # or
+                    %   # a percent sign for d% = d100
+                 )
+              }x;       # whitespace allowed
+
+    my($num)    = $1 || 1;
+    my($type)   = $2;
+
+    return @throws if $num > 100;
+    $type  = 100 if $type eq '%';
+    return @throws if $type < 2;
+
+    for( 1 .. $num ) {
+        push @throws, int (rand $type) + 1;
+    }
+
+    return @throws;
+}
+
+sub dice::roll ($) {
+    my($line) = shift;
+
+    $line =~ s/ //g;
+
+    return '' unless $line =~ m{
+                 ^              # beginning of line
+                 (              # dice string in $1
+                   (?:\d+)?     # optional count
+                   [dD]         # 'd' for dice
+                   (?:          # type of dice:
+                      \d+       # either one or more digits
+                    |           # or
+                      %         # a percent sign for d% = d100
+                   )
+                 )
+                 (?:            # grouping-only parens
+                   ([-+xX*/bB]) # a + - * / b(est) in $2
+                   (\d+)        # an offset in $3
+                 )?             # both of those last are optional
+              }x;               # whitespace allowed in re
+
+    my($dice_string) = $1;
+    my($sign) = $2 || '';
+    my($offset) = $3 || 0;
+
+    $sign = lc $sign;
+
+    my(@throws) = roll_array( $dice_string );
+    return '' unless @throws > 0;
+    my($retval) = "rolled " . join(',', @throws);
+
+    my(@result);
+    if( $sign eq 'b' ) {
+        $offset = 0       if $offset < 0;
+        $offset = @throws if $offset > @throws;
+
+        @throws = sort { $b <=> $a } @throws;   # sort numerically, descending
+        @result = @throws[ 0 .. $offset-1 ];    # pick off the $offset first ones
+       $retval .= " best $offset";
+    } else {
+        @result = @throws;
+    }
+
+    my($sum) = 0;
+    $sum += $_ foreach @result;
+    $sum += $offset if  $sign eq '+';
+    $sum -= $offset if  $sign eq '-';
+    $sum *= $offset if ($sign eq '*' || $sign eq 'x');
+    do { $sum /= $offset; $sum = int $sum; } if $sign eq '/';
+    $retval .= " $sign $offset" if $sign;
+
+    return "$retval = $sum";
+}
+
+sub dice::dice {
+    my ($message) = @_;
+    srand(); # fork seems to not change rand. force it here
+    my $retval = roll($message);
+
+    &::performStrictReply($retval);
+}
+
+#print "(q)uit or die combination, ex. 4d10/4\n";
+#while (my $dice = <STDIN>) {
+#    chomp $dice;
+#    if (! $dice || $dice =~ m/^q(?:uit)*$/i) {
+#      print "done\n";
+#      exit;
+#    } else {
+#      print roll($dice) . "\n";
+#    }
+#}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+dice.pl - simulate die rolls
+
+=head1 SYNOPSIS
+
+  'dice 3d6+1';
+
+=head1 DESCRIPTION
+
+The number and type of dice to roll is given in a style which should be
+familiar to players of popular role-playing games: I<a>dI<b>[+-*/b]I<c>.
+I<a> is optional and defaults to 1; it gives the number of dice to roll.
+I<b> indicates the number of sides to each die; the most common,
+cube-shaped die is thus a d6. % can be used instead of 100 for I<b>;
+hence, rolling 2d% and 2d100 is equivalent. C<roll> simulates I<a> rolls
+of I<b>-sided dice and adds together the results. The optional end,
+consisting of one of +-*/b and a number I<c>, can modify the sum of the
+individual dice. +-*/ are similar in that they take the sum of the rolls
+and add or subtract I<c>, or multiply or divide the sum by I<c>. (x can
+also be used instead of *.) Hence, 1d6+2 gives a number in the range
+3..8, and 2d4*10 gives a number in the range 20..80. (Using / truncates
+the result to an int after dividing.) Using b in this slot is a little
+different: it's short for "best" and indicates "roll a number of dice,
+but add together only the best few". For example, 5d6b3 rolls five six-
+sided dice and adds together the three best rolls. This is sometimes
+used, for example, in roll-playing to give higher averages.
+
+=head1 AUTHOR
+
+Philip Newton, <pne@cpan.org>
+
+Tim Riker <Tim@Rikers.org>
+
+=head1 LICENCE
+
+Copyright (C) 1999, 2002 Philip Newton - All rights reserved.
+
+Copyright (C) 2005 Tim Riker - All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions
+are met:
+
+=over 4
+
+=item *
+
+Redistributions of source code must retain the above copyright notice,
+this list of conditions and the following disclaimer.
+
+=item *
+
+Redistributions in binary form must reproduce the above copyright notice,
+this list of conditions and the following disclaimer in the
+documentation and/or other materials provided with the distribution.
+
+=back
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND
+CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR CONTRIBUTORS BE
+LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
+ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGE.
+
+=cut