initial commit

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',
+);