1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
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',
);
|
