lib/Mafia.pm

   1 package Mafia;
   2
   3 use 5.010001;
   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.001004';
  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 +{ ## no critic (Capitalization)
  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 my %ROLE_HASH = map { $_ => 1 } @{ROLE()};
  43 my %FACTION_HASH = map { $_ => 1 } @{FACTION()};
  44 my %FLAG_HASH = map { $_ => 1 } @{FLAG()};
  45 my %INVESTIGATIVE_ACTIONS_HASH = map { $_ => 1 } @{INVESTIGATIVE_ACTIONS()};
  46 my %GUNROLES_HASH = map { $_ => 1 } @{GUNROLES()};
  47
  48 our @EXPORT = do {
  49         no strict 'refs'; ## no critic (ProhibitNoStrict)
  50         grep { $_ !~ [qw/import/] and exists &$_ } keys %{__PACKAGE__ . '::'};
  51 };
  52
  53 ################################################## Helper subs
  54
  55 sub import {
  56         strict->import;
  57         goto &Exporter::import;
  58 }
  59
  60 my (%players, %tplayers, @actions);
  61 my $daycnt = 0;
  62 my $nightcnt = 0;
  63 my $isday = 0;
  64 my $first = 1;
  65
  66 sub clean{
  67         %players = ();
  68         %tplayers = ();
  69         @actions = ();
  70         $daycnt = 0;
  71         $nightcnt = 0;
  72         $isday = 0;
  73         $first = 1;
  74 }
  75
  76 sub uniq {
  77         my %hash = map { $_ => 1 } @_;
  78         keys %hash
  79 }
  80
  81 sub phase {
  82         return "Day $daycnt" if $isday;
  83         return "Night $nightcnt" unless $isday;
  84 }
  85
  86 sub rolename { ## no critic (RequireArgUnpacking)
  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';
  92         }
  93         my @tokens = ();
  94         push @tokens, ucfirst $faction if $faction;
  95         for my $flag (@{FLAG()}) {
  96                 push @tokens, ucfirst $flag if $player{$flag}
  97         }
  98         push @tokens, ucfirst $role unless $role eq goon && $player{godfather};
  99         "@tokens"
 100 }
 101
 102 sub msg {
 103         my ($type, @args) = @_;
 104         my %msg_lut = (
 105                 MSG_NIGHT => sub {
 106                         my ($night) = @args;
 107                         say '' unless $first;
 108                         $first = 0;
 109                         say "It is Night $night";
 110                 },
 111
 112                 MSG_DAY => sub {
 113                         my ($day) = @args;
 114                         say '' unless $first;
 115                         $first = 0;
 116                         say "It is Day $day";
 117                 },
 118
 119                 MSG_PLAYERS_ALIVE => sub {
 120                         @args = sort @args;
 121                         say 'Players alive: ', join ', ', @args
 122                 },
 123
 124                 MSG_DEATH => sub {
 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";
 130                 },
 131
 132                 MSG_GUNCHECK => sub {
 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;
 137                 },
 138
 139                 MSG_NORESULT => sub {
 140                         my %args = @args;
 141                         my ($who) = $args{'source'};
 142                         say "$who: No result"
 143                 },
 144
 145                 MSG_TRACK => sub {
 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;
 152                 },
 153
 154                 MSG_WATCH => sub {
 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;
 161                 },
 162
 163                 MSG_ROLECOP => sub {
 164                         my %args = @args;
 165                         my ($rolecop, $who, $role) = @args{'source', 'target', 'result'};
 166                         say "$rolecop: $who\'s role is: $role"
 167                 },
 168
 169                 MSG_COP => sub {
 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;
 174                 },
 175         );
 176
 177         $msg_lut{$type}->();
 178 }
 179
 180 sub putaction {
 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         }
 186         push @{$actions[$delay]->{$type}}, \%args
 187 }
 188
 189 sub doaction { ## no critic (ProhibitExcessComplexity)
 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} //= [];
 197                 push @{$tplayers{$source}{targets}}, $target;
 198                 $tplayers{$target}{sources} //= [];
 199                 push @{$tplayers{$target}{sources}}, $source;
 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 %new_args = %args;
 205                                 $new_args{target} = $target;
 206                                 $new_args{hidepierce} = 1;
 207                                 doaction($type, \%new_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) )) {
 217                         msg MSG_NORESULT, %args if $INVESTIGATIVE_ACTIONS_HASH{$type};
 218                         return
 219                 }
 220         }
 221
 222         my %act_lut = (
 223                 ACT_KILL => sub {
 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
 228                                 $args{target} = shift @{$tplayers{$target}{guards}};
 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}
 238                 },
 239
 240                 ACT_LYNCH => sub {
 241                         if ($tplayers{$target}{guard_count}) {
 242                                 $tplayers{$target}{guard_count}--;
 243                                 $args{target} = shift @{$tplayers{$target}{guards}};
 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}
 252                 },
 253
 254                 ACT_PROTECT => sub {
 255                         my $count = $args{count} // 1;
 256                         $tplayers{$target}{protection} += $count unless $tplayers{$target}{macho}
 257                 },
 258
 259                 ACT_ROLEBLOCK => sub {
 260                         $tplayers{$target}{roleblocked} = 1
 261                 },
 262
 263                 ACT_GUNCHECK => sub {
 264                         my $role = $players{$target}{role};
 265                         my $hasgun = $GUNROLES_HASH{$role} || ($players{$target}{faction} eq mafia && $role ne doctor);
 266                         msg MSG_GUNCHECK, %args, result => $hasgun
 267                 },
 268
 269                 ACT_TRACK_RESULT => sub {
 270                         msg MSG_TRACK, %args, result => [ uniq @{$tplayers{$target}{targets} // []} ];
 271                 },
 272
 273                 ACT_WATCH_RESULT => sub {
 274                         msg MSG_WATCH, %args, result => [ uniq @{$tplayers{$target}{sources} // []} ];
 275                 },
 276
 277                 ACT_GUARD => sub {
 278                         $tplayers{$target}{guard_count}++;
 279                         $tplayers{$target}{guards} //= [];
 280                         push @{$tplayers{$target}{guards}}, $source;
 281                 },
 282
 283                 ACT_ROLECOP => sub {
 284                         my $result = $players{$target}{role};
 285                         $result = vanilla if $result eq goon;
 286                         msg MSG_ROLECOP, %args, result => ucfirst $result
 287                 },
 288
 289                 ACT_COP => sub {
 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
 294                 },
 295
 296                 ACT_HIDE => sub {
 297                         $tplayers{$source}{hidden} = 1;
 298                         $tplayers{$target}{hiders} //= [];
 299                         push @{$tplayers{$target}{hiders}}, $source
 300                 },
 301         );
 302
 303         $act_lut{$type}->();
 304 }
 305
 306 sub process_phase_change {
 307         %tplayers = %{dclone \%players};
 308         my $actions = shift @actions;
 309         for my $type (@{ACTION_ORDER()}) {
 310                 doaction $type, $_ for @{$actions->{$type}}
 311         }
 312 }
 313
 314 ################################################## User subs
 315
 316 sub player {
 317         my ($name, @args) = @_;
 318         my %player;
 319         for my $trait (@args) {
 320                 $player{role} = $trait    if $ROLE_HASH{$trait};
 321                 $player{faction} = $trait if $FACTION_HASH{$trait};
 322                 $player{$trait} = 1       if $FLAG_HASH{$trait};
 323         }
 324
 325         $players{$name} = \%player;
 326 }
 327
 328 sub day {
 329         process_phase_change;
 330         $isday = 1;
 331         msg MSG_DAY, ++$daycnt;
 332         msg MSG_PLAYERS_ALIVE, keys %players;
 333 }
 334
 335 sub night {
 336         process_phase_change;
 337         $isday = 0;
 338         msg MSG_NIGHT, ++$nightcnt;
 339         msg MSG_PLAYERS_ALIVE, keys %players;
 340 }
 341
 342 sub lynch {
 343         my ($who) = @_;
 344         putaction 0, ACT_LYNCH, target => $who;
 345 }
 346
 347 sub factionkill {
 348         my ($killer, $who, $reason, @args) = @_;
 349         putaction 0, ACT_KILL, target => $who, source => $killer, reason => $reason, @args;
 350 }
 351
 352 sub protect {
 353         my ($doctor, $who) = @_;
 354         putaction 0, ACT_PROTECT, target => $who, source => $doctor;
 355 }
 356
 357 sub vig {
 358         my ($vig, $who, $reason, @args) = @_;
 359         putaction 0, ACT_KILL, target => $who, source => $vig, reason => $reason, @args;
 360 }
 361
 362 sub roleblock {
 363         my ($roleblocker, $who) = @_;
 364         putaction 0, ACT_ROLEBLOCK, target => $who, source => $roleblocker;
 365 }
 366
 367 sub jailkeep {
 368         my ($jailkeeper, $who) = @_;
 369         putaction 0, ACT_ROLEBLOCK, target => $who, source => $jailkeeper;
 370         putaction 0, ACT_PROTECT, target => $who, source => $jailkeeper, count => 1000;
 371 }
 372
 373 sub guncheck {
 374         my ($gunsmith, $who) = @_;
 375         putaction 0, ACT_GUNCHECK, target => $who, source => $gunsmith;
 376 }
 377
 378 sub track {
 379         my ($tracker, $who) = @_;
 380         putaction 0, ACT_TRACK, target => $who, source => $tracker;
 381         putaction 0, ACT_TRACK_RESULT, target => $who, source => $tracker;
 382 }
 383
 384 sub watch {
 385         my ($watcher, $who) = @_;
 386         putaction 0, ACT_WATCH, target => $who, source => $watcher;
 387         putaction 0, ACT_WATCH_RESULT, target => $who, source => $watcher;
 388 }
 389
 390 sub guard {
 391         my ($guard, $who) = @_;
 392         putaction 0, ACT_GUARD, target => $who, source => $guard;
 393 }
 394
 395 sub rolecopcheck {
 396         my ($rolecop, $who) = @_;
 397         putaction 0, ACT_ROLECOP, target => $who, source => $rolecop;
 398 }
 399
 400 sub copcheck {
 401         my ($cop, $who) = @_;
 402         putaction 0, ACT_COP, target => $who, source => $cop;
 403 }
 404
 405 sub skill {
 406         my ($sk, $who, $reason, @args) = @_;
 407         putaction 0, ACT_KILL, target => $who, source => $sk, reason => $reason, @args;
 408 }
 409
 410 sub hide {
 411         my ($hider, $who) = @_;
 412         putaction 0, ACT_HIDE, target => $who, source => $hider;
 413 }
 414
 415 1;
 416 __END__
 417
 418 =encoding utf-8
 419
 420 =head1 NAME
 421
 422 Mafia - 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 DESCRIPTION
 450
 451 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).
 452
 453 =head1 WHAT YOU NEED TO KNOW
 454
 455 A typical script starts with the following two lines
 456
 457   #!/usr/bin/perl -w
 458   use Mafia;
 459
 460 The rest of the script is a series of function calls that describe the players and their actions.
 461
 462 A function call looks like this:
 463
 464   function_name first_argument, second_argument, ...
 465
 466 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>).
 467
 468 Example 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
 480 Defines a new player named I<name> and its traits (role, faction, role modifiers).
 481
 482 Roles: C<vanilla, goon, doctor, vigilante, roleblocker, jailkeeper, gunsmith, tracker, watcher, bodyguard, rolecop, cop, sk, hider>.
 483
 484 Factions: C<mafia, town>. C<townie> is a synonim for C<town>.
 485
 486 Other attributes: C<miller, godfather, weak, macho, bulletproof>
 487
 488 These traits may be specified in any order.
 489
 490 Example 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
 498 Defines the start of a new Day. All actions in the previous Night are now resolved.
 499
 500 =item B<night>
 501
 502 Defines the start of a new Night. All actions in the previous Day are now resolved.
 503
 504 =item B<lynch> I<player>
 505
 506 Notes that I<player> was lynched.
 507
 508 =item B<factionkill> I<killer>, I<player>, I<flavour>, [ strong => 1 ]
 509
 510 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.
 511
 512 Example 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
 519 Notes that I<doctor> protected I<player>.
 520
 521 =item B<vig> I<vigilante>, I<player>, I<flavour>, [ strong => 1 ]
 522
 523 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.
 524
 525 Example 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
 532 Notes that I<roleblocker> roleblocked I<player>.
 533
 534 =item B<jailkeep> I<jailkeeper>, I<player>
 535
 536 Notes that I<jailkeeper> roleblocked and protected I<player>.
 537
 538 =item B<guncheck> I<gunsmith>, I<player>
 539
 540 Notes that I<gunsmith> checked if I<player> has a gun.
 541
 542 =item B<track> I<tracker>, I<player>
 543
 544 Notes that I<tracker> tracked I<player>.
 545
 546 =item B<watch> I<watcher>, I<player>
 547
 548 Notes that I<watcher> watched I<player>.
 549
 550 =item B<guard> I<bodyguard>, I<player>
 551
 552 Notes that I<bodyguard> guarded I<player>
 553
 554 =item B<rolecopcheck> I<rolecop>, I<player>
 555
 556 Notes that I<rolecop> checked the role of I<player>
 557
 558 =item B<copcheck> I<cop>, I<player>
 559
 560 Notes that I<cop> checked whether I<player> is mafia.
 561
 562 =item B<skill> I<SK>, I<player>, I<flavour>, [ strong => 1 ]
 563
 564 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.
 565
 566 =item B<hide> I<hider>, I<player>
 567
 568 Notes that I<hider> hid behind I<player>.
 569
 570 =back
 571
 572 =head1 AUTHOR
 573
 574 Marius Gavrilescu, E<lt>marius@ieval.roE<gt>
 575
 576 =head1 COPYRIGHT AND LICENSE
 577
 578 Copyright (C) 2013-2017 by Marius Gavrilescu
 579
 580 This library is free software; you can redistribute it and/or modify
 581 it under the same terms as Perl itself, either Perl version 5.14.2 or,
 582 at your option, any later version of Perl 5 you may have available.
 583
 584
 585 =cut