diff options
Diffstat (limited to 'frotzglue.pl')
| -rw-r--r-- | frotzglue.pl | 445 |
1 files changed, 445 insertions, 0 deletions
diff --git a/frotzglue.pl b/frotzglue.pl new file mode 100644 index 0000000..0105fe9 --- /dev/null +++ b/frotzglue.pl @@ -0,0 +1,445 @@ +# 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'); |