html/dice.pl
1 # dice / A RP Dice Simulator
2 #
3 # What is this?
4 #
5 # I often Dungeon Master on our Neverwinternights Servers called "Bund der
6 # alten Reiche" (eng. "Alliance of the old realms") at bundderaltenreiche.de
7 # (German Site) Often idling in our Channel I thought it might be Fun to have
8 # a script to dice. Since I found nothing for irssi I wrote this little piece
9 # of script. The script assumes, that if a 'd' for english dice is given it
10 # should print the output in english. On the other hand if a 'w' for german
11 # "Würfel" is given it prints the output in german.
12 #
13 # Usage.
14 #
15 # Anyone on the Channel kann ask "!dice" to toss the dice for him. He just has
16 # to say what dice he want to use. The notation should be well known from
17 # RP :-) Thus
18 #
19 # Write: !dice: <quantity of dice>d[or w for german users]<sides on dice>
20 #
21 # Here are some examples
22 #
23 # !dice: 2d20
24 # !dice: 3d6
25 #
26 # OK, I think you got it already :-)
27 #
28 # Write: !dice version
29 # For Version Information
30 #
31 # Write: !dice help
32 # For Information about how to use it
33
34 use strict;
35 use vars qw($VERSION %IRSSI);
36
37 use Irssi qw(command_bind signal_add);
38 use IO::File;
39 $VERSION = '0.00.04';
40 %IRSSI = (
41 authors => 'Marcel Kossin',
42 contact => 'mkossin@enumerator.org',
43 name => 'dice',
44 description => 'A Dice Simulator for Roleplaying in Channels or just for fun.',
45 license => 'GNU GPL Version 2 or later',
46 url => 'http://www.enumerator.org/component/option,com_docman/task,view_category/Itemid,34/subcat,7/'
47 );
48
49 sub own_question {
50 my ($server, $msg, $nick, $address, $target) = @_;
51 question($server, $msg, $nick, $target);
52 }
53
54 sub public_question {
55 my ($server, $msg, $nick, $address, $target) = @_;
56 question($server, $msg, $nick, $target);
57 }
58
59 sub question($server, $msg, $nick, $target) {
60 my ($server, $msg, $nick, $target) = @_;
61 $_ = $msg;
62
63 if (!/^!dice/i) { return 0; }
64
65 if (/^!dice:.+[d|w]\d+/i) {
66 my $value;
67 my $rnd;
68 my $forloop;
69 my $sides;
70 my $lang;
71 my @dice = split(/ /,$_,2);
72 my @dices = split(/[d|w|D|W]/,$dice[1],2);
73 if ($_ = /^.*[w|W].*/i) {
74 $lang = "DE";
75 } else {
76 $lang = "EN";
77 }
78 SWITCH: {
79 if ($lang eq "DE") {
80 $server->command('msg '.$target.' '.$nick.' würfelt mit dem '.$dice[1].'..... ');
81 last SWITCH;
82 }
83 if ($lang eq "EN") {
84 $server->command('msg '.$target.' '.$nick.' tosses with the '.$dice[1].'..... ');
85 last SWITCH;
86 }
87 }
88 if($dices[1] > 1) {
89 if($dices[1] < 100) {
90 if($dices[0] < 11) {
91 if($dices[0] < 1) {
92 $dices[0] = 1;
93 }
94 for($forloop = 1; $forloop <= $dices[0]; $forloop++) {
95 $rnd = int(rand($dices[1]-1));
96 if($rnd == 0){
97 $rnd = $dices[1];
98 }
99 $value = $value + $rnd;
100 SWITCH: {
101 if ($lang eq "DE") {
102 $server->command('msg '.$target.' '.$nick.' würfelt beim '.$forloop.'. Wurf eine '.$rnd);
103 last SWITCH;
104 }
105 if ($lang eq "EN") {
106 $server->command('msg '.$target.' '.$nick.' tosses at his '.$forloop.'. try a '.$rnd);
107 last SWITCH;
108 }
109 }
110 }
111 SWITCH: {
112 if ($lang eq "DE") {
113 $server->command('msg '.$target.' '.$nick.' ist fertig mit Würfeln. Sein Ergebnis lautet: '.$value);
114 last SWITCH;
115 }
116 if ($lang eq "EN") {
117 $server->command('msg '.$target.' '.$nick.' finished. His result reads: '.$value);
118 last SWITCH;
119 }
120 }
121 } else {
122 SWITCH: {
123 if ($lang eq "DE") {
124 $server->command('msg '.$target.' '.$nick.' meint wohl in d'.$dices[1].'´s baden zu müssen... Mal im Ernst versuch es mit weniger Würfeln!' );
125 last SWITCH;
126 }
127 if ($lang eq "EN") {
128 $server->command('msg '.$target.' '.$nick.' seems to wanna take a bath in d'.$dices[1].'´s... Seriously! Try less dice' );
129 last SWITCH;
130 }
131 }
132 }
133 } else {
134 SWITCH: {
135 if ($lang eq "DE") {
136 $server->command('msg '.$target.' '.$nick.' baut uns bald einen riiiiiesigen d'.$dices[1].'... Mal im Ernst versuch es mit weniger Augen!' );
137 last SWITCH;
138 }
139 if ($lang eq "EN") {
140 $server->command('msg '.$target.' '.$nick.' soon will build us a biiiiiiiiiig d'.$dices[1].'... Seriously! Try less sides' );
141 last SWITCH;
142 }
143 }
144 }
145 } else {
146 if($dices[1] == "0") {
147 SWITCH: {
148 if ($lang eq "DE") {
149 $server->command('msg '.$target.' '.$nick.' ist dumm wie Knäckebrot... Oder hat jemand schonmal einen Würfel ohne Seiten gesehen?' );
150 last SWITCH;
151 }
152 if ($lang eq "EN") {
153 $server->command('msg '.$target.' '.$nick.' is chuckleheaded... Or has anybody ever seen a dice without sides?' );
154 last SWITCH;
155 }
156 }
157 }
158 if($dices[1] == "1") {
159 SWITCH: {
160 if ($lang eq "DE") {
161 $server->command('msg '.$target.' '.$nick.' ist dumm wie Dosenthunfisch... Oder hat jemand schonmal einen Würfel mit einer Seite gesehen?' );
162 last SWITCH;
163 }
164 if ($lang eq "EN") {
165 $server->command('msg '.$target.' '.$nick.' plays possum... Or has anybody ever seen a dice with only one side?' );
166 last SWITCH;
167 }
168 }
169 }
170 }
171 return 0;
172 } elsif (/^!dice: version$/i){
173 $server->command('msg '.$target.' dice Version: '.$VERSION.' by mkossin');
174 return 0;
175 } elsif (/^!dice: help$/i){
176 $server->command('msg '.$target.' '.$nick.' Please explain which dice you want to toss: "!dice: <quantity of dice>d<sides on dice>" e. g. "!dice: 2d20"');
177 return 0;
178 } elsif (/^!dice: hilfe$/i){
179 $server->command('msg '.$target.' '.$nick.' Sag mir welchen Würfel du werfen möchtest: "!dice: <Anzahl der Würfel>w<Augen des Würfels>" z. B. "!dice: 2w20"');
180 return 0;
181 } else {
182 if(!/^!dice.*:/i){
183 $server->command('msg '.$target.' '.$nick.' "!dice: help" - gives you the english help');
184 $server->command('msg '.$target.' '.$nick.' "!dice: hilfe" - zeigt die Deutsche Hilfe an');
185 return 0;
186 }
187 }
188 }
189
190 signal_add("message public", "public_question");
191 signal_add("message own_public", "own_question");