Jul 29, 2011

IRCダイスボットへの道 - IRCボットにローカルダイスを組み込んでみる

PerlIRCダイスボットへの道第四回は、第三回のローカルダイスを IRCボットに組み込んでみます。

ローカルダイスは、Perlモジュールの Parse::RecDescent を使ってダイスコマンド文字列をパースして無名ハッシュのリファレンスに収め、Data::Transformer を使ってそのままの状態でダイスだけ転がした後、ハッシュリファレンスから値を取り出して集計しています。ロールの乱数には Perl の標準関数 の rand ではなく、メルセンヌ・ツイスタを使った Math::Random::MT を利用しています。今回 IRCボットに組み込むに当たっては、POE::Component::IRC を使ってみました。

simpledicebot.pl

#!/usr/bin/env perl

use strict;
use warnings;
use utf8;
use Encode;
use POE;
use POE::Component::IRC::State;
use POE::Component::IRC::Plugin::AutoJoin;
use Parse::RecDescent;
use Data::Transformer;
use Math::Random::MT;

my $irc_server = 'irc.trpg.net'; # 利用する IRCサーバ
my $room       = '#ぽち小屋';    # IRC で入るチャンネル名
my $name       = 'dice_smp';     # IRC でのダイスボットの名前
my $encoding   = 'iso-2022-jp';  # 大抵これで OK、駄目な場合は utf-8 に変更

my $e = find_encoding( $encoding );

my $grammar = <<'GRAMMER';
expression: add end { { left => $item[1] } }
add: mult '+' add { { left => $item[1], op => '+', right => $item[3] } }
add: mult '-' add { { left => $item[1], op => '-', right => $item[3] } }
add: mult
mult: brack '*' mult { { left => $item[1], op => '*', right => $item[3] } }
mult: brack
brack: '(' add ')' { $item[2] }
brack: val
val: /[1-9]\d?d(?:100|30|20|12|10|8|6|4|2)/i
val: /\d{1,2}/
end: /\s*$/
GRAMMER

my $parser = Parse::RecDescent->new( $grammar ) or die 'Bad grammar';

my $seed = time ^ $$;
my $gen  = Math::Random::MT->new($seed);

POE::Session->create(
    package_states => [
        main => [ qw/ _start irc_public / ]
    ]
);

$poe_kernel->run();

sub _start {
    my $irc = POE::Component::IRC::State->spawn(
        Nick   => $name,
        Server => $irc_server,
    );

    $irc->plugin_add( 'AutoJoin', POE::Component::IRC::Plugin::AutoJoin->new(
        Channels => [ $e->encode( $room ) ]
    ));

    $irc->yield( register => 'join' );
    $irc->yield( 'connect' );
}

sub irc_public {
   my ( $sender, $who, $where, $what ) = @_[SENDER, ARG0, ARG1, ARG2];
   my $nick = ( split /!/, $who )[0];
   my $channel = $where->[0];
   my $irc = $sender->get_heap();

   if ( $what =~ /^\(?[1-9]\d?d(?:100|30|20|12|10|8|6|4|2)/i ) {
       my $result = &dice( $what );
       defined $result
           and $irc->yield( privmsg => $channel => "$nick: $result" );
   }
   return;
}

sub dice {
    my $arg = $e->decode( $_[0] );
    my @args = split /\s+/, $arg;
    my $text = shift @args;
    my $data = $parser->expression( $text ) or return;

    my $roll =  Data::Transformer->new(
        normal => sub {
                      my $val = shift;
	              if ( $$val =~ /^([1-9]\d?)d(100|30|20|12|10|8|6|4|2)$/i ) {
                          my ( $counts, $planes ) = ( $1, $2 );
                          my $dices;
                          while ( $counts ) {
	                      my $a_dice = int $gen->rand( $planes ) + 1;
                              $dices += $a_dice;
                              $counts--;
                          }
                          $$val = $dices;
                      }
                  },
    );
    $roll->traverse( $data );

    if ( !@args ) {
        return &gathering( $data->{ left } );
    }
    else {
        my $comments;
        foreach ( @args ) {
            $comments = $comments . "$_ ";
        }
        chop $comments;
        return &gathering( $data->{ left }) . ' ' . $e->encode( $comments );
    }
}

sub gathering {
    my $val = shift;
    if ( ref $val ) {
        if ( $val->{ op } =~ /\+/ ) {
            return &gathering( $val->{ left } ) + &gathering( $val->{ right } );
	}
        elsif ( $val->{ op } =~ /-/ ) {
            return &gathering( $val->{ left } ) - &gathering( $val->{ right } );
        }
        else {
            return &gathering( $val->{ left } ) * &gathering( $val->{ right } );
        }
    }
    else {
        return $val;
    }
}

コマンドライン操作の

$ ./simpledicebot.pl

で、設定した IRCサーバの設定したチャンネルに接続します。接続を終える時は、実行中に Ctrl + c で停止させるか、実行したターミナルエミュレータのウィンドウを閉じて停止させます。

同じチャンネルに接続した IRCクライアントから

>pochi< (1d8+3d6+1d100-2)*2

と発言すると、

<dice_smp> pochi: 158

のようにロールの結果を合計して返してくれます。ダイスコマンドの後に半角または全角スペースを挟むと、それ以後はダイスロールについてのコメントとして、ロール結果と一緒に再び表示されます。

>pochi< 1d100 SANチェック
<dice_smp> pochi: 75 SANチェック

とてもシンプルではありますけども、なんとかまた IRCダイスボットをでっちあげる事が出来ました。

Posted at 21:35 in perl | Comments/Trackbacks ()
Comments/Trackbacks
TrackBack ping me at
http://pochi.usamimi.info/blog/perl/dicebot.
Post a comment

writeback message: