[mafia.git] / lib / Mafia.pm

package Mafia;

use 5.010001;
use strict;
use warnings;
use parent qw/Exporter/;

use constant;
use Storable qw/dclone/;

our $VERSION = '0.001002';

sub defconst { constant->import($_ => $_) for @_ }

BEGIN {
	# Roles
	defconst qw/vanilla goon doctor vigilante roleblocker jailkeeper gunsmith tracker watcher bodyguard rolecop cop sk hider/;

	# Factions
	defconst qw/mafia town/;

	# Extra traits
	defconst qw/miller godfather weak macho bulletproof/;

	# Messages
	defconst qw/MSG_NIGHT MSG_DAY MSG_PLAYERS_ALIVE MSG_DEATH MSG_GUNCHECK MSG_NORESULT MSG_TRACK MSG_WATCH MSG_COP MSG_ROLECOP/;

	# Action types
	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/;
}

use constant +{
	townie => town,
	ROLE => [vanilla, goon, doctor, vigilante, roleblocker, jailkeeper, gunsmith, tracker, watcher, bodyguard, rolecop, cop, sk, hider],
	FACTION => [mafia, town],
	FLAG => [miller, godfather, weak, macho, bulletproof],
	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],
	INVESTIGATIVE_ACTIONS => [ACT_GUNCHECK, ACT_TRACK, ACT_WATCH, ACT_ROLECOP, ACT_COP],
	GUNROLES => [vigilante, gunsmith],
};

my %ROLE_HASH = map { $_ => 1 } @{ROLE()};
my %FACTION_HASH = map { $_ => 1 } @{FACTION()};
my %FLAG_HASH = map { $_ => 1 } @{FLAG()};
my %INVESTIGATIVE_ACTIONS_HASH = map { $_ => 1 } @{INVESTIGATIVE_ACTIONS()};
my %GUNROLES_HASH = map { $_ => 1 } @{GUNROLES()};

our @EXPORT = do {
	no strict 'refs';
	grep { $_ !~ [qw/import/] and exists &$_ } keys %{__PACKAGE__ . '::'};
};

################################################## Helper subs

sub import {
	strict->import;
	goto &Exporter::import;
}

my (%players, %tplayers, @actions);
my $daycnt = 0;
my $nightcnt = 0;
my $isday = 0;
my $first = 1;

sub clean{
	%players = ();
	%tplayers = ();
	@actions = ();
	$daycnt = 0;
	$nightcnt = 0;
	$isday = 0;
	$first = 1;
}

sub uniq {
	my %hash = map { $_ => 1 } @_;
	keys %hash
}

sub phase {
	return "Day $daycnt" if $isday;
	return "Night $nightcnt" unless $isday;
}

sub rolename {
	my %player = %{$players{$_[0]}};
	my ($faction, $role) = ($player{faction}, $player{role});
	if (defined $faction && $faction eq town && $role eq vanilla) {
		undef $faction;
		$role = 'Vanilla Townie';
	}
	my @tokens = ();
	push @tokens, ucfirst $faction if $faction;
	for my $flag (@{FLAG()}) {
		push @tokens, ucfirst $flag if $player{$flag}
	}
	push @tokens, ucfirst $role unless $role eq goon && $player{godfather};
	"@tokens"
}

sub msg {
	my ($type, @args) = @_;
	my %msg_lut = (
		MSG_NIGHT => sub {
			my ($night) = @args;
			say '' unless $first;
			$first = 0;
			say "It is Night $night";
		},

		MSG_DAY => sub {
			my ($day) = @args;
			say '' unless $first;
			$first = 0;
			say "It is Day $day";
		},

		MSG_PLAYERS_ALIVE => sub {
			@args = sort @args;
			say "Players alive: ", join ', ', @args
		},

		MSG_DEATH => sub {
			my %args = @args;
			my ($who, $reason) = @args{'target', 'reason'};
			my $phase = phase;
			my $rolename = rolename $who;
			say "$who ($rolename) — $reason $phase";
		},

		MSG_GUNCHECK => sub {
			my %args = @args;
			my ($gunsmith, $who, $hasgun) = @args{'source', 'target', 'result'};
			say "$gunsmith: $who has a gun" if $hasgun;
			say "$gunsmith: $who does not have a gun" unless $hasgun;
		},

		MSG_NORESULT => sub {
			my %args = @args;
			my ($who) = $args{'source'};
			say "$who: No result"
		},

		MSG_TRACK => sub {
			my %args = @args;
			my ($tracker, $who, $result) = @args{'source', 'target', 'result'};
			my @result = @{$result};
			local $, = ', ';
			say "$tracker: $who did not visit anyone" unless scalar @result;
			say "$tracker: $who visited: @result" if scalar @result;
		},

		MSG_WATCH => sub {
			my %args = @args;
			my ($watcher, $who, $result) = @args{'source', 'target', 'result'};
			my @result = @{$result};
			local $, = ', ';
			say "$watcher: $who was not visited by anyone" unless scalar @result;
			say "$watcher: $who was visited by: @result" if scalar @result;
		},

		MSG_ROLECOP => sub {
			my %args = @args;
			my ($rolecop, $who, $role) = @args{'source', 'target', 'result'};
			say "$rolecop: $who\'s role is: $role"
		},

		MSG_COP => sub {
			my %args = @args;
			my ($cop, $who, $ismafia) = @args{'source', 'target', 'result'};
			say "$cop: $who is mafia" if $ismafia;
			say "$cop: $who is not mafia" unless $ismafia;
		},
	);

	$msg_lut{$type}->();
}

sub putaction {
	my ($delay,  $type, %args) = @_;
	$actions[$delay]->{$type} //= [];
	if (exists $args{target} && exists $args{source} && $players{$args{target}}{faction} eq mafia && $players{$args{source}}{weak}) {
		putaction($delay, ACT_KILL, target => $args{source}, reason => 'targeted scum');
	}
	push @{$actions[$delay]->{$type}}, \%args
}

sub doaction {
	my ($type, $args) = @_;
	my %args = %$args;
	my $source = $args{source};
	my $target = $args{target};
	if (defined $source && defined $target) {
		# Watcher and tracker variables
		$tplayers{$source}{targets} //= [];
		push @{$tplayers{$source}{targets}}, $target;
		$tplayers{$target}{sources} //= [];
		push @{$tplayers{$target}{sources}}, $source;

		# Copy this action to everybody hiding behind $target
		if (exists $tplayers{$target}{hiders}) {
			for my $target (@{$tplayers{$target}{hiders}}) {
				my %args = %args;
				$args{target} = $target;
				$args{hidepierce} = 1;
				doaction($type, \%args);
			}
		}

		# Check if the action should be blocked
		my $strongkill = $type eq ACT_KILL && $args{strong};
		my $roleblocked = $tplayers{$source}{roleblocked};
		my $hidden = $tplayers{$target}{hidden};
		my $hidepierce = $args{hidepierce};
		if ($source && (( $roleblocked && !$strongkill ) || ($hidden && !$hidepierce) )) {
			msg MSG_NORESULT, %args if $INVESTIGATIVE_ACTIONS_HASH{$type};
			return
		}
	}

	my %act_lut = (
		ACT_KILL => sub {
			break if $tplayers{$target}{bulletproof} && defined $source;
			if ($tplayers{$target}{guard_count} && defined $source) {
				$tplayers{$target}{guard_count}--;
				# Copy this action to the first guard
				$args{target} = shift @{$tplayers{$target}{guards}};
				@_ = ($type, %args);
				goto &doaction;
			}
			if ($tplayers{$target}{protection} && !$args{strong}) {
				$tplayers{$target}{protection}--;
				break
			}
			msg MSG_DEATH, %args;
			delete $players{$target}
		},

		ACT_LYNCH => sub {
			if ($tplayers{$target}{guard_count}) {
				$tplayers{$target}{guard_count}--;
				$args{target} = shift @{$tplayers{$target}{guards}};
				$target=$args{target};
			}
			if ($tplayers{$target}{protection}) {
				$tplayers{$target}{protection}--;
				break
			}
			msg MSG_DEATH, %args, reason => 'lynched';
			delete $players{$target}
		},

		ACT_PROTECT => sub {
			my $count = $args{count} // 1;
			$tplayers{$target}{protection} += $count unless $tplayers{$target}{macho}
		},

		ACT_ROLEBLOCK => sub {
			$tplayers{$target}{roleblocked} = 1
		},

		ACT_GUNCHECK => sub {
			my $role = $players{$target}{role};
			my $hasgun = $GUNROLES_HASH{$role} || ($players{$target}{faction} eq mafia && $role ne doctor);
			msg MSG_GUNCHECK, %args, result => $hasgun
		},

		ACT_TRACK_RESULT => sub {
			msg MSG_TRACK, %args, result => [ uniq @{$tplayers{$target}{targets} // []} ];
		},

		ACT_WATCH_RESULT => sub {
			msg MSG_WATCH, %args, result => [ uniq @{$tplayers{$target}{sources} // []} ];
		},

		ACT_GUARD => sub {
			$tplayers{$target}{guard_count}++;
			$tplayers{$target}{guards} //= [];
			push @{$tplayers{$target}{guards}}, $source;
		},

		ACT_ROLECOP => sub {
			my $result = $players{$target}{role};
			$result = vanilla if $result eq goon;
			msg MSG_ROLECOP, %args, result => ucfirst $result
		},

		ACT_COP => sub {
			my $result = $players{$target}{faction} eq mafia;
			$result = 1 if $players{$target}{miller};
			$result = 0 if $players{$target}{godfather};
			msg MSG_COP, %args, result => $result
		},

		ACT_HIDE => sub {
			$tplayers{$source}{hidden} = 1;
			$tplayers{$target}{hiders} //= [];
			push @{$tplayers{$target}{hiders}}, $source
		},
	);

	$act_lut{$type}->();
}

sub process_phase_change {
	%tplayers = %{dclone \%players};
	my $actions = shift @actions;
	for my $type (@{ACTION_ORDER()}) {
		doaction $type, $_ for @{$actions->{$type}}
	}
}

################################################## User subs

sub player {
	my ($name, @args) = @_;
	my %player;
	for my $trait (@args) {
		$player{role} = $trait    if $ROLE_HASH{$trait};
		$player{faction} = $trait if $FACTION_HASH{$trait};
		$player{$trait} = 1       if $FLAG_HASH{$trait};
	}

	$players{$name} = \%player;
}

sub day {
	process_phase_change;
	$isday = 1;
	msg MSG_DAY, ++$daycnt;
	msg MSG_PLAYERS_ALIVE, keys %players;
}

sub night {
	process_phase_change;
	$isday = 0;
	msg MSG_NIGHT, ++$nightcnt;
	msg MSG_PLAYERS_ALIVE, keys %players;
}

sub lynch {
	my ($who) = @_;
	putaction 0, ACT_LYNCH, target => $who;
}

sub factionkill {
	my ($killer, $who, $reason, @args) = @_;
	putaction 0, ACT_KILL, target => $who, source => $killer, reason => $reason, @args;
}

sub protect {
	my ($doctor, $who) = @_;
	putaction 0, ACT_PROTECT, target => $who, source => $doctor;
}

sub vig {
	my ($vig, $who, $reason, @args) = @_;
	putaction 0, ACT_KILL, target => $who, source => $vig, reason => $reason, @args;
}

sub roleblock {
	my ($roleblocker, $who) = @_;
	putaction 0, ACT_ROLEBLOCK, target => $who, source => $roleblocker;
}

sub jailkeep {
	my ($jailkeeper, $who) = @_;
	putaction 0, ACT_ROLEBLOCK, target => $who, source => $jailkeeper;
	putaction 0, ACT_PROTECT, target => $who, source => $jailkeeper, count => 1000;
}

sub guncheck {
	my ($gunsmith, $who) = @_;
	putaction 0, ACT_GUNCHECK, target => $who, source => $gunsmith;
}

sub track {
	my ($tracker, $who) = @_;
	putaction 0, ACT_TRACK, target => $who, source => $tracker;
	putaction 0, ACT_TRACK_RESULT, target => $who, source => $tracker;
}

sub watch {
	my ($watcher, $who) = @_;
	putaction 0, ACT_WATCH, target => $who, source => $watcher;
	putaction 0, ACT_WATCH_RESULT, target => $who, source => $watcher;
}

sub guard {
	my ($guard, $who) = @_;
	putaction 0, ACT_GUARD, target => $who, source => $guard;
}

sub rolecopcheck {
	my ($rolecop, $who) = @_;
	putaction 0, ACT_ROLECOP, target => $who, source => $rolecop;
}

sub copcheck {
	my ($cop, $who) = @_;
	putaction 0, ACT_COP, target => $who, source => $cop;
}

sub skill {
	my ($sk, $who, $reason, @args) = @_;
	putaction 0, ACT_KILL, target => $who, source => $sk, reason => $reason, @args;
}

sub hide {
	my ($hider, $who) = @_;
	putaction 0, ACT_HIDE, target => $who, source => $hider;
}

1;
__END__

=encoding utf-8

=head1 NAME

Mafia - easily moderate Mafia games

=head1 SYNOPSIS

  #!/usr/bin/perl -w
  use Mafia;

  player 'Banana Bob', cop, town;
  player 'Dragon Phoenix', vanilla, townie;
  player 'Gammie', mafia, goon;
  player 'gslamm', vanilla, townie;
  player 'Untrod Tripod', mafia, goon;
  player 'Werebear', vanilla, townie;
  player 'willows_weep', town, doctor;

  day;
  lynch 'Untrod Tripod';

  night;
  factionkill 'Gammie', 'willows_weep', 'shot';
  copcheck 'Banana Bob', 'gslamm';

  day;
  lynch 'Gammie';

  night;

=head1 DESCRPTION

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).

=head1 WHAT YOU NEED TO KNOW

A typical script starts with the following two lines

  #!/usr/bin/perl -w
  use Mafia;

The rest of the script is a series of function calls that describe the players and their actions.

A function call looks like this:

  function_name first_argument, second_argument, ...

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>).

Example calls:

  player 'Somebody', mafia, goon; # player is the function, 'Somebody' is a string, mafia and goon are constants.
  lynch 'Nobody'; # lynch is the function, 'Nobody' is a string.
  day; # day is the function. There are no arguments.

=head1 FUNCTIONS

=over

=item B<player> I<name>, I<trait>, ...

Defines a new player named I<name> and its traits (role, faction, role modifiers).

Roles: C<vanilla, goon, doctor, vigilante, roleblocker, jailkeeper, gunsmith, tracker, watcher, bodyguard, rolecop, cop, sk, hider>.

Factions: C<mafia, town>. C<townie> is a synonim for C<town>.

Other attributes: C<miller, godfather, weak, macho, bulletproof>

These traits may be specified in any order.

Example usage:

  player 'alice', town, bulletproof, miller, vigilante; # Alice is a NK-Immune Miller Vig
  player 'bob', town, weak, doctor; # Bob is a Town Weak Doctor
  player 'eve', mafia, godfather, goon; # Eve is a Mafia Godfather

=item B<day>

Defines the start of a new Day. All actions in the previous Night are now resolved.

=item B<night>

Defines the start of a new Night. All actions in the previous Day are now resolved.

=item B<lynch> I<player>

Notes that I<player> was lynched.

=item B<factionkill> I<killer>, I<player>, I<flavour>, [ strong => 1 ]

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.

Example usage:

  factionkill 'eve', 'alice', 'strangled to death';
  factionkill 'eve', 'bob', 'brutally murdered', strong => 1; # This is a strongman kill

=item B<protect> I<doctor>, I<player>

Notes that I<doctor> protected I<player>.

=item B<vig> I<vigilante>, I<player>, I<flavour>, [ strong => 1 ]

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.

Example usage:

  vig 'chuck', 'bob', 'shot';
  vig 'chuck', 'bob', 'shot seven times', strong => 1; # This is a Juggernaut (Strongman Vigilante) kill

=item B<roleblock> I<roleblocker>, I<player>

Notes that I<roleblocker> roleblocked I<player>.

=item B<jailkeep> I<jailkeeper>, I<player>

Notes that I<jailkeeper> roleblocked and protected I<player>.

=item B<guncheck> I<gunsmith>, I<player>

Notes that I<gunsmith> checked if I<player> has a gun.

=item B<track> I<tracker>, I<player>

Notes that I<tracker> tracked I<player>.

=item B<watch> I<watcher>, I<player>

Notes that I<watcher> watched I<player>.

=item B<guard> I<bodyguard>, I<player>

Notes that I<bodyguard> guarded I<player>

=item B<rolecopcheck> I<rolecop>, I<player>

Notes that I<rolecop> checked the role of I<player>

=item B<copcheck> I<cop>, I<player>

Notes that I<cop> checked whether I<player> is mafia.

=item B<skill> I<SK>, I<player>, I<flavour>, [ strong => 1 ]

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.

=item B<hide> I<hider>, I<player>

Notes that I<hider> hid behind I<player>.

=back

=head1 AUTHOR

Marius Gavrilescu, E<lt>marius@ieval.roE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2013-2015 by Marius Gavrilescu

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.14.2 or,
at your option, any later version of Perl 5 you may have available.


=cut
Commit	Line	Data
	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.001002';
	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	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';
	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 {
	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 {
	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 %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) )) {
	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 DESCRPTION
	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-2015 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