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