path: root/frotzglue.pl

# convert this to a man page with:
#  pod2man --stderr -s6 -c"Irssi Scripts" -r0.1 -u frotzglue.pl

# for HTML:
#  pod2html frotzglue.pl

=pod

=head1 NAME

frotzglue.pl - run a z-code interactive fiction game within irssi, in a channel.

=head1 SYNOPSIS

/script load frotzglue.pl

=head1 DESCRIPTION

B<frotzglue.pl> is a Perl script for irssi(1) which runs a z-code game
using dfrotz(6), and allow users in an IRC channel to co-operatively
play the game.

You probably don't want to run this in your regular irssi session that
you use for normal chatting. It's basically a bot, intended to be run
with a dedicated irssi instance that uses its own separate user, or at
least a separate config dir (irssi's B<--home> option).

=head2 Gameplay

When a game is started, a list of players (IRC nicks) must be given. These
players will take turns sending a command to the game.

All output from the game is sent to the IRC channel where the game
was started. When the game is ready for input, there will be a prompt
with the current player's nick (whoever's turn it is) followed by a >
character.

Due to irssi's anti-flooding mechanism (and/or the IRC server's),
output will be slow, with pauses between lines. This means that some
games (ones that rely on timed prompts) might be unplayable.

=head2 Commands

Only public (channel) messages are accepted; there's no way to play or
control a game via private messages.

All commands are prefixed with B<.if>; any other channel text is ignored.

=head3 Admin Commands

These commands can be executed by anyone (TODO: for now; later there will be some
sort of access control).

=over 4

=item B<.if lsgames>

Show the list of supported games. These are hard-coded in the script.

TODO: store the game list as an irssi setting.

=item B<.if newgame> I<game> [I<player> I<...>]

Start a game. I<game> must be one of the supported games. Any number
of players may be given. If there are no players, a 1-player game is
started, with the only player being the user who started the game.

=item B<.if status>

Tell whether or not a game is running. If it is, show the game name, channel,
list of players, and whose turn it is.

=item B<.if endgame>

Ends any game in progress.

=back

=head3 Game Control Commands

These commands only work while a game is in progress, and can only be given
by players.

=over 4

=item B<.if skipturn>

Skip (pass) the current user's turn. Use this to avoid holding up gameplay
if someone is AFK or has gotten disconnected.

=item B<.if add> I<player> [I<player> I<...>]

Adds one or more players to the game.

=item B<.if rm> I<player> [I<player> I<...>]

Removes one or more players from the game. If there's only one player
on the list, attempts to remove him will be denied; the game must
always have at least one player.

=item B<.if ls>

List the players in the game, and tell whose turn it is. (Note: possibly this
shouldn't exist; .if status shows the same info...)

=back

=head3 Gameplay Commands

Any message beginning with B<.if> that isn't one of the recognized commands
above will be sent to the game as input. In a multi-player game, only the
player whose turn it is can send commands to the game.

Examples might be B<.if get sword> or B<.if inventory>.

To send a blank line to the game, say B<.if \n> or just B<.if> by itself.

To send one of the listed admin or control commands to the game instead of
acting on it, prefix it with B<-->. Example: B<.if -- ls> would send the
command "ls" to the game (where it would probably result in an error,
such as B<I don't know the word "ls">).

Currently, the B<save> and B<load> commands are disabled (for security
reasons). At some point, there might be a safe way to implement these.

=head1 EXAMPLES

[put an example here]

=head1 BUGS

All game text is assumed to end with a > prompt. If something the game
says doesn't end with >, there will be a 5-second timeout before the
text will appear... and the text will be printed again, next time a >
prompt is encountered. This is because of the author's inexperience
with the perl Expect module, and will likely be fixed soon.

Use of the dfrotz \ commands (list under CONFIGURATION in its man
page) is allowed, but probably shouldn't be. It's probably possible to
break the Expect stuff with some of the \ commands.

Only one game can be running at a time... not "one game per IRC
channel", just one, period. There should be a way to run separate
games in different channels.

There's a $VERBOSE variable for debugging, but it doesn't do much, and
the script has to be edited and reloaded to set/unset it.

=head1 AUTHOR

B. Watson <urchlay@slackware.uk>, AKA Urchlay on the Libera IRC network.

=cut


# Requirements:
# - irssi (of course).
# - dfrotz somewhere on $PATH.
# - Expect perl module.

# the game has a defined list of players, and on every move,
# the next player has control.
# commands are prefixed with .if:

# These commands work any time, and can be run by anyone (for now).

# .if lsgames
# - list all the games we know about.

# .if newgame <game> <player> <...>
# - start a new game.

# .if status
# - tell whether or not a game is running. if so, list filename, channels, and players.

# .if endgame
# - end any game in progress (and kill its dfrotz process).

# These commands only work while a game is in progress, and can only
# be issued by players:

# .if skipturn
# - pass the current player's turn. use if someone's AFK or disconnected.

# .if add <player>
# .if rm <player>
# .if ls
# - add/delete/list players.

# anything else beginning with .if is passed to the game as-is.
# if you *really* want to pass one of the above commands as game input,
# use e.g. ".if -- whatever".

use strict;
use vars qw($VERSION %IRSSI $VERBOSE $exp @players $cur_player %games $gameprefix $cur_game $gamechan);

use Irssi qw(signal_add);

$VERSION = '0.1';
%IRSSI = (
	authors         => 'B. Watson',
	contact         => 'urchlay@slackware.uk',
	name            => 'frotzglue',
	description     => 'Run a z-code interactive fiction game in a channel',
	license         => 'WTFPL',
);

$VERBOSE = 1; # set to 1 if needed.

use Expect;
$Expect::Log_Stdout = 0;

$gameprefix = "/usr/share/zcode/";
%games = (
	zork1 => [ "Zork I", $gameprefix . "zork1.z3" ],
	zork2 => [ "Zork II", $gameprefix . "zork2.z3" ],
	zork3 => [ "Zork III", $gameprefix . "zork3.z3" ],
	hhgg  => [ "Hitchhiker's Guide", $gameprefix . "hhgg.z3" ],
);

sub player_prompt {
	my ($server, $target) = @_;
	return unless $exp;
	$server->command("msg $target " . current_player() . ">");
}

sub end_game {
	$exp->hard_close();
	undef $exp;
	undef $cur_game;
	undef $gamechan;
	undef @players;
	undef $cur_player;
}

sub run_game {
	my ($server, $target) = @_;
	$exp->expect(10, '>');

	my $xstat = $exp->exitstatus();

	if(defined($xstat)) {
		my $normal = $xstat ? "due to error" : "normally";
		$server->command("msg $target *** game exited $normal with status $xstat.");
		end_game();
		return;
	}

##	my $err = $exp->error();
##	if($err) {
##		$server->command("msg $target *** got error $err, aborting game.");
##		end_game();
##		return;
##	}

	for(split /\n/, $exp->before()) {
		s/\r//g;
		$_ = " " unless length;
		$server->command("msg $target $_");
	}
}

sub cant_spawn {
	my ($server, $target) = @_;
	$server->command("msg $target *** game failed to execute!");
}

sub spawn_game {
	return unless $cur_game;
	my $gamepath = $games{$cur_game}[1];
	return unless $gamepath;
	$exp = Expect->new;
	if(!$exp->spawn("dfrotz", "-q", "-m", "-f", "irc", $gamepath)) {
		cant_spawn(@_);
		end_game();
		return;
	}
	run_game(@_);
	player_prompt(@_);
}

sub next_player {
	return unless @players;
	$cur_player++;
	$cur_player %= @players;
}

sub is_playing {
	return 0 unless @players;
	grep { $_ eq $_[0] } @players;
}

sub current_player {
	return 0 unless @players;
	return $players[$cur_player];
}

sub player_list {
	return "" unless @players;
	return join(", ", @players);
}

sub on_message {
	my ($server, $msg, $nick, $address, $target) = @_;
	my $mynick = $server->{nick};

	$msg = '.if \n' if $msg =~ /^\.if\s*$/;

	return unless $msg =~ s/^\.if\s+//;
	return unless length $msg;

	warn "nick='$nick', address='$address', target='$target', mynick='$mynick'" if $VERBOSE;

	(my $cmd, my @args) = split " ", $msg;
	$cmd = lc $cmd;

	warn "cmd='$cmd'" if $VERBOSE;

	# all responses start with this prefix.
	my $resp = "msg $target $nick";

	if($cmd eq 'newgame') {
		if(!@args) {
			$server->command("$resp: newgame requires at least a game name.");
			return;
		}

		my $game = shift @args;

		if(!@args) {
			#$server->command("$resp: newgame requires at least one player.");
			#return;
			push @args, $nick;
		}

		if($exp) {
			$server->command("$resp: a game of $cur_game is already in progress in $gamechan; use 'endgame' to end it.");
		} else {
			if(!$games{$game}) {
				$server->command("$resp: no such game as $game; try '.if lsgames'.");
				return;
			}
			$server->command("$resp: starting a " . @args . "-player game of $game in $target.");
			$cur_game = $game;
			@players = @args;
			$cur_player = 0;
			$gamechan = $target;
			spawn_game($server, $target);
		}
		return;
	} elsif($cmd eq 'help') {
		$server->command("$resp: Usage: .if [newgame <players>|status|endgame|lsgames|skipturn|add|ls|rm|<game command>]");
		return;
	} elsif($cmd eq 'status') {
		if($exp) {
			$server->command("$resp: game '$cur_game' is running on $gamechan, with players " . player_list() . "; " . current_player() . "'s turn.");
		} else {
			$server->command("$resp: game is NOT running.");
		}
		return;
	} elsif($cmd eq 'endgame') {
		if($exp) {
			$server->command("$resp: ending game.");
			end_game();
		} else {
			$server->command("$resp: can't end; game is NOT running.");
		}
		return;
	} elsif($cmd eq 'lsgames') {
		$server->command("$resp: I know how to play these games:");
		for(sort keys %games) {
			$server->command("$resp:   $_ ($games{$_}[0])");
		}
		return;
	}

	if(!$exp) {
		$server->command("$resp: '$cmd' not valid unless game is running.");
		return;
	}

	if($target ne $gamechan) {
		$server->command("$resp: wrong channel; game is running in $gamechan.");
		return;
	}

	if(!is_playing($nick)) {
		$server->command("$resp: $nick: you are not a player in the game.");
		return;
	}

	if($cmd eq 'skipturn') {
		$server->command("$resp: skipping " . current_player() . "'s turn.");
		next_player();
		player_prompt();
		return;
	} elsif($cmd eq 'add') {
		for(@args) {
			if(is_playing($_)) {
				$server->command("$resp: can't add $_: already playing.");
			} else {
				push @players, $_;
				$server->command("$resp: added player: $_");
			}
		}
		return;
	} elsif($cmd eq 'rm') {
		for(@args) {
			if(is_playing($_)) {
				if(@players == 1) {
					$server->command("$resp: cannot remove last player from game.");
					return;
				}
				my $p = $_;
				@players = grep { $_ ne $p } @players;
				$cur_player %= @players;
				$server->command("$resp: removed $_.");
			} else {
				$server->command("$resp: can't remove $_ (not playing).");
			}
		}
		return;
	} elsif($cmd eq 'ls') {
		$server->command("$resp: " . player_list());
		return;
	} elsif($cmd eq 'save' || $cmd eq 'load') {
		$server->command("$resp: save and load commands are disabled.");
		return;
	} else {
		if(current_player() eq $nick) {
			$msg =~ s/^\s*--\s*//;
			$server->command("$resp: sending '$msg' to game.");
			$msg = "" if $msg eq '\n';
			$exp->send($msg . "\n");
			run_game($server, $target);
			next_player();
			player_prompt($server, $target);
		} else {
			$server->command("$resp: it's not your turn; it's " . current_player() . "'s.");
			return;
		}
	}
}

signal_add('message public', 'on_message');