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