Aug 01, 2011

IRCダイスボットへの道 - IRCダイスボットをもう少し実用的に

PerlIRCダイスボットへの道第五回は、第四回のシンプルな 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 @results;
    my @comments;
    my @args = split /\s+/, $e->decode( $_[0] );

    foreach ( @args ) {
        if ( my $parsed = $parser->expression( $_ ) ) {
            my $dt =  Data::Transformer->new( normal => \&roll );
            $dt->traverse( $parsed );
            push @results, &gathering( $parsed->{ left } );
        }
        elsif ( @results ) {
            push @comments, $_;
        }
        else {
            return;
        }
    }

    if ( !@comments ) {
        return join ' ', @results;
    }
    else {
        my $comment;
        foreach ( @comments ) {
            $comment = $comment . "$_ ";
        }
        chop $comment;
        return ( join ' ', @results )  . ' ' . $e->encode( $comment );
    }
}

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

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チェック

ダイスロールの内訳が必要な場合には、演算子の代わりに半角スペースを空けてダイスコマンドを発言してあげるとこんな感じになります。

>pochi< 1d8 1d6 1d10 1d100
<dice_smp> pochi: 4 3 9 45
>pochi< (1D8+3D6+1D100-2)*2 1d8+1d6+2 1D100-20
<dice_smp> pochi: 192 11 35
Posted at 22:46 in perl | Comments/Trackbacks ()
Comments/Trackbacks
TrackBack ping me at
http://pochi.usamimi.info/blog/perl/dicebot_next.
Post a comment

writeback message: