]>
Commit | Line | Data |
---|---|---|
f1171346 MG |
1 | package Mafia; |
2 | ||
3 | use 5.014000; | |
4 | use strict; | |
5 | use warnings; | |
6 | use parent qw/Exporter/; | |
7 | ||
8 | use constant; | |
9 | use Storable qw/dclone/; | |
10 | ||
11 | our $VERSION = '0.001'; | |
12 | ||
13 | sub defconst { constant->import($_ => $_) for @_ } | |
14 | ||
15 | BEGIN { | |
16 | # Roles | |
17 | defconst qw/vanilla goon doctor vigilante roleblocker jailkeeper gunsmith tracker watcher bodyguard rolecop cop sk hider/; | |
18 | ||
19 | # Factions | |
20 | defconst qw/mafia town/; | |
21 | ||
22 | # Extra traits | |
23 | defconst qw/miller godfather weak macho bulletproof/; | |
24 | ||
25 | # Messages | |
26 | defconst qw/MSG_NIGHT MSG_DAY MSG_PLAYERS_ALIVE MSG_DEATH MSG_GUNCHECK MSG_NORESULT MSG_TRACK MSG_WATCH MSG_COP MSG_ROLECOP/; | |
27 | ||
28 | # Action types | |
29 | defconst qw/ACT_KILL ACT_LYNCH ACT_PROTECT ACT_GUARD ACT_ROLEBLOCK ACT_GUNCHECK ACT_TRACK ACT_WATCH ACT_ROLECOP ACT_COP ACT_TRACK_RESULT ACT_WATCH_RESULT ACT_HIDE/; | |
30 | } | |
31 | ||
32 | use constant +{ | |
33 | townie => town, | |
34 | ROLE => [vanilla, goon, doctor, vigilante, roleblocker, jailkeeper, gunsmith, tracker, watcher, bodyguard, rolecop, cop, sk, hider], | |
35 | FACTION => [mafia, town], | |
36 | FLAG => [miller, godfather, weak, macho, bulletproof], | |
37 | ACTION_ORDER => [ACT_HIDE, ACT_ROLEBLOCK, ACT_PROTECT, ACT_GUARD, ACT_GUNCHECK, ACT_ROLECOP, ACT_COP, ACT_TRACK, ACT_WATCH, ACT_KILL, ACT_LYNCH, ACT_TRACK_RESULT, ACT_WATCH_RESULT], | |
38 | INVESTIGATIVE_ACTIONS => [ACT_GUNCHECK, ACT_TRACK, ACT_WATCH, ACT_ROLECOP, ACT_COP], | |
39 | GUNROLES => [vigilante, gunsmith], | |
40 | }; | |
41 | ||
42 | our @EXPORT = do { | |
43 | no strict 'refs'; | |
44 | grep { $_ !~ [qw/import/] and exists &$_ } keys %{__PACKAGE__ . '::'}; | |
45 | }; | |
46 | ||
47 | ################################################## Helper subs | |
48 | ||
49 | sub import { | |
50 | strict->import; | |
51 | goto &Exporter::import; | |
52 | } | |
53 | ||
54 | my (%players, %tplayers, @actions); | |
55 | my $daycnt = 0; | |
56 | my $nightcnt = 0; | |
57 | my $isday = 0; | |
58 | my $first = 1; | |
59 | ||
60 | sub clean{ | |
61 | %players = (); | |
62 | %tplayers = (); | |
63 | @actions = (); | |
64 | $daycnt = 0; | |
65 | $nightcnt = 0; | |
66 | $isday = 0; | |
67 | $first = 1; | |
68 | } | |
69 | ||
70 | sub uniq { | |
71 | my %hash = map { $_ => 1 } @_; | |
72 | keys %hash | |
73 | } | |
74 | ||
75 | sub phase { | |
76 | return "Day $daycnt" if $isday; | |
77 | return "Night $nightcnt" unless $isday; | |
78 | } | |
79 | ||
80 | sub rolename { | |
81 | my %player = %{$players{$_[0]}}; | |
82 | my ($faction, $role) = ($player{faction}, $player{role}); | |
83 | if (defined $faction && $faction eq town && $role eq vanilla){ | |
84 | undef $faction; | |
85 | $role = 'Vanilla Townie'; | |
86 | }; | |
87 | my @tokens = (); | |
88 | push @tokens, ucfirst $faction if $faction; | |
89 | for my $flag (@{FLAG()}) { | |
90 | push @tokens, ucfirst $flag if $player{$flag} | |
91 | } | |
92 | push @tokens, ucfirst $role unless $role eq goon && $player{godfather}; | |
93 | "@tokens" | |
94 | } | |
95 | ||
96 | sub msg { | |
97 | my ($type, @args) = @_; | |
98 | given ($type){ | |
99 | when (MSG_NIGHT) { | |
100 | my ($night) = @args; | |
101 | say '' unless $first; | |
102 | $first = 0; | |
103 | say "It is Night $night"; | |
104 | } | |
105 | ||
106 | when (MSG_DAY) { | |
107 | my ($day) = @args; | |
108 | say '' unless $first; | |
109 | $first = 0; | |
110 | say "It is Day $day"; | |
111 | } | |
112 | ||
113 | when (MSG_PLAYERS_ALIVE) { | |
114 | @args = sort @args; | |
115 | say "Players alive: ", join ', ', @args | |
116 | } | |
117 | ||
118 | when (MSG_DEATH) { | |
119 | my %args = @args; | |
120 | my ($who, $reason) = @args{'target', 'reason'}; | |
121 | my $phase = phase; | |
122 | my $rolename = rolename $who; | |
123 | say "$who ($rolename) — $reason $phase"; | |
124 | } | |
125 | ||
126 | when (MSG_GUNCHECK) { | |
127 | my %args = @args; | |
128 | my ($gunsmith, $who, $hasgun) = @args{'source', 'target', 'result'}; | |
129 | say "$gunsmith: $who has a gun" if $hasgun; | |
130 | say "$gunsmith: $who does not have a gun" unless $hasgun; | |
131 | } | |
132 | ||
133 | when (MSG_NORESULT) { | |
134 | my %args = @args; | |
135 | my ($who) = $args{'source'}; | |
136 | say "$who: No result" | |
137 | } | |
138 | ||
139 | when (MSG_TRACK) { | |
140 | my %args = @args; | |
141 | my ($tracker, $who, $result) = @args{'source', 'target', 'result'}; | |
142 | my @result = @{$result}; | |
143 | local $, = ', '; | |
144 | say "$tracker: $who did not visit anyone" unless scalar @result; | |
145 | say "$tracker: $who visited: @result" if scalar @result; | |
146 | } | |
147 | ||
148 | when (MSG_WATCH) { | |
149 | my %args = @args; | |
150 | my ($watcher, $who, $result) = @args{'source', 'target', 'result'}; | |
151 | my @result = @{$result}; | |
152 | local $, = ', '; | |
153 | say "$watcher: $who was not visited by anyone" unless scalar @result; | |
154 | say "$watcher: $who was visited by: @result" if scalar @result; | |
155 | } | |
156 | ||
157 | when (MSG_ROLECOP) { | |
158 | my %args = @args; | |
159 | my ($rolecop, $who, $role) = @args{'source', 'target', 'result'}; | |
160 | say "$rolecop: $who\'s role is: $role" | |
161 | } | |
162 | ||
163 | when (MSG_COP) { | |
164 | my %args = @args; | |
165 | my ($cop, $who, $ismafia) = @args{'source', 'target', 'result'}; | |
166 | say "$cop: $who is mafia" if $ismafia; | |
167 | say "$cop: $who is not mafia" unless $ismafia; | |
168 | } | |
169 | } | |
170 | } | |
171 | ||
172 | sub putaction { | |
173 | my ($delay, $type, %args) = @_; | |
174 | $actions[$delay]->{$type} //= []; | |
175 | if (exists $args{target} && exists $args{source} && $players{$args{target}}{faction} eq mafia && $players{$args{source}}{weak}) { | |
176 | putaction($delay, ACT_KILL, target => $args{source}, reason => 'targeted scum'); | |
177 | } | |
178 | push $actions[$delay]->{$type}, \%args | |
179 | } | |
180 | ||
181 | sub doaction { | |
182 | my ($type, $args) = @_; | |
183 | my %args = %$args; | |
184 | my $source = $args{source}; | |
185 | my $target = $args{target}; | |
186 | if (defined $source && defined $target) { | |
187 | # Watcher and tracker variables | |
188 | $tplayers{$source}{targets} //= []; | |
189 | push $tplayers{$source}{targets}, $target; | |
190 | $tplayers{$target}{sources} //= []; | |
191 | push $tplayers{$target}{sources}, $source; | |
192 | ||
193 | # Copy this action to everybody hiding behind $target | |
194 | if (exists $tplayers{$target}{hiders}) { | |
195 | for my $target (@{$tplayers{$target}{hiders}}) { | |
196 | my %args = %args; | |
197 | $args{target} = $target; | |
198 | $args{hidepierce} = 1; | |
199 | doaction($type, \%args); | |
200 | } | |
201 | } | |
202 | ||
203 | # Check if the action should be blocked | |
204 | my $strongkill = $type eq ACT_KILL && $args{strong}; | |
205 | my $roleblocked = $tplayers{$source}{roleblocked}; | |
206 | my $hidden = $tplayers{$target}{hidden}; | |
207 | my $hidepierce = $args{hidepierce}; | |
208 | if ($source && (( $roleblocked && !$strongkill ) || ($hidden && !$hidepierce) )) { | |
209 | msg MSG_NORESULT, %args if $type ~~ INVESTIGATIVE_ACTIONS; | |
210 | return | |
211 | } | |
212 | } | |
213 | ||
214 | ||
215 | given ($type) { | |
216 | when(ACT_KILL) { | |
217 | break if $tplayers{$target}{bulletproof} && defined $source; | |
218 | if ($tplayers{$target}{guard_count} && defined $source) { | |
219 | $tplayers{$target}{guard_count}--; | |
220 | # Copy this action to the first guard | |
221 | $args{target} = shift $tplayers{$target}{guards}; | |
222 | @_ = ($type, %args); | |
223 | goto &doaction; | |
224 | } | |
225 | if ($tplayers{$target}{protection} && !$args{strong}) { | |
226 | $tplayers{$target}{protection}--; | |
227 | break | |
228 | } | |
229 | msg MSG_DEATH, %args; | |
230 | delete $players{$target} | |
231 | } | |
232 | ||
233 | when(ACT_LYNCH){ | |
234 | if ($tplayers{$target}{guard_count}) { | |
235 | $tplayers{$target}{guard_count}--; | |
236 | $args{target} = shift $tplayers{$target}{guards}; | |
237 | $target=$args{target}; | |
238 | } | |
239 | if ($tplayers{$target}{protection}) { | |
240 | $tplayers{$target}{protection}--; | |
241 | break | |
242 | } | |
243 | msg MSG_DEATH, %args, reason => 'lynched'; | |
244 | delete $players{$target} | |
245 | } | |
246 | ||
247 | when(ACT_PROTECT){ | |
248 | my $count = $args{count} // 1; | |
249 | $tplayers{$target}{protection} += $count unless $tplayers{$target}{macho} | |
250 | } | |
251 | ||
252 | when(ACT_ROLEBLOCK){ | |
253 | $tplayers{$target}{roleblocked} = 1 | |
254 | } | |
255 | ||
256 | when(ACT_GUNCHECK){ | |
257 | my $role = $players{$target}{role}; | |
258 | my $hasgun = $role ~~ GUNROLES || ($players{$target}{faction} eq mafia && $role ne doctor); | |
259 | msg MSG_GUNCHECK, %args, result => $hasgun | |
260 | } | |
261 | ||
262 | when(ACT_TRACK_RESULT){ | |
263 | msg MSG_TRACK, %args, result => [ uniq @{$tplayers{$target}{targets} // []} ]; | |
264 | } | |
265 | ||
266 | when(ACT_WATCH_RESULT){ | |
267 | msg MSG_WATCH, %args, result => [ uniq @{$tplayers{$target}{sources} // []} ]; | |
268 | } | |
269 | ||
270 | when(ACT_GUARD){ | |
271 | $tplayers{$target}{guard_count}++; | |
272 | $tplayers{$target}{guards} //= []; | |
273 | push $tplayers{$target}{guards}, $source; | |
274 | } | |
275 | ||
276 | when(ACT_ROLECOP){ | |
277 | my $result = $players{$target}{role}; | |
278 | $result = vanilla if $result eq goon; | |
279 | msg MSG_ROLECOP, %args, result => ucfirst $result | |
280 | } | |
281 | ||
282 | when(ACT_COP){ | |
283 | my $result = $players{$target}{faction} eq mafia; | |
284 | $result = 1 if $players{$target}{miller}; | |
285 | $result = 0 if $players{$target}{godfather}; | |
286 | msg MSG_COP, %args, result => $result | |
287 | } | |
288 | ||
289 | when(ACT_HIDE){ | |
290 | $tplayers{$source}{hidden} = 1; | |
291 | $tplayers{$target}{hiders} //= []; | |
292 | push $tplayers{$target}{hiders}, $source | |
293 | } | |
294 | } | |
295 | } | |
296 | ||
297 | sub process_phase_change { | |
298 | %tplayers = %{dclone \%players}; | |
299 | my $actions = shift @actions; | |
300 | for my $type(@{ACTION_ORDER()}) { | |
301 | doaction $type, $_ for @{$actions->{$type}} | |
302 | } | |
303 | } | |
304 | ||
305 | ################################################## User subs | |
306 | ||
307 | sub player { | |
308 | my ($name, @args) = @_; | |
309 | my %player; | |
310 | for my $trait (@args) { | |
311 | given ($trait) { | |
312 | $player{role} = $trait when ROLE; | |
313 | $player{faction} = $trait when FACTION; | |
314 | $player{$trait} = 1 when FLAG; | |
315 | } | |
316 | } | |
317 | ||
318 | $players{$name} = \%player; | |
319 | } | |
320 | ||
321 | sub day { | |
322 | process_phase_change; | |
323 | $isday = 1; | |
324 | msg MSG_DAY, ++$daycnt; | |
325 | msg MSG_PLAYERS_ALIVE, keys %players; | |
326 | } | |
327 | ||
328 | sub night { | |
329 | process_phase_change; | |
330 | $isday = 0; | |
331 | msg MSG_NIGHT, ++$nightcnt; | |
332 | msg MSG_PLAYERS_ALIVE, keys %players; | |
333 | } | |
334 | ||
335 | sub lynch { | |
336 | my ($who) = @_; | |
337 | putaction 0, ACT_LYNCH, target => $who; | |
338 | } | |
339 | ||
340 | sub factionkill { | |
341 | my ($killer, $who, $reason, @args) = @_; | |
342 | putaction 0, ACT_KILL, target => $who, source => $killer, reason => $reason, @args; | |
343 | } | |
344 | ||
345 | sub protect { | |
346 | my ($doctor, $who) = @_; | |
347 | putaction 0, ACT_PROTECT, target => $who, source => $doctor; | |
348 | } | |
349 | ||
350 | sub vig { | |
351 | my ($vig, $who, $reason, @args) = @_; | |
352 | putaction 0, ACT_KILL, target => $who, source => $vig, reason => $reason, @args; | |
353 | } | |
354 | ||
355 | sub roleblock { | |
356 | my ($roleblocker, $who) = @_; | |
357 | putaction 0, ACT_ROLEBLOCK, target => $who, source => $roleblocker; | |
358 | } | |
359 | ||
360 | sub jailkeep { | |
361 | my ($jailkeeper, $who) = @_; | |
362 | putaction 0, ACT_ROLEBLOCK, target => $who, source => $jailkeeper; | |
363 | putaction 0, ACT_PROTECT, target => $who, source => $jailkeeper, count => 1000; | |
364 | } | |
365 | ||
366 | sub guncheck { | |
367 | my ($gunsmith, $who) = @_; | |
368 | putaction 0, ACT_GUNCHECK, target => $who, source => $gunsmith; | |
369 | } | |
370 | ||
371 | sub track { | |
372 | my ($tracker, $who) = @_; | |
373 | putaction 0, ACT_TRACK, target => $who, source => $tracker; | |
374 | putaction 0, ACT_TRACK_RESULT, target => $who, source => $tracker; | |
375 | } | |
376 | ||
377 | sub watch { | |
378 | my ($watcher, $who) = @_; | |
379 | putaction 0, ACT_WATCH, target => $who, source => $watcher; | |
380 | putaction 0, ACT_WATCH_RESULT, target => $who, source => $watcher; | |
381 | } | |
382 | ||
383 | sub guard { | |
384 | my ($guard, $who) = @_; | |
385 | putaction 0, ACT_GUARD, target => $who, source => $guard; | |
386 | } | |
387 | ||
388 | sub rolecopcheck { | |
389 | my ($rolecop, $who) = @_; | |
390 | putaction 0, ACT_ROLECOP, target => $who, source => $rolecop; | |
391 | } | |
392 | ||
393 | sub copcheck { | |
394 | my ($cop, $who) = @_; | |
395 | putaction 0, ACT_COP, target => $who, source => $cop; | |
396 | } | |
397 | ||
398 | sub skill { | |
399 | my ($sk, $who, $reason, @args) = @_; | |
400 | putaction 0, ACT_KILL, target => $who, source => $sk, reason => $reason, @args; | |
401 | } | |
402 | ||
403 | sub hide { | |
404 | my ($hider, $who) = @_; | |
405 | putaction 0, ACT_HIDE, target => $who, source => $hider; | |
406 | } | |
407 | ||
408 | 1; | |
409 | __END__ | |
410 | ||
411 | =head1 NAME | |
412 | ||
413 | Mafia - easily moderate Mafia games | |
414 | ||
415 | =head1 SYNOPSIS | |
416 | ||
417 | #!/usr/bin/perl -w | |
418 | use Mafia; | |
419 | ||
420 | player 'Banana Bob', cop, town; | |
421 | player 'Dragon Phoenix', vanilla, townie; | |
422 | player 'Gammie', mafia, goon; | |
423 | player 'gslamm', vanilla, townie; | |
424 | player 'Untrod Tripod', mafia, goon; | |
425 | player 'Werebear', vanilla, townie; | |
426 | player 'willows_weep', town, doctor; | |
427 | ||
428 | day; | |
429 | lynch 'Untrod Tripod'; | |
430 | ||
431 | night; | |
432 | factionkill 'Gammie', 'willows_weep', 'shot'; | |
433 | copcheck 'Banana Bob', 'gslamm'; | |
434 | ||
435 | day; | |
436 | lynch 'Gammie'; | |
437 | ||
438 | night; | |
439 | ||
440 | =head1 DESCRPTION | |
441 | ||
442 | Mafia.pm is a Perl extension for easily moderating Mafia games. You don't even need to know Perl to use it (see L<"WHAT YOU NEED TO KNOW"> for details). | |
443 | ||
444 | =head1 WHAT YOU NEED TO KNOW | |
445 | ||
446 | A typical script starts with the following two lines | |
447 | ||
448 | #!/usr/bin/perl -w | |
449 | use Mafia; | |
450 | ||
451 | The rest of the script is a series of function calls that describe the players and their actions. | |
452 | ||
453 | A function call looks like this: | |
454 | ||
455 | function_name first_argument, second_argument, ... | |
456 | ||
457 | Each argument is either a number, a string (which is a sequence of characters between single or double quotes, such as C<'badguy'>, C<'qwrf'>) or a constant (such as C<mafia>, C<vanilla>, C<bulletproof>). | |
458 | ||
459 | Example calls: | |
460 | ||
461 | player 'Somebody', mafia, goon; # player is the function, 'Somebody' is a string, mafia and goon are constants. | |
462 | lynch 'Nobody'; # lynch is the function, 'Nobody' is a string. | |
463 | day; # day is the function. There are no arguments. | |
464 | ||
465 | =head1 FUNCTIONS | |
466 | ||
467 | =over | |
468 | ||
469 | =item B<player> I<name>, I<trait>, ... | |
470 | ||
471 | Defines a new player named I<name> and its traits (role, faction, role modifiers). | |
472 | ||
473 | Roles: C<vanilla, goon, doctor, vigilante, roleblocker, jailkeeper, gunsmith, tracker, watcher, bodyguard, rolecop, cop, sk, hider>. | |
474 | ||
475 | Factions: C<mafia, town>. C<townie> is a synonim for C<town>. | |
476 | ||
477 | Other attributes: C<miller, godfather, weak, macho, bulletproof> | |
478 | ||
479 | These traits may be specified in any order. | |
480 | ||
481 | Example usage: | |
482 | ||
483 | player 'alice', town, bulletproof, miller, vigilante; # Alice is a NK-Immune Miller Vig | |
484 | player 'bob', town, weak, doctor; # Bob is a Town Weak Doctor | |
485 | player 'eve', mafia, godfather, goon; # Eve is a Mafia Godfather | |
486 | ||
487 | =item B<day> | |
488 | ||
489 | Defines the start of a new Day. All actions in the previous Night are now resolved. | |
490 | ||
491 | =item B<night> | |
492 | ||
493 | Defines the start of a new Night. All actions in the previous Day are now resolved. | |
494 | ||
495 | =item B<lynch> I<player> | |
496 | ||
497 | Notes that I<player> was lynched. | |
498 | ||
499 | =item B<factionkill> I<killer>, I<player>, I<flavour>, [ strong => 1 ] | |
500 | ||
501 | Notes that I<killer> killed I<player> with flavour I<flavour>. Append C<< strong => 1 >> if the kill should ignore roleblocks and doctor/jailkeeper protections. Use this for mafia kills. | |
502 | ||
503 | Example usage: | |
504 | ||
505 | factionkill 'eve', 'alice', 'strangled to death'; | |
506 | factionkill 'eve', 'bob', 'brutally murdered', strong => 1; # This is a strongman kill | |
507 | ||
508 | =item B<protect> I<doctor>, I<player> | |
509 | ||
510 | Notes that I<doctor> protected I<player>. | |
511 | ||
512 | =item B<vig> I<vigilante>, I<player>, I<flavour>, [ strong => 1 ] | |
513 | ||
514 | Notes that I<killer> killed I<player> with flavour I<flavour>. Append C<< strong => 1 >> if the kill should ignore roleblocks and doctor/jailkeeper protections. Use this for Vigilante/Juggernaut kills. | |
515 | ||
516 | Example usage: | |
517 | ||
518 | vig 'chuck', 'bob', 'shot'; | |
519 | vig 'chuck', 'bob', 'shot seven times', strong => 1; # This is a Juggernaut (Strongman Vigilante) kill | |
520 | ||
521 | =item B<roleblock> I<roleblocker>, I<player> | |
522 | ||
523 | Notes that I<roleblocker> roleblocked I<player>. | |
524 | ||
525 | =item B<jailkeep> I<jailkeeper>, I<player> | |
526 | ||
527 | Notes that I<jailkeeper> roleblocked and protected I<player>. | |
528 | ||
529 | =item B<guncheck> I<gunsmith>, I<player> | |
530 | ||
531 | Notes that I<gunsmith> checked if I<player> has a gun. | |
532 | ||
533 | =item B<track> I<tracker>, I<player> | |
534 | ||
535 | Notes that I<tracker> tracked I<player>. | |
536 | ||
537 | =item B<watch> I<watcher>, I<player> | |
538 | ||
539 | Notes that I<watcher> watched I<player>. | |
540 | ||
541 | =item B<guard> I<bodyguard>, I<player> | |
542 | ||
543 | Notes that I<bodyguard> guarded I<player> | |
544 | ||
545 | =item B<rolecopcheck> I<rolecop>, I<player> | |
546 | ||
547 | Notes that I<rolecop> checked the role of I<player> | |
548 | ||
549 | =item B<copcheck> I<cop>, I<player> | |
550 | ||
551 | Notes that I<cop> checked whether I<player> is mafia. | |
552 | ||
553 | =item B<skill> I<SK>, I<player>, I<flavour>, [ strong => 1 ] | |
554 | ||
555 | Notes that I<SK> killed player with flavour I<flavour>. Append C<< strong => 1 >>> if the kill should ignore roleblocks and doctor/jailkeeper protections. Use this for Serial Killer kills. | |
556 | ||
557 | =item B<hide> I<hider>, I<player> | |
558 | ||
559 | Notes that I<hider> hid behind I<player>. | |
560 | ||
561 | =back | |
562 | ||
563 | =head1 AUTHOR | |
564 | ||
565 | Marius Gavrilescu, E<lt>marius@ieval.roE<gt> | |
566 | ||
567 | =head1 COPYRIGHT AND LICENSE | |
568 | ||
569 | Copyright (C) 2013 by Marius Gavrilescu | |
570 | ||
571 | This library is free software; you can redistribute it and/or modify | |
572 | it under the same terms as Perl itself, either Perl version 5.14.2 or, | |
573 | at your option, any later version of Perl 5 you may have available. | |
574 | ||
575 | ||
576 | =cut |