[mafia.git] / lib / Mafia.pm

package Mafia;

use 5.014000;
use strict;
use warnings;
no if $] > 5.017011, warnings => 'experimental::smartmatch';
use parent qw/Exporter/;

use constant;
use Storable qw/dclone/;

our $VERSION = '0.001';

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],
};

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) = @_;
	given ($type){
		when (MSG_NIGHT) {
			my ($night) = @args;
			say '' unless $first;
			$first = 0;
			say "It is Night $night";
		}

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

		when (MSG_PLAYERS_ALIVE) {
			@args = sort @args;
			say "Players alive: ", join ', ', @args
		}

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

		when (MSG_GUNCHECK) {
			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;
		}

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

		when (MSG_TRACK) {
			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;
		}

		when (MSG_WATCH) {
			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;
		}

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

		when (MSG_COP) {
			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;
		}
	}
}

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 $type ~~ INVESTIGATIVE_ACTIONS;
			return
		}
	}


	given ($type) {
		when(ACT_KILL) {
			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}
		}

		when(ACT_LYNCH){
			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}
		}

		when(ACT_PROTECT){
			my $count = $args{count} // 1;
			$tplayers{$target}{protection} += $count unless $tplayers{$target}{macho}
		}

		when(ACT_ROLEBLOCK){
			$tplayers{$target}{roleblocked} = 1
		}

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

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

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

		when(ACT_GUARD){
			$tplayers{$target}{guard_count}++;
			$tplayers{$target}{guards} //= [];
			push $tplayers{$target}{guards}, $source;
		}

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

		when(ACT_COP){
			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
		}

		when(ACT_HIDE){
			$tplayers{$source}{hidden} = 1;
			$tplayers{$target}{hiders} //= [];
			push $tplayers{$target}{hiders}, $source
		}
	}
}

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) {
		given ($trait) {
			$player{role} = $trait when ROLE;
			$player{faction} = $trait when FACTION;
			$player{$trait} = 1 when FLAG;
		}
	}

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