ぽち＊ろぐ

IRCダイスボットへの道 - ダイス目や修正値を集計してみる

Perl で IRCダイスボットへの道第三回は、ダイスの目や修正値を集計してみます。

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->{ left } ] );
print $d->Dump;

print &gathering( $result->{ left } ), "\n";

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

$ ./diceroll.pl "(1d8+3d6+1d100-2)*2"

$VAR1 = {
          'left' => {
                      'left' => 3,
                      'op' => '+',
                      'right' => {
                                   'left' => 11,
                                   'op' => '+',
                                   'right' => {
                                                'left' => 20,
                                                'op' => '-',
                                                'right' => '2'
                                              }
                                 }
                    },
          'op' => '*',
          'right' => '2'
        };
64

なんとなく強引な気はしますけども、これで一応ローカルダイスが完成した事にしてしまいます。