Jul 27, 2011

IRCダイスボットへの道 - ダイスを転がしてみる

PerlIRCダイスボットへの道第二回は、ダイスを転がしてみます。

Perlモジュールの Parse::RecDescent を使ってダイスコマンド文字列をパースして無名ハッシュのリファレンスに収め、Data::Transformer を使ってそのままの状態でダイスだけ転がしてみました。乱数には Perl の標準関数 の rand ではなく、Math::Random::MT を使ってメルセンヌ・ツイスタを利用しています。

diceroll.pl

#!/usr/bin/env perl

use strict;
use warnings;
use Parse::RecDescent;
use Data::Transformer;
use Math::Random::MT;
use Data::Dumper;

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|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 $text = $ARGV[0];
my $result = $parser->expression( $text ) or die 'Bad text';

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

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

local $Data::Dumper::Sortkeys = 1;
my $d = Data::Dumper->new( [ $result ] );
print $d->Dump;
$ ./diceroll.pl "(1d8+3d6+1d100-2)*2"
$VAR1 = {
          'left' => {
                      'left' => {
                                  'left' => 2,
                                  'op' => '+',
                                  'right' => {
                                               'left' => 15,
                                               'op' => '+',
                                               'right' => {
                                                            'left' => 42,
                                                            'op' => '-',
                                                            'right' => '2'
                                                          }
                                             }
                                },
                      'op' => '*',
                      'right' => '2'
                    }
        };

あとはハッシュリファレンスの深い順に op の演算子で合算していけば良いんだけど、要素をスマートに取り出す方法がパッとは思いつかなくて、とりあえず無理矢理こんな感じでダイスを転がしてみました。

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

writeback message: