Jul 29, 2011
IRCダイスボットへの道 - IRCボットにローカルダイスを組み込んでみる
Perl で IRCダイスボットへの道第四回は、第三回のローカルダイスを 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
http://pochi.usamimi.info/blog/perl/dicebot.
writeback message: