diff options
Diffstat (limited to 'newdice.pl')
| -rw-r--r-- | newdice.pl | 205 |
1 files changed, 205 insertions, 0 deletions
diff --git a/newdice.pl b/newdice.pl new file mode 100644 index 0000000..e1f9f80 --- /dev/null +++ b/newdice.pl @@ -0,0 +1,205 @@ + +# newdice.pl - AD&D dice roller for IRC. +# Loosely based on 'dice_concise.pl', here: +# https://scripts.irssi.org/scripts/dice_concise.pl +# ...but completely rewritten, so I don't feel bound by the GPL. + +# Differences between this and dice_concise.pl: + +# - The count can be omitted, so "d6" means "1d6". +# - If the count is omitted, the "d" can also be omitted, so "6" means "1d6". +# - Multiple arguments are supported, e.g. "!roll 1d20 1d8+4", up to $max_args. +# - A repeat count can be given as the first argument, e.g. "!roll 6x 3d6" +# for rolling stats. +# - The command prefix can either be ! or the bot's nick. +# - Private messages are supported, with or without the command prefix. +# - Modifiers are eval'ed as perl code, so they can be arbitrarily complex, +# and support proper precedence (+2*20 means *40). +# - Add !reroll command. doesn't track context, literally just rerolls +# the last thing that was rolled, no matter who did it or what channel +# or privmsg it was. +# - Simplify error messages. parse errors just print the help, there's no +# need for a separate help command. +# - Got rid of the German translations. I had to write new error messages, +# and I don't speak German. The "2w6" notation is still supported. +# - Change the presentation of the output (remove commas, for one thing). also, +# don't print the raw roll in brackets if it's a plain 1d roll with no +# modifier (for 1d6, you just get 6, not "6 [6]"). +# - Got rid of limit of 100 sides. I can't see much use for 1000+ sided dice, +# but it does no harm to support them. + +use strict; +use vars qw($VERSION %IRSSI $VERBOSE $parse_regex $max_dice $max_args $lastmsg); + +use Irssi qw(signal_add); + +$VERSION = '0.1'; +%IRSSI = ( + authors => 'B. Watson', + contact => 'urchlay@slackware.uk', + name => 'newdice', + description => 'Die roller that accepts AD&D notation', + license => 'WTFPL', +); + +$VERBOSE = 0; # set to 1 if needed. + +$max_dice = 20; +$max_args = 6; + +# I tried to make this regex as readable as possible. It doesn't +# handle the 'relaxed' syntax where the count and/or the letter d +# are missing: those get added by other code, so this will always see +# e.g. "1d6" even if "6" was the original input. +$parse_regex = qr/ + ^ # anchor at start of arg (to avoid e.g. -1d6). + (\d+) # count of dice (required). + d # the letter d or D (required). + (\d+) # number of sides on die (required). + ( # modifier(s)... + [-+\/*] # first modifier *must* start with arithmetic operator. + [-+\/*\d]+ # the rest is mix-and match, arith ops and digits. + )? # ...modifiers are optional. + $ # avoid trailing junk, e.g. "1d6foo". +/ix; + +# This always rounds up if the fractional part is >= 0.5, regardless +# of sign (5.5 rounds to 6, -5.5 rounds to -5). Could have used +# POSIX::ceil, but POSIX is a lot of overhead just for one simple +# funciton. +sub round_up(\$) { + my $v = ${$_[0]}; + my $i = int(${$_[0]}); + my $sgn = ($v < 0 ? -1 : 1); + $i += $sgn if ($v - $i >= 0.5); + ${$_[0]} = $i; +} + +sub on_message { + my ($server, $msg, $nick, $address, $target) = @_; + my $mynick = $server->{nick}; + + unless(length $target) { + $target = $nick; + $nick = $mynick; + } + + if($target eq $mynick) { + # private message... send response to sender + $target = $nick; + $msg =~ s/^/!/; + } + + # all responses start with this prefix. + my $resp = "msg $target $nick"; + + # command prefix can be ! or nick followed by an optional punctuation mark + # and a required space. + $msg =~ s/^$mynick[^\sA-Za-z0-9]\s/!/; + + # allow multiple ! (makes the logic simpler) + return unless $msg =~ /^!+(re)?roll(?:$|\s*(\S.*)?$)/i; + + if($1) { # re-rolling last args... + if(defined($2)) { + $server->command("$resp: Usage: !reroll (no arguments)."); + return; + } elsif(defined $lastmsg) { + $msg = $lastmsg; + } else { + $server->command("$resp: can't re-roll, nobody has rolled yet."); + return; + } + } + + warn "\$nick is $nick, \$target is $target, server nick is " . $server->{nick} if $VERBOSE; + + # accept d% as a synonym for d100 + $msg =~ s/%/100/g; + + # the 'undef' gets rid of the command (the !roll). + (undef, my @args) = split " ", $msg; + + if($args[0] && ($args[0] =~ /^([1-9])x$/)) { + shift @args; + my @newargs; + push @newargs, @args for 1..$1; + @args = @newargs; + } + + warn join(", ", @args) if $VERBOSE; + + if(@args > $max_args) { + $server->command("$resp: too many arguments (limit is $max_args)"); + return; + } elsif(!@args) { + push @args, "help"; + } + + for my $arg (@args) { + # support the German "w" notation, for compatibility with dice_concise.pl. + if($arg =~ /^\d*w/i) { + $arg =~ s/w/d/i; + } + + # add default prefixes (count and the letter 'd') if missing. + # allows e.g. "!roll 6" or "!roll 1d6" to mean "!roll 1d6", + # or even "!roll 6+2" to mean "!roll 1d6+2". + $arg =~ s/^/d/ if $arg !~ /d/i; + $arg =~ s/^/1/ if $arg =~ /^d/i; + + if($arg =~ $parse_regex) { + my $count = $1 || 1; + my $sides = $2; + my $mods = $3 || ""; + my $canonical = "${count}d${sides}${mods}"; + my @rolls; + my $total = 0; + + if($count > $max_dice) { + $server->command("$resp: $canonical: too many dice (limit is $max_dice)"); + next; + } + + if($sides < 2) { + $server->command("$resp: $canonical: not enough sides (must be at least 2)"); + next; + } + + for(1..$count) { + my $got = int(rand($sides) + 1); + $total += $got; + push @rolls, $got; + } + + # modifiers can be anything that's valid perl. this isn't a + # security hole because the $parse_regex only accepts + - * / + # and digits (so, no way to execute arbitrary code). + eval "\$total = $total $mods;" if $mods; + + if($@) { + $server->command("$resp: $canonical: Invalid modifier '$mods'."); + } else { + round_up($total); + my $msg = "$resp rolls $canonical and gets: $total"; + if(($count > 1) || $mods) { + $msg .= " [" . join(' ', @rolls) . "]"; + } + $server->command($msg); + } + } else { + $server->command($resp . ': Usage: !roll [<repeat>x] [<numdice>][d]<sides>[<+-*/>modifier(s)] ... (e.g. "!roll 2d20", "!roll 2d20*2+10"'); + return; + }; + + } + $lastmsg = $msg; + return; +} + +signal_add($_, 'on_message') for ( + 'message private', + 'message own_private', + 'message public', + 'message own_public', +); |