Nov 13, 2011
IRCダイスボットへの道 - POE から AnyEvent へ
Perl で IRCダイスボットへの道第六回は、第四回・第五回と IRCサーバに接続するのに使っていた POE::Component::IRC を AnyEvent::IRC に置き換えます。
今回 POE::Component::IRC から AnyEvent::IRC に置き換えるのは、どどんとふにも使われている IRCダイスボットボーンズ＆カーズを書かれた Facelessさんに、「POE はあんまり信用出来なくて……」と言われたから、なんてわけでもありません。
実は Perl界隈では POE は以前から、妙にこんがらがり過ぎてコードが難読化してウザイとか、独特の書き方をしないといけないのがウザイとか、評判が良くありませんでした。POE は Perl Obfuscation Engine や Portal Of Evil の略だなんて言われたりもしています。ぽちがずっと前に最初の IRCダイスボットを書いた時に POE::Component::IRC を使ったのは、その時の選択肢には Net::IRC か POE::Component::IRC ぐらいしか見当たらず、Net::IRC を使った IRCダイスボットは既に書いている方がいたから、というごくごく単純な理由からでした。
今はそんな二択じゃないし、今書くのなら評判良さげなのを使っちゃえば良いじゃない！！
というわけで、なんとなく評判の良さげな気がする AnyEvent::IRC に置き換えちゃいます。
simpledicebot.pl
2012年 5月31日追記：irc.cre.jp系IRCサーバ群の文字コードが ISO-2022-JP から UTF-8 に変更された為、初期設定例の接続先IRCサーバの文字コードを UTF-8 に変更しました。
2012年 6月 6日追記：ダイスコマンドの引き数の個数に制限を加えました。
#!/usr/bin/env perl
use strict;
use warnings;
use utf8;
use Encode;
use AnyEvent;
use AnyEvent::IRC::Client;
use Parse::RecDescent;
use Data::Transformer;
use Math::Random::MT;
my $irc_server = 'localhost'; # 接続先IRCサーバ
my $room = '#犬小屋'; # 接続先チャンネル
my $name = 'dice_smpl'; # IRCサーバでのダイスボット名
my $encoding = 'utf8'; # 接続先IRCサーバの文字コード
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(?:120|100|60|30|24|20|16|12|10|8|6|4|3|2)/i
val: /\d{1,2}/
end: /\s*$/
GRAMMER
my $parser = Parse::RecDescent->new( $grammar ) or die 'Bad grammar';
my $seed = time ^ ( $$ + ( $$ << 15 ) );
my $gen = Math::Random::MT->new( $seed );
my $c = AnyEvent->condvar;
my $irc = AnyEvent::IRC::Client->new;
$irc->reg_cb(
irc_privmsg => sub {
my ($self, $msg) = @_;
if ( $msg->{ params }->[-1] =~ /^\(?[1-9]\d?d(?:120|100|60|30|24|20|16|12|10|8|6|4|3|2)/i ) {
my $result = dice( $msg->{ params }->[-1] );
$msg->{ prefix } =~/^(.*)!/;
defined $result
and $irc->send_chan( $e->encode( $room ), 'PRIVMSG', $e->encode( $room ), "$1: $result" );
}
}
);
$irc->reg_cb (
connect => sub {
my ( $irc, $err ) = @_;
defined $err and print "Couldn't connect to server: $err\n";
},
registered => sub {
my ( $self ) = @_;
print "registered\n";
$irc->enable_ping( 60 );
},
disconnect => sub {
print "disconnected: $_[1]\n";
}
);
$irc->send_srv( 'JOIN', $e->encode( $room ) );
$irc->connect(
$irc_server,
6667,
{ nick => $name, user => $name, real => $name },
);
$c->wait;
sub dice {
my @results;
my @comments;
my @args = split /\s+/, $e->decode( $_[0] );
scalar( @args ) > 15 and return;
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(120|100|60|30|24|20|16|12|10|8|6|4|3|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サーバの設定したチャンネルに接続します。接続先IRCサーバや接続先チャンネル、IRCサーバでのダイスボット名は適切に書き換えて使って下さい。接続を終える時は、実行中に Ctrl + c で停止させるか、実行したターミナルエミュレータのウィンドウを閉じて停止させます。
同じチャンネルに接続した IRCクライアントから
>pochi< (1d8+3d6+1d100-2)*2
と発言すると、
<dice_smpl> pochi: 158
のようにロールの結果を合計して返してくれます。ダイスコマンドの後に半角または全角スペースを挟むと、それ以後はダイスロールについてのコメントとして、ロール結果と一緒に再び表示されます。
>pochi< 1d100 SANチェック <dice_smpl> pochi: 75 SANチェック
ダイスロールの内訳が必要な場合には、演算子の代わりに半角スペースを空けてダイスコマンドを発言してあげるとこんな感じになります。
>pochi< 1d8 1d6 1d10 1d100 <dice_smpl> pochi: 4 3 9 45
>pochi< (1D8+3D6+1D100-2)*2 1d8+1d6+2 1D100-20 <dice_smpl> pochi: 192 11 35
Oct 27, 2011
Windows の Perl でテキストファイルの文字コードを変換
2011年11月12日追記：ぽち＊ぷ〜ちのいさましいちびのツールたち unzip.pl untar.pl enc.pl に enc.pl についてもう少しだけ詳しく書きました。
父の Vista機に Strawberry Perl をインストールして Windows上で Perl を使っていると、ぽちの Linux機で書いた日本語のテキストファイルを読みたい場合があったりします。けれども、それぞれのファイルシステムで使われている日本語文字コードが異なると、文字コードを変換しないままでは文字化けしてしまう事があります。高機能なテキストエディタがインストールしてあれば、わざわざ文字コードを変換したりしなくても読めるのですが、父の Vista機にはテキストエディタはメモ帳しか入っていません。メモ帳は Windows で使われている CP932以外にも UTF-8 ならそのまま表示出来るのですけども、日本語のメールで使われている ISO-2022-JP や、古いUNIX/Linux で使われている EUC-JP は文字コードを変換しないと読めません。
ものぐさなぽちは、文字コードや改行コードを自分で指定するのがめんどくさいので、unzip.pl や untar.pl の文字コード自動推測部分を流用して、こんなのを書いて楽をしています。
enc.pl
#!/usr/bin/env perl
use strict;
use warnings;
use utf8;
use Encode;
use Encode::UTF8Mac; # utf-8-mac は fオプションと tオプションでしか使えません。
use Encode::Guess qw/ euc-jp cp932 iso-2022-jp utf8 /; # 自動推測の対象
use Encode::Locale;
use Path::Class;
use Getopt::Std;
my %opts;
getopts('f:t:', \%opts);
@ARGV or die "Usage: enc.pl [-f encoding_name] [-t encoding_name] text_file\n";
foreach ( @ARGV ) {
my $file = file $_;
my $reader = $file->openr or die "Couldn't open $file for reading: $!\n";
my $content = $file->slurp;
$reader->close;
rename $file, "$file.bak";
my ( $from, $to );
if ( $opts{ f } ) {
$from = $opts{ f };
} else {
my $f_obj = Encode::Guess->guess( $content );
ref $f_obj ? $from = $f_obj->name : die "Couldn't guess: $f_obj\n";
}
if ( $opts{ t } ) {
$to = $opts{ t };
} else { $to = 'locale_fs'; }
$content = encode( $to, decode( $from, $content ) );
$from =~ /cp932|iso-2022-jp/ and $content =~ s/\r\n/\n/g;
$to =~ /cp932|iso-2022-jp/ and $content =~ s/\n/\r\n/g;
my $writer = $file->openw or die "Couldn't open $file for writing: $!\n";
$writer->print( $content );
$writer->close;
}
exit;
C¥> perl enc.pl [-f エンコード名] [-t エンコード名] テキストファイル
基本的には fオプションや tオプションも無くても適切に変換します。変換前の文字コードの推測に失敗してエラーが出た時には fオプションで、変換後の文字コードをファイルシステムのロケールにしたくない場合には tオプションで文字コードを指定して下さい。
一応、Mac で使われてる UTF-8-MAC も扱えますけども、UTF-8 と UTF-8-MAC の判別が難しいので、自動推測の候補には入れていません。UTF-8-MAC を扱う場合にはオプションで指定して下さい。
Oct 22, 2011
Strawberry Perl 5.12.3.0 をインストール
2011年11月12日追記：ぽち＊ぷ〜ちのいさましいちびのツールたち unzip.pl untar.pl enc.pl に untar.pl についてもう少しだけ詳しく書きました。
Windows上で使う Perl に疎いぽちは、Perl で書いたコードを Windows上で実行可能な単独の exeファイルに纏める PAR、PAR::Packer というモジュールがある事を最近知りました。これらのモジュールは何も Windows の exe形式だけに限らず単独の実行形式ファイルを作るのに使えるのですけども、Windows上で Perl のコードから単独で実行可能な exeファイルを作るのは、Perl をインストールさせる事なく、Perl で書いたものを気軽に「これ使ってね♪」と渡せるという点ではとっても便利そうな気がします。
そこでぽちは、父が年賀状作成と孫たちの動画の保管や写真のプリントにしか使っていない、インターネット回線にさえ繋げる気が無い Windows Vista機に Strawberry Perl 5.12.3.0 を入れる許可を得て、インストールしてみました。Strawberry Perl自体は msi に纏められているので、オフラインでもぽちの Linux機でダウンロードしたものを持って来て簡単にインストール出来るのですけども、追加でインストールしたいモジュールは CPAN Search で個別に探してダウンロードして、それぞれ CPAN Dependencies で依存関係を確認しながら、必要なものから順序良く手動で入れるという作業をする事になってしまいました。
父の Vista機を回線に繋げられれば、わざわざこんな作業をしなくても cpanm なり、cpanm -f なりで済んでしまうんですけど、自分の PC じゃ無い以上「回線には繋げるな」という父の意向を無視するわけにはいきません。今時、私用の PC をスタンドアローンで使うなんていうセキュリティ確保の方法は現実的じゃない気がしますが…ぽちが言っても耳を貸してくれませんでした。
Vista機は数年前の購入時のままの状態で、Perlモジュールの圧縮形式、tar.gzファイルを展開するツールなんて入っていません。そこで入れたばっかりの Perl を利用してコマンドプロンプトから
C¥> perl -MArchive::Extract -e "$ae = Archive::Extract->new(archive => q/Path-Class-0.24.tar.gz/); $ae->extract;"
こんなふうにワンライナーで展開してみました。
これで充分用は足りるんですけども、ついでなのでぽちの unzip.pl を Archive::Tar で書き換えてこんな感じにしてみました。
untar.pl
#!/usr/bin/env perl
use strict;
use warnings;
use Archive::Tar;
use utf8;
use Encode;
use Encode::UTF8Mac; # utf-8-mac は fオプションでしか使えません。
use Encode::Guess qw/ euc-jp cp932 iso-2022-jp utf8 /; # 自動推測の対象
use Encode::Locale;
use Path::Class;
use Getopt::Std;
my %opts;
getopts('f:', \%opts);
@ARGV or die "Usage: untar.pl [-f encoding_name] tar_file\n";
foreach ( @ARGV ) {
my $file = file $_;
my $tar = Archive::Tar->new();
$tar->read( "$file" ) or die "Couldn't read: $file\n";
my $str;
$str .= $_ foreach ( $tar->list_files );
my $enc_name;
if ( $opts{ f } ) {
$enc_name = $opts{ f };
} else {
my $enc = Encode::Guess->guess( $str );
ref $enc ? $enc_name = $enc->name : die "Couldn't guess: $enc\n";
}
foreach ( $tar->list_files ) {
my $file = file( encode( 'locale_fs', decode( $enc_name, $_ ) ) );
my $dir = $file->parent;
-d $dir or dir( $dir )->mkpath;
print "extract $file ...";
$tar->extract_file( $_, "$file" );
print "done.\n";
}
}
exit;
見ての通り対象となるファイルのアーカイブ・圧縮形式が違うだけで、使い方は unzip.pl と同じです。
C¥> perl untar.pl [-f エンコード名] tarファイル
追加したモジュールですけども、文字コードが cp932 の日本語版Windows上で Encode::Locale のテストの t/env.t が通らないのは有名みたいですね。
- Bug #69256 for Encode-Locale: env.t fails on Win32
- [perl #89904] Build test FAIL on t/env.t of Encode-Locale-1.02
調べたらこんな感じだった。
env.t
> Encode::Locale::reinit("cp1252");
Windowsではコードページの変更が出来ない
> $ENV{"m\xf6ney"} = "\x80uro";
・コードページ"cp932"(日本標準)ではこの設定ができない
・なぜかPerlが落ちる
・コードページが元から"cp1252"(西欧標準)の場合は上手く行く
英語版のWindowsだと問題を把握できないかも。
とりあえずテストの失敗を無視して入れてもきちんと動いているようです。
Oct 19, 2011
Perl で unzip.pl
2011年11月12日追記：ぽち＊ぷ〜ちのいさましいちびのツールたち unzip.pl untar.pl enc.pl に unzip.pl についてもう少しだけ詳しく書きました。
UNIX/Linux で zipファイルの展開に使われる unzip という有名な展開ツールがありますが、ファイルシステムのロケールに設定された文字コードが異なる環境で作成された zipファイルで、日本語ファイル名が含まれているものを展開すると、ファイル名が文字化けしてしまいます。C で書かれた unzip のソースコードに、マルチバイト文字のファイル名に対応するパッチを当てれば文字化けしないようになるのですけども、Perl大好きなぽちはずっと以前から、狐の王国の Suganoさんが書かれた unzip.pl をもとに、ぽちが使い易いようにちまちま改造を加えたものを zipファイルの展開に使っています。最近のぽちの unzip.pl はこんな感じです。
unzip.pl
#!/usr/bin/env perl
use strict;
use warnings;
use Archive::Zip qw/ :ERROR_CODES /;
use utf8;
use Encode;
use Encode::UTF8Mac; # utf-8-mac は fオプションでしか使えません。
use Encode::Guess qw/ euc-jp cp932 iso-2022-jp utf8 /; # 自動推測の対象
use Encode::Locale;
use Path::Class;
use Getopt::Std;
my %opts;
getopts('f:', \%opts);
@ARGV or die "Usage: unzip.pl [-f encoding_name] zip_file\n";
foreach ( @ARGV ) {
my $file = file $_;
my $zip = Archive::Zip->new();
$zip->read( "$file" ) == AZ_OK or die "Couldn't read: $file\n";
my $str;
$str .= $_->fileName foreach ( $zip->members );
my $enc_name;
if ( $opts{ f } ) {
$enc_name = $opts{ f };
} else {
my $enc = Encode::Guess->guess( $str );
ref $enc ? $enc_name = $enc->name : die "Couldn't guess: $enc\n";
}
foreach ( $zip->members ) {
my $file = file( encode( 'locale_fs', decode( $enc_name, $_->fileName ) ) );
my $dir = $file->parent;
-d $dir or dir( $dir )->mkpath;
print "extract $file ...";
$zip->extractMember( $_->fileName, "$file" );
print "done.\n";
}
}
exit;
使い方は、
$ ./unzip.pl [-f エンコード名] zipファイル
基本的に fオプションは必要なく、zipファイルの中のファイル名からエンコードされている文字コードを推測して、そのファイル名をファイルシステムのロケールに合わせて変換してから展開してくれます。たまに推測に失敗する時もありますが、そんな時はエラーメッセージを見て fオプションで適切な文字コードを指定してあげます。
今 Archive::Zip の POD を読んでみたら、「展開するだけなら Archive::Zip じゃなくて Archive::Extract を使ってね？」なんて書いてありますね。けど Archive::Extractって一度展開した後でないと内容物のファイル名を取得出来ないんで、文字コードの変換をするにはちょっと不便なんですよねえ。
Aug 01, 2011
IRCダイスボットへの道 - IRCダイスボットをもう少し実用的に
Perl で IRCダイスボットへの道第五回は、第四回のシンプルな 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
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ダイスボットをでっちあげる事が出来ました。
Jul 28, 2011
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
なんとなく強引な気はしますけども、これで一応ローカルダイスが完成した事にしてしまいます。
Jul 27, 2011
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 ] );
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 の演算子で合算していけば良いんだけど、要素をスマートに取り出す方法がパッとは思いつかなくて、とりあえず無理矢理こんな感じでダイスを転がしてみました。
Jul 26, 2011
IRCダイスボットへの道 - ダイスコマンドをパースする
Perl をはじめたての頃に IRCダイスボットを書いていたのですけども、その後の HDDクラッシュで影も形も無くなってしまいました。既にボーンズ＆カーズという高機能な IRCダイスボットが公開されている事だし、一から作り直すのも面倒でそのまま放置していたのですけども、最近なんとなく自分専用にシンプルな IRCダイスボットを作ってみたくなりました。
- ダイスコマンド文字列のパーサを書く
- パーサ組み込んだローカルダイスツールを作る
- ローカルダイスツールを IRCボットに組み込む
という手順で作ってみる予定です。
Perlモジュールの Parse::RecDescent を使ってダイスコマンド文字列のパーサを書くとこんな感じになります。
diceparser.pl
#!/usr/bin/env perl
use strict;
use warnings;
use Parse::RecDescent;
use Data::Dumper;
my $grammar = <<'GRAMMER';
expression: add end { $item[1] }
add: val '+' add { { left => $item[1], op => '+', right => $item[3] } }
add: val '-' add { { left => $item[1], op => '-', right => $item[3] } }
add: 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';
local $Data::Dumper::Sortkeys = 1;
my $d = Data::Dumper->new( [ $result ] );
print $d->Dump;
$ ./diceparser.pl 1d8+1d6+1d100-2
$VAR1 = {
'left' => '1d8',
'op' => '+',
'right' => {
'left' => '1d6',
'op' => '+',
'right' => {
'left' => '1d100',
'op' => '-',
'right' => '2'
}
}
};
と、それぞれのダイスと修正値、演算子が無名ハッシュへのリファレンスに収まります。便利べんり！次回はこれを取り出してダイスをロールし結果を表示するローカルダイスツールを作ってみようと思います。
Jul 24, 2011
さよならアナロ熊
今日の正午に地上波アナログ放送が停止しました。
NHK総合を地上波アナログで観ていたのですけども、停止寸前に最後に手を振ったどーもくんがアナロ熊に見えて仕方がありませんでした。
単純なぽちは、やっぱり感傷的になってしまいます。
Jul 09, 2011
りゅうたまでゲームマスターをする？
ぽちはたまにりゅうたまという TRPG をプレイヤーとして遊んでいるのですけども、今回オンラインセッションで GM をやろうと決心して、セッションの狂言回し的なりゅうたまの独特の GM専用キャラ「竜人」を作ってみました。
黒竜：タイヴァ
化身：梟
外見：漆黒の瞳と髪の子供
性格：わがままでいたずら好き、子供特有の無邪気な残酷さも
使命：旅人が知恵を振り絞って困難を切り抜ける物語を紡ぐ
居住界：漆黒の森に沈む黒檀の東屋
レベル：1 ライフポイント：3
アーティファクト：
短剣（セッション中一度だけ NPC一人を無条件で死亡させる事が出来る）
銘：『背後の一突き』
作った竜人の傾向から分かるかもしれませんけども、ありがちなハック＆スラッシュではないシナリオを作って行きたいな、なんて野望に燃えています。
GM経験なんてほとんど無いのにイキナリ高望みして大丈夫、ぽち？
Jul 07, 2011
ぽちたて 0.1.7 をリリースしました
今夜は七夕なのにぽち地元は天気が悪く、天の川は見えそうになくてちょっと残念ですけども、ぽちたて 0.1.7 をリリースしました。
昨日、CLI の twitterクライアントを書いていて、ぽちたてではホームディレクトリを取得するのに環境変数を直接使っていた事に気がつきました。これでは Windows環境だと、環境変数を改めて自分で設定するひと手間が必要になり、そのままぽちたてを動かす事は出来ません。そこで 0.1.7 では、File::HomeDir を使ってもっとポータビリティに配慮してみました。UNIX/Linux環境でぽちたてを使われている場合には、0.1.6 のままでも実用上全く問題ありませんけども、0.1.7 の方がほんの少しだけお行儀が良いかもしれません。
Jul 06, 2011
Net::Twitter::Lite で tweetするよ
twitter を始めた勢いに任せて、
を参考にして、Perl で Net::Twitter::Lite を使った CLI の twitterクライアントアプリケーションを作ってみました。
pochitwi.pl
#!/usr/bin/env perl
use strict;
use warnings;
use utf8;
use Encode;
use Try::Tiny;
use Net::Twitter::Lite;
use Time::Piece;
use YAML;
use File::HomeDir;
use Path::Class;
use HTML::TreeBuilder::XPath;
use Getopt::Std;
my $yaml = file( File::HomeDir->my_home, '.pochitwi.yml' );
my $conf = YAML::LoadFile( $yaml ) or die "$yaml: $!";
my $enc = $conf->{ encoding };
my $nt = Net::Twitter::Lite->new(
consumer_key => $conf->{ consumer }{ key },
consumer_secret => $conf->{ consumer }{ secret },
ssl => 1,
);
$nt->access_token( $conf->{ access }{ token } );
$nt->access_token_secret( $conf->{ access }{ token_secret } );
my %opts;
getopts("n:t:" => \%opts);
if ( defined $opts{ n } ) {
$opts{ n } =~ /^\d{1,2}$/
or die encode( $enc, "受け取れない件数ですよ？: $opts{ n }" );
}
if ( defined $opts{ t } ) {
$opts{ t } =~ /^\d{17,}$/
or die encode( $enc, "受け取れないステータスID ですよ？: $opts{ t }" );
}
unless ( $ARGV[0] ) {
&get_twitter;
}
else {
my $text = $ARGV[0];
$text = decode( $enc, $text );
my $length = length $text;
$length <= 140
or die encode( $enc, "つぶやけるのは 140字以下ですよ？: $length" );
&post_twitter( $text, $opts{ t } );
}
sub get_twitter {
my $ht;
try {
$ht = $nt->home_timeline( { count => $opts{ n } } );
}
catch {
warn $_;
};
foreach my $line ( @{ $ht } ) {
print $line->{ user }->{ screen_name }, ' ',
encode( $enc, $line->{ user }->{ name } ), ' : ',
'(', $line->{ id }, ')',
encode( $enc, $line->{ text } ), ' ',
&to_jst( $line->{ created_at } ), ' ',
'via ', encode( $enc, &delete_html_tag( $line->{ source } ) ),
"\n";
}
}
sub post_twitter {
my ( $text, $reply_to ) = @_;
unless ( $reply_to ) {
try { $nt->update( { status => $text } ); } catch { warn $_; };
}
else {
try {
$nt->update( { status => $text,
in_reply_to_status_id => $reply_to,
} );
}
catch {
warn $_;
};
}
}
sub to_jst {
my $twitter_dt = shift;
my $t = Time::Piece->strptime( $twitter_dt, '%a %b %d %T %z %Y' );
$t += 60 * 60 * 9;
$t->datetime . '+09:00';
}
sub delete_html_tag {
my $source = shift;
my $tree = HTML::TreeBuilder::XPath->new;
$tree->parse_content( $source );
if ( my ( $node ) = $tree->findnodes( '//a' ) ) {
return $node->as_text;
}
else {
return $source;
}
$tree->delete;
}
このコードとは別に .pochitwi.yml というファイル名でホームディレクトリ直下に、こんな設定ファイルを用意します。
encoding: utf8
consumer:
key: Consumer key
secret: Consumer secret
access:
token: Access Token
token_secret: Access Token Secret
utf8 は、日本語環境の文字コードに合わせて適宜変更します。また、Consumer key、Consumer secret、Access Token、Access Token Secret は、dev.twitter.com で Twitter API を使うアプリケーションの登録を済ませて入手します。
Pure Perl で書かれた YAML を使ってるせいか遅いですけども、そこは移植性を考慮して我慢がまん。
$ ./pochitwi.pl
とすると、下の出力例のような形式で、ホームのタイムラインから最新の 20件のつぶやきを表示します。
inuyamapochimar 犬山ぽち丸 : (87846235523919872)@konafi 壁の穴が心配デス 2011-07-04T20:32:29+09:00 via ぽちつい
出力する件数を指定するには -n オプションを使います。60件表示したい場合はこうします。
$ ./pochitwi.pl -n 60
つぶやくには、
$ ./pochitwi.pl '昨日快晴だったのに今日は大豪雨！？'
誰かのつぶやきに返信するには、-t オプションで返信を付けたい対象のつぶやきの ID を指定してつぶやきます。
$ ./pochitwi.pl -t 87845668449828864 '@konafi 昨日今日と随分涼しくなりましたよ〜？'
コード量のわりにシンプル過ぎる機能しかありませんけども、ぽちもまだ twitter を始めたばかりで凝った使い方が出来るわけじゃありませんので、今のところははこんな感じでも充分間に合っていたりします。
Jun 27, 2011
twitter 始めました
タイトル通り、今更感満載ですけども twitter のアカウントを作って twitter を始めてみました。アカウントは犬山ぽち丸@inuyamapochimarです。字数制限で ID の読みが「いぬやまぽちまる」ではなく「いぬやまぽちまー」になってるのは許してやって下さいませ。まだ何一つ tweet してませんけども、twitter でもどうぞよろしくお願いします。
Jun 20, 2011
ぽちたて 0.1.6 をリリースしました
今まで、コマンドライン引き数に読み込むファイルを与えて起動した時は、ファイル内容の文字コード判定に失敗したり取り扱えないファイルだったりすると、きちんとエラーを表示して die 出来てたのですけども、ファイル選択ダイアログで読み込むファイルを与えた場合にエラーが発生すると、ファイル選択ダイアログのウィンドウがフリーズしてしまうバグがありました。そんなに変なファイルは読まないだろうとそのままにしていたのですけども、最近はぽち以外にも実際に使って下さってる方がいらっしゃいますので、大慌てできちんとエラー処理を施したぽちたて 0.1.6 をリリースしました。
実際に使って下さってる方がいると、ぽちたて作りにも張り合いが出ます。[犬]ω＜)ノ☆
Jun 09, 2011
Perlモジュールの作り方
こないだ勉強がてら、テストファーストでオブジェクト指向の Perlモジュールを書いて、その過程（？）をニコニコ動画に置いていたのですけれども、今日、その修正版を投稿しました。
『仕様を落とし込んだテストを先に書いてから、そのテストを通過するようにモジュールを書いていく』という流れを紹介するのが目的の動画なので、Perl のリファレンスやオブジェクト、モジュールについての基礎的な知識を前提にした不親切な動画になってしまいました。とはいえ、たまにはこんなのがあっても良いですよね？
May 30, 2011
最近読んだ本：Perl CPANモジュールガイド
先週、YouTube で Perl関係の動画をつらつら眺めていたら、こんな動画を見つけました。
この動画を観てなんとなく勢いで購入してしまいましたけども、ここで紹介されている Perl CPANモジュールガイドは、最近の定番モジュールの解説書です。最近の Perl について書かれた本だと、少し前にモダンPerl入門という本がありました。このモダンPerl入門、内容はとても充実している良書なのですが、とてもイキナリ初心者に読ませるような本ではありません。今までこの Perl CPANモジュールガイドのように、最近の Perl について書かれた初心者向けの本は無かったので貴重なんじゃないでしょうか？動画では cpanm について言及されていますけども、cpanm だけじゃなく perlbrew の解説もあります。きちんとこの二つのツールの解説があるのは、今から Perl本体や CPANモジュール をインストールして学ぶ方に大きな助けになると思います。この本は、初めてのPerl 第5版や続・初めてのPerl 改訂版の副読本にちょうど良いんじゃないでしょうか？
しかし、読んでると自分がいかに CAPN の便利なモジュールを使いこなしていないのかが分かって本当にヘコみます。
May 29, 2011
Open JTalk の Mei (Normal)用コマンドオプションを変更
以前ぽち＊ぷ〜ちの Open JTalk で音声合成して日本語テキスト読み上げに debian squeeze で Open JTalk を導入して音声合成をする方法を書いていましたけども、HTSボイスに Mei (Normal) を使った場合だとコマンドオプションが良くなくてあまり綺麗な声には出来ませんでした。ところが以前ニコニコ動画にアップした Open JTalk音声合成動画のコメントで、Mei (Normal) がもっとずっと綺麗な声になるオプション例を公開している、
というサイトを教えていただきました。早速そのオプションを取り入れて音声合成してみた結果がこちらです。
まだまだ Open JTalk のデモサイトの調整には及びませんけども、ちょっとびっくりするくらいに綺麗になりました。
May 12, 2011
指輪物語を読み返してみた
なんとなく思い立って十数年前に図書館で読んだ指輪物語を読み返してみる気になり、評論社の文庫版を買って読み始めてしまいました。
以前読んだ時からお気に入りキャラはトム・ボンバディルとボロミアです。トムの老荘の隠君子じみた自由闊達なところや、ボロミアの率直で人間臭いところを読むと、やっぱりこの二人はとっても大好き。映画ではトムの登場するストーリーが丸ごとごっそり割愛されていたり、ボロミアがニコニコ動画の MikuMikuDance動画でネタキャラとして扱われてるのがとっても悔しくてなりません。誰ですか、好みの振れ幅が両極端に開き過ぎてるなんて言ってるのは[犬]ω＜#)ノ！？
まだ読み返し始めてようやく半分ぐらいなのですけども、本文中の旅歩きの描写で、普段インドアなぽちも山歩きとか徒歩の旅に出たくなってしまいました。煙草が大嫌いなぽちがジッポライター必要かな？とか、ツールナイフは便利そうかな？とか、コンパスも欲しいね？とか、アウトドア用品を物色しているなんて異常事態が起きていたり…。と、最近はこんな有様なので、SDL Perl でのゲーム作りや、ぽちたて作りは完全に停滞しています。
May 06, 2011
Perl で素因数分解
先日、ニコニコ生放送で C や Lua などのプログラミング言語を使ってプロジェクト・オイラーの問題を解くのを配信している初心者の方がいました。三問目で躓いて悩んでらっしゃったのを観て、うっかり触発されて、その問題を Perl で解いてみようかな？なんて気になってしまいました。
The prime factors of 13195 are 5, 7, 13 and 29. What is the largest prime factor of the number 600851475143 ?
これは、600851475143 の素因数のうちの最大数を求める問題です。
下のコードは、600851475143 を小さい順に 2 から 600851475143 の平方根以下までの範囲の整数で割っていって、割り切れたら再帰的にまたその商を同じ手順でひたすらどんどん割り続け、最後に割り切れた商を最大の素因数として表示します。
#!/usr/bin/perl
use strict;
use warnings;
print &largest_prime_factor( 600851475143 ), "\n";
sub largest_prime_factor {
my $n = shift;
for ( my $i = 2; $i <= int sqrt $n; $i++ ) {
return &largest_prime_factor( $n / $i ) if $n % $i == 0;
}
return $n;
}
その後、素因数分解のアルゴリズムを調べてみたら、もっとスマートな方法がたくさんあるようです。正規表現のパターンマッチを使って素因数分解しちゃうという、いかにも Perl ならではの方法まであったり…。
May 03, 2011
ぽちたて 0.1.5 をリリースしました
ファイルタイプの判別に File::MMagic を使うようにした、ぽちたて 0.1.5 をリリースしました。
バージョンアップするほどの変更ではないかもしれませんが、とりあえず 0.1.4 よりは安全性は高くなった気がします。
May 01, 2011
日本語テキスト音声合成システム Open JTalk
今までぽちたてを作ってみたりしてテキスト縦書きビューワーにばかり関心を持っていましたけども、最近は音声合成での日本語テキスト読み上げにも興味が出て来ました。Linux で使えて日本語で音声合成が出来るものには、
があるようです。
AquesTalk や AquesTalk2 は、その音声ライブラリが、ゆっくり声の SofTalk の内部で使われているので有名なのですが、プロプライエタリなものなので無償利用可能な評価版には「ナ行、マ行」の音韻がすべて「ヌ」になる制限があるから使えません。一方、オープンソースな Galatea Talk は、最新リリース情報を見ると開発が二年以上停滞しているようです。そこで同じオープンソースなもので、比較的活発に開発され、MMDAgent などにも組み込まれている Open JTalk を試してみる事にしました。
の記事を参考に、無事に debian squeeze でもビルド出来ました。あまり期待していなかったせいか、予想よりも良い感じに日本語テキストを読み上げてくれます。配布されている作成済みのボイスデータは男声だけですけども、女声のボイスデータが必要なら、同じ Open JTalk を使っている MMDAgent の Sample Script に含まれている、メイのボイスデータが流用出来ます。
2011年 5月 3日追記：ぽち＊ぷ〜ちの Open JTalk で音声合成して日本語テキスト読み上げに debian squeeze で Open JTalk を導入する方法を書きました。
2011年 5月 4日追記：
Apr 28, 2011
SDL Perl をいじってみた (3)
今回はスコア表示を変更してゲームオーバー条件を付け、ゲームオーバー状態から RETURNキーを押すと最初から再スタート出来るようにしてみました。←→キーで左右の移動、qキーまたは ESCキーで終了するのは前のままです。
ライブラリは前回同様、SDL に加えて png画像の読み込みに SDL_image、truetypeフォントの読み込みに SDL_ttf を利用しています。また、Perl で使っている SDL Perl のバージョンは 2.532 です。2.2.6以前のバージョンでは動きません。残念な事に debian や ubuntu の SDL Perlパッケージ、libsdl-perl のバージョンは現時点では一番新しくても 2.2.5 なので、CPAN からインストールするしかありません。
ゲームオーバーの条件を付けた事で、だらだらとなんとなくソウルジェムを受け止めるだけの何かが、また少しだけゲームに近付いた気がします。
madoka.png と soul_gem.png
ソウルジェム以外のアイテム、例えばティーカップやきゅぅべえとかもランダムなタイミングでいくつも降らせてみたり、何かの条件を付けてまどかに矢を射させたりしてみたいのですけども、そもそもゲームの作り方を良く知らないぽちなので、実現するにはまだまだ知識が必要なようです。
教えて、ゲームのすごいひと！
#!/usr/local/bin/perl
use strict;
use warnings;
use SDL;
use SDL::Events;
use SDLx::App;
use SDLx::Rect;
use SDLx::Sprite;
use SDLx::Text;
my $error_limit = 10; # ゲームオーバーになるエラー数
# ウィンドウ全体の準備
my $app = SDLx::App->new(
width => 512,
height => 384,
title => 'Catch the Soul Gem!',
dt => 0.02,
exit_on_quit => 1,
);
# 自キャラの準備
my $player = {
rect => SDLx::Rect->new( $app->w / 2 - 16, $app->h / 5 * 4, 32, 32 ),
v_x => 0,
catch => 0,
error => 0,
};
# 自キャラ画像を入れる
my $player_character = SDLx::Sprite->new(
image => 'madoka.png', # 画像置き場へのパス
rect => $player->{rect},
);
# アイテムの準備
my $item = {
rect => SDLx::Rect->new( int( rand( $app->w ) ) - 16, 0, 32, 32 ),
v_y => 4,
};
# アイテム画像を入れる
my $item_character = SDLx::Sprite->new(
image => 'soul_gem.png', # 画像置き場のパス
rect => $item->{rect},
);
# キャッチスコアの準備
my $catch = SDLx::Text->new(
font => 'VL-Gothic-Regular.ttf', # この行削除ならシステムデフォルト
h_align => 'left',
);
# エラースコアの準備
my $error = SDLx::Text->new(
font => 'VL-Gothic-Regular.ttf', # この行削除ならシステムデフォルト
h_align => 'right',
);
# 表示
$app->add_show_handler(
sub {
$app->draw_rect( [ 0, 0, $app->w, $app->h - 45 ], 0x007bbbff ); # 空
$app->draw_rect( [ 0, $app->h - 45, $app->w, 45 ], 0xc3d825ff ); # 地面
$player_character->draw( $app ); # 自キャラ
$item_character->draw( $app ); # アイテム
$catch->write_to( $app, '昇天：' . $player->{catch} ); # キャッチスコア
$error->write_to( $app, '絶望：' . $player->{error} ); # エラースコア
if ( $player->{error} >= $error_limit ) { # ゲームオーバーだったら表示
$catch->write_xy( $app, 140, 170,
'救った魔法少女：' . $player->{catch} . '人' );
}
# CPU使用率が 100% に振り切れるようならディレイを挟んでも良いかも？
#$app->delay( 10 );
$app->update;
}
);
# 自キャラの動き
$app->add_move_handler(
sub {
my ( $step, $app ) = @_;
my $v_x = $player->{v_x};
unless ( $player->{error} >= $error_limit ) {
# 自キャラ座標の変化
$player->{rect}->x( $player->{rect}->x + ( $v_x * $step ) );
# 左の移動限度
if ( $player->{rect}->left <= 0 ) {
$player->{rect}->left( 0 );
}
# 右の移動限度
elsif ( $player->{rect}->right >= $app->w ) {
$player->{rect}->right( $app->w );
}
}
}
);
# アイテムの動き
$app->add_move_handler(
sub {
my ( $step, $app ) = @_;
my $v_y = $item->{v_y};
unless ( $player->{error} >= $error_limit ) {
# アイテム座標の変化
$item->{rect}->y( $item->{rect}->y + ( $v_y * $step ) );
# 衝突した？
if ( &check_collision( $item->{rect}, $player->{rect} ) ) {
$player->{catch}++;
&reset_item;
}
# 下端まで行き着いた？
elsif ( $item->{rect}->top >= $app->h ) {
$player->{error}++;
&reset_item;
}
}
}
);
# 自キャラの操作
$app->add_event_handler(
sub {
my ( $event, $app ) = @_;
# キーを押し込んだ場合
if ( $event->type == SDL_KEYDOWN ) {
# ←キーを押し込んで左へ
if ( $event->key_sym == SDLK_LEFT ) {
$player->{v_x} = -2;
}
# →キーを押し込んで右へ
elsif ( $event->key_sym == SDLK_RIGHT ) {
$player->{v_x} = 2.4;
}
# RETURNキーを押し込んで再スタート
elsif ( $event->key_sym == SDLK_RETURN ) {
$player->{catch} = 0;
$player->{error} = 0;
}
# qキーまたは ESCキーを押して終了
elsif (
$event->key_sym == SDLK_q
or $event->key_sym == SDLK_ESCAPE
) {
$app->stop();
}
}
# キーを離した場合
elsif ( $event->type == SDL_KEYUP ) {
# ←キーや→キーを離したら自キャラが止まる
if (
$event->key_sym == SDLK_LEFT
or $event->key_sym == SDLK_RIGHT
) {
$player->{v_x} = 0;
}
}
}
);
# ループ開始
$app->run;
# 衝突判定
sub check_collision {
my ($A, $B) = @_;
return if ( $A->bottom < $B->top + 16 ); # 自キャラ上半分の衝突判定を削る
return if ( $A->right < $B->left );
return if ( $A->left > $B->right );
# 衝突
return 1;
}
# アイテムをリセット
sub reset_item {
$item->{rect}->y( 0 ); # 上端の
$item->{rect}->x( int( rand( $app->w) ) - 16 ); # ランダムな水平位置
$item->{v_y} = int( rand( 3 ) ) + 3; # ランダムな速度で再出現
}
Apr 26, 2011
SDL Perl をいじってみた (2)
懲りずにまだまだ SDL Perl をいじっています。今回はアイテムと、アイテムと自キャラの衝突判定、スコア表示を追加してみました。少しはゲームに近づいたのではないでしょうか？
SDL に加えて png画像の読み込みに SDL_image、truetypeフォントの読み込みに SDL_ttf を利用しています。
ご覧のように、魔法少女まどか☆マギカのまどかが漆黒に染まったソウルジェムを拾うゲーム（まだゲームとは言えない出来ですけども）になってしまったのは、まどかマギカの第11話・第12話を観たばっかりだったのと、前回投稿した動画、SDL Perl でゲームっぽい何かを書いてみたのコメントのキャラをまどかのドット絵にしたら？という書き込みに乗っかってみたからです。そんでもってまたもや動画を投稿してみました。
madoka.png と soul_gem.png
コードを追加するよりドット絵を手打ちする方に遥かに多くの時間が掛かってしまいました。さらりと描ける方々が本当に羨ましいです。
#!/usr/local/bin/perl
use strict;
use warnings;
use SDL;
use SDL::Events;
use SDLx::App;
use SDLx::Rect;
use SDLx::Sprite;
use SDLx::Text;
# ウィンドウ全体の準備
my $app = SDLx::App->new(
width => 512,
height => 384,
title => 'Catch the Soul Gem!',
dt => 0.02,
exit_on_quit => 1,
);
# 自キャラの準備
my $player = {
rect => SDLx::Rect->new( $app->w / 2 - 16, $app->h / 5 * 4, 32, 32 ),
v_x => 0,
score => 0,
};
# 自キャラ画像を入れる
my $player_character = SDLx::Sprite->new(
image => 'madoka.png', # 画像置き場へのパス
rect => $player->{rect},
);
# アイテムの準備
my $item = {
rect => SDLx::Rect->new( int( rand( $app->w ) ) - 16, 0, 32, 32 ),
v_y => 4,
};
# アイテム画像を入れる
my $item_character = SDLx::Sprite->new(
image => 'soul_gem.png', # 画像置き場のパス
rect => $item->{rect},
);
# スコアの準備
my $score = SDLx::Text->new(
font => 'VL-Gothic-Regular.ttf', # truetypeフォント置き場へのパス
h_align => 'right',
);
# 表示
$app->add_show_handler(
sub {
$app->draw_rect( [ 0, 0, $app->w, $app->h - 45 ], 0x007bbbff ); # 空
$app->draw_rect( [ 0, $app->h - 45, $app->w, 45 ], 0xc3d825ff ); # 地面
$player_character->draw( $app ); # 自キャラ
$item_character->draw( $app ); # アイテム
$score->write_to( $app, 'SCORE:' . $player->{score} ); # スコア
# CPU使用率が 100% に振り切れるようならディレイを挟んでも良いかも？
#$app->delay( 10 );
$app->update;
}
);
# 自キャラの動き
$app->add_move_handler(
sub {
my ( $step, $app ) = @_;
my $v_x = $player->{v_x};
$player->{rect}->x( $player->{rect}->x + ( $v_x * $step ) );
# 左の移動限度
if ( $player->{rect}->left <= 0 ) {
$player->{rect}->left( 0 );
}
# 右の移動限度
elsif ( $player->{rect}->right >= $app->w ) {
$player->{rect}->right( $app->w );
}
}
);
# アイテムの動き
$app->add_move_handler(
sub {
my ( $step, $app ) = @_;
my $v_y = $item->{v_y};
$item->{rect}->y( $item->{rect}->y + ( $v_y * $step ) );
# 衝突した？
if ( &check_collision( $item->{rect}, $player->{rect} ) ) {
$player->{score}++;
&reset_item;
}
# 下端まで行き着いた？
elsif ( $item->{rect}->top >= $app->h ) {
&reset_item;
}
}
);
# 自キャラの操作
$app->add_event_handler(
sub {
my ( $event, $app ) = @_;
# キーを押し込んだ場合
if ( $event->type == SDL_KEYDOWN ) {
# ←キーを押し込んで左へ
if ( $event->key_sym == SDLK_LEFT ) {
$player->{v_x} = -2;
}
# →キーを押し込んで右へ
elsif ( $event->key_sym == SDLK_RIGHT ) {
$player->{v_x} = 2;
}
# qキーまたは ESCキーを押して終了
elsif (
$event->key_sym == SDLK_q
or $event->key_sym == SDLK_ESCAPE
) {
$app->stop();
}
}
# キーを離した場合
elsif ( $event->type == SDL_KEYUP ) {
# ←キーや→キーを離したら自キャラが止まる
if (
$event->key_sym == SDLK_LEFT
or $event->key_sym == SDLK_RIGHT
) {
$player->{v_x} = 0;
}
}
}
);
# ループ開始
$app->run;
# 衝突判定
sub check_collision {
my ($A, $B) = @_;
return if ( $A->bottom < $B->top + 16 ); # 自キャラ上半分の衝突判定を削る
return if ( $A->right < $B->left );
return if ( $A->left > $B->right );
# 衝突
return 1;
}
# アイテムをリセット
sub reset_item {
$item->{rect}->y( 0 ); # 上端の
$item->{rect}->x( int( rand( $app->w) ) - 16 ); # ランダムな水平位置
$item->{v_y} = int( rand( 3 ) ) + 3; # ランダムな速度で再出現
}
Apr 22, 2011
SDL Perl をいじった挙句、ニコニコ動画へ投稿
少しでも SDL Perl の知名度が上がらないかと思ってニコニコ動画へ動画を投稿してみました。
Perl でゲームを書いてみようなんて物好きで酔狂な人が、一人でも増えると心強いんだけど。
Apr 21, 2011
SDL Perl をいじってみた
まったりと SDL::Manual を読みながら、新しくなった SDL Perl をいじってみました。
chr_01.png
とりあえず、ムーヴハンドラやイベントハンドラを仕込んで自キャラを動かしてみるところまで。敵キャラやアイテムや衝突判定は次回へ持ち越しです。
#!/usr/local/bin/perl
use strict;
use warnings;
use SDL;
use SDL::Events;
use SDLx::App;
use SDLx::Rect;
use SDLx::Sprite;
# ウィンドウ全体の準備
my $app = SDLx::App->new(
width => 512,
height => 384,
title => 'test',
dt => 0.02,
exit_on_quit => 1,
);
# キャラクタを入れる器の準備
my $rect = {
chr => SDLx::Rect->new( $app->w / 2 - 16, $app->h / 5 * 4, 32, 32 ),
v_x => 0,
};
# キャラクタを入れる
my $chr = SDLx::Sprite->new(
image => 'chr_01.png', # 画像置き場へのパス
rect => $rect->{chr},
);
# 表示
$app->add_show_handler(
sub {
$app->draw_rect( [ 0, 0, $app->w, $app->h - 45 ], 0x007bbbff ); # 空
$app->draw_rect( [ 0, $app->h - 45, $app->w, 45 ], 0xc3d825ff ); # 地面
$chr->draw( $app ); # キャラ
# CPU使用率が 100% に振りきれるようならディレイを挟んでも良いかも？
#$app->delay( 10 );
$app->update;
}
);
# 動き
$app->add_move_handler(
sub {
my ( $step, $app ) = @_;
my $v_x = $rect->{v_x};
$rect->{chr}->x( $rect->{chr}->x + ( $v_x * $step ) );
# 左の移動限度
if ( $rect->{chr}->left <= 0 ) {
$rect->{chr}->left( 0 );
}
# 右の移動限度
elsif ( $rect->{chr}->right >= $app->w ) {
$rect->{chr}->right( $app->w );
}
}
);
# 操作
$app->add_event_handler(
sub {
my ( $event, $app ) = @_;
# キーを押し込んだ場合
if ( $event->type == SDL_KEYDOWN ) {
# ←キーを押し込んで左へ
if ( $event->key_sym == SDLK_LEFT ) {
$rect->{v_x} = -2;
}
# →キーを押し込んで右へ
elsif ( $event->key_sym == SDLK_RIGHT ) {
$rect->{v_x} = 2;
}
# qキーまたは ESCキーを押して終了
elsif (
$event->key_sym == SDLK_q
or $event->key_sym == SDLK_ESCAPE
) {
$app->stop();
}
}
# キーを離した場合
elsif ( $event->type == SDL_KEYUP ) {
# ←キーや→キーを離したら自キャラが止まる
if (
$event->key_sym == SDLK_LEFT
or $event->key_sym == SDLK_RIGHT
) {
$rect->{v_x} = 0;
}
}
}
);
# ループ開始
$app->run;
CPU の使用率が 100% に振り切れるのは、古い PC だから仕方ないとして、むむむ、自キャラの左右の移動速度があからさまに違うのは何故！？左右の移動速度に差が出るようには書いてない筈なんだけど…。
まだまだ問題山積みです。
Apr 20, 2011
SDL Perl も、あるんだよ！
以前もここで書いたかもしれませんが、SDL の Perlバインディング、SDL Perl はバージョン 2.2.6 以前とバージョン2.5xx では API が大きく変わりました。その上最近では SDL::Manual Writing Games with SDL Perl のような初心者向け文書も書かれています。本が出るくらい日本語文書が充実している Ruby/SDL には到底及びませんけども、ひたすら SDL関連モジュールに埋め込まれた POD を読むしかなかった頃に比べてみれば、SDL Perl を使う為の敷居は随分低くなったのではないでしょうか？
早速 SDL::Manual をちまちま読みながら、教材になってるポンクローンやテトリスクローンを作ってみようと思います。
Apr 18, 2011
Makefileってそいういう仕組みだったんだね…あたしってホント、馬鹿
かいてんパティシエ！とグリーンアイランドのビルドがきっかけで、make や Makefile をきちんと勉強しようと思って、週末にざっと GNU Make Manual を読んでみました。お蔭でぽち環境でのビルド時に悪さをしていた部分がやっとこさ分かりました。
一つは、Makefile.linux の include .depend で .depend の中のリストを使ってヘッダファイルをインクルードしている部分です。これが、存在しない場所にあるヘッダファイルをインクルードしようとして、
make: *** `ram.o' に必要なターゲット `/usr/local/mingw32/include/SDL/SDL.h' を make するルールがありません. 中止.
というエラーを引き起こしていました。
もう一つはグリーンアイランドだけの問題なのですけども、展開して出来た bubble/src の中に make前にもかかわらず不要なオブジェクトファイルがどっさり入っています。
dconv.o: file not recognized: File format not recognized collect2: ld returned 1 exit status make[1]: *** [GreenIsland] エラー 1 make[1]: ディレクトリ `/home/pochi/Desktop/bubble/src' から出ます make: *** [recursive] エラー 2
これがまた、上のようなエラーに繋がっていました。これらの症状は make を行う前に make clean すれば回避出来ます。それに加えてグリーンアイランドの場合は Makefile.linux の中で RotateGear になっているターゲットの名前を、お作法に則ってきちんと GreenIsland にしてあげれば良いだけです。
その肝心の make clean ですが、make clean を実行する前に Makefile.linux の clean: のコマンド部分は、$(RM) $(OBJS) *~ .depend RotateGear.exe から、出来上がる筈のバイナリに合わせて、$(RM) $(OBJS) *~ .depend RotateGear なり、$(RM) $(OBJS) *~ .depend GreenIsland なりに変更する必要があります。
とりあえずわかった事を日記に書いてみましたけども、近いうちにぽち＊ぷ〜ちの Linux箱に置いてあるかいてんパティシエ！、グリーンアイランドを遊ぶも書き直さないと…。
Apr 16, 2011
愛がこもってるから
今日、男性向けエロ漫画家さんの性別を絵を見ただけで言い当てたら驚かれてしまいました。描いた男性キャラを見れば誰だって分かるんじゃないかな？女の子をかわいくエロく描く事に特化した男性向けエロ漫画でも、女性の漫画家さんだと男性キャラの描き方にも愛がこもっています。
しかし、けろりんさんという漫画家さんの絵柄は、ぽちが小学生の頃に読んだブルーソネットの影響を強く受けてる気がします。
Apr 14, 2011
もう Makefile も怖くない！（死亡フラグ）
あるふぁ〜秘密基地(Alpha Secret Base) のパズルアクションゲーム、かいてんパティシエ！とグリーンアイランドをビルドする時、Makefile について何も知らないのに野性の勘と当てずっぽうで変更を加えて、なんとなく make を通してしまいました。出来上がったバイナリを実行して遊んでみたところ、素敵に動いてくれて楽しく遊べます。
けど Makefile を理解出来てないので、どうして make が失敗したり成功したりしたのかは、周辺知識から野性の勘で予想する事は出来ても、確かな事は何一つ分かりません。これではいくらゲームがきちんと動いてるといっても、どうにも気持ち悪くなってしまっていけません。
ぽちは学習用の断片程度なら C を書いた事がありますけども、Makefile が必要なほどの規模のものを書いた事がないので、Makefile の書き方なんて知らないまま過ごして来ました。Linux を使う場合でも、必要なツールはパッケージ管理システムの apt任せにインストールするのばっかりで、必要に迫られてソースコードからビルドする場合でも、同梱の configure に頼り切りです。これも良い機会だと思って、理由もなく怖がっていた Makefile について少し調べてみると、何の事はない、Makefileってお料理の献立レシピみたいなものじゃないですか！！クックパッドのレシピと大差あるものじゃありません。
何だか良く分からないものに対する恐怖感もなくなった事だし、きちんと勉強してみる事にします。
Apr 13, 2011
Linux でゲームを遊ぶ - かいてんパティシエ！とグリーンアイランド
ぽちたて作りがぽちの実力不足で滞ってしまったので、気分転換にゲームで遊んでみる事にしました。ぽちは Linux の入った PC しか持っていないので、遊ぶゲームは当然 Linux のゲームです。Linux のゲームというと海外のものしかないという印象ですけども、日本でも Linux でビルド出来るゲームを作っている方がいらっしゃいます。
今回遊んでみる事にしたのはこれ。
DirectX ではなくてクロスプラットフォームなライブラリの SDL を使っているので、上手く行けば Windows だけじゃなく Linux でもソースコードからビルドして遊べる筈です。ダウンロードのリンクにはそれぞれ Windows とかしか書いてありませんけども、それは同梱されているビルド済みバイナリの話で、実はソースコードがきっちり入っていて Linux向けの Makefile まで準備されています。紆余曲折はありましたが、C の初歩の初歩のほんのさわりしかわからず Makefile の書き方なんて全然知らないぽちでも何とかビルド出来ました。かいてんパティシエ！の二倍ウィンドウやグリーンアイランドは、古過ぎるぽちPC のパワー不足のせいで少しモッサリした感じになってしまいましたけども、充分楽しく遊べます。もっと SDL を使ったゲームが増えるといいなあ。
具体的な紆余曲折はぽち＊ぷ〜ちの Linux箱に書く予定です。
D.Kさん、Linux でも動くかわゆくも楽しい、素敵なゲームをありがとうございます。
Apr 12, 2011
Net::AozoraBunko で青空文庫を検索・取得
ぽちたてを青空文庫ビューワー化する為に「青空文庫」と「Perl」で Web を検索してたら、いきなりスゴイの見つけました。
- Perlで文学を嗜む Net::AozoraBunko - JPerl advent calendar 2010 casual Track
- Net::AozoraBunko - search.cpan.org
Net::AozoraBunko
というわけで書いてみました。Net::AozoraBunko。
このモジュールは、青空文庫の作家や作品を検索し、作品をダウンロードすることができます
まだ CPAN にはあげてなくて、 github においてあります。
最初の URI の記事の書かれた時点では、まだ CPAN に上げてない旨が書かれていて、GitHub へのリンクが張られていますけども、二番目の URI の記事でご覧の通り、2011年 4月 12日現在ではしっかり CPAN にあります。青空文庫好きのぽちにとっては断然便利な Perlモジュールなのですが、このモジュールをぽちたてで使ったりしたら色々と便利な事が出来そうです。
Apr 11, 2011
青空文庫形式テキストのパーサが欲しい！
連日ちまちま作っているぽちたてですけども、単純なテキスト縦書きビューワーとしては、だんだんとそれなりの物になって来ています。昨日も圧縮されたテキストファイルをそのまま読み込めるようにしました。こうなって来ると、青空文庫のテキストを読む時に青空文庫形式テキストをただそのまま素の縦書き表示するだけでなく、青空文庫形式テキストの注記を解釈してルビやレイアウトなどに反映させた縦書き表示をしたくなって来ます。その為に必要になるのが青空文庫形式テキストのパーサです。
ぽちたてを青空文庫ビューワー化させるには、まずこの青空文庫パーサを書かないといけません。ぽちの乏しい知識と泥臭いセンスからすると、安直に Perl の正規表現で書く事になると思います。本当は誰か Perl の凄いひとが、AozoraBunko::Parser（仮名）みたいな名前で Perlモジュールを書いてくれたら良いんだけどなあ…。
とりあえず今後の為に、参考になりそうなサイトをメモしておきます。
なんだか、本当にぽちたての青空文庫ビューワー化が出来るのか不安になって来てしまいました。
Apr 10, 2011
ぽちたて 0.1.4 をリリースしました
素のテキストファイルだけでなく、gzip、bzip2、zip形式に圧縮されたテキストファイルも受け取って表示出来るようになった、ぽちたて 0.1.4 をリリースしました。
これでファイルを保管するスペースをだいぶ節約出来るかも？
Apr 09, 2011
IO::Uncompress::AnyUncompress でファイルを展開してみる
ぽちたてで gzip、bzip2、zip といった形式に圧縮されたテキストファイルを直接読み込めるようにしたくて Perl でそうした圧縮ファイルを展開する方法を調べてみると、gzip、bzip2、zip、その他をまとめて扱ってくれる IO::Uncompress::AnyUncompress という、そのものズバリな名前の便利そうなモジュールを発見。早速試しに gzip、bzip2、zipファイルを展開するコードを書いてみました。
#!/usr/bin/perl
use strict;
use warnings;
use IO::Uncompress::AnyUncompress qw/$AnyUncompressError/;
my $file = $ARGV[0];
if ($file =~ /.+\.txt$/) {
open my $fh, '<', $file
or die "Couldn't open $file for reading: $!\n";
my $content .= join '', <$fh>;
close $fh;
print $content;
}
elsif ($file =~ /.+\.zip$|.+\.gz$|.+\.bz2$/) {
my $z = IO::Uncompress::AnyUncompress->new($file)
or die "anyuncompress failed: $AnyUncompressError\n";
my $content .= join '', <$z>;
close $z;
print $content;
}
else {
die "Illegal file name: $file\n";
}
exit;
ファイルを引き数に取って、そのファイルがテキストファイルの場合はそのままで、対応している圧縮ファイルの場合は展開してから、文字列の入った $content を print で標準出力へ流しています。改めてテキストファイルが必要なら > で新しいファイルへリダイレクトしてあげるといいかも？
ファイル判別にファイル名の拡張子を使ってるので、中身が何だか分からないアヤシゲなファイルには危なくて使えないけど、ぽちたての用途なら充分使えそうです。
Apr 06, 2011
犬山ぽち丸の孤独
趣味で Linux や Perl をいぢっているぽちには、身近で気軽にこうした話題で盛り上がったり出来る友達は全く居ません。辺鄙な田舎在住なので都会のそうした趣味の方々の集まりには参加出来ず、インターネット上に公開されたり配布されたりしている情報を頼りに、今までひっそり独学で勉強して来ました。けど、やっぱり何だか寂しく感じてしまう今日この頃だったりします。Linux や Perl についてあーだこーだ言い合える友達が居たらいいのにな…。
犬山ぽち丸は Linux や Perl が好きな友達を（今更ながらに）大募集中です。
Apr 05, 2011
ぽちたて 0.1.3 をリリースしました
一度栞を挟んだ後で、ぽちたて 0.1.2 を終了せずに再度栞を挟むと、次に起動した時にページ数や読み出し位置がおかしくなる不具合を修正した、ぽちたて 0.1.3 をリリースしました。
何か、いつもいつもリリースした直後にバグが発覚している気がします。リリース前にはもっと変な使い方を試して慎重にデバグしないといけませんね。とほほ…[犬]ω；)。
Apr 04, 2011
ぽちたて 0.1.2 をリリースしました
Pango と IPAフォント のバージョンアップのお蔭で縦書き表示が以前よりぐっと実用的になったので、ぽちたて 0.1.2 をリリースしました。誰ですか他力本願って言ってるのは？
今回は、従来マウスクリックでのページ送り・ページ戻りがとても面倒臭かったので、キー操作でも出来るようにし、栞機能を見直して、栞で再開した後でも栞を挟んだページよりも前へ戻れるようにしてみました。さほど致命的では無いバグがまだ残っているかもしれませんけども、これで簡易なテキスト縦書きビューワーとしての機能は一応満たせたような気がします。次の目標は青空文庫形式テキストの閲覧機能の実装？
しかし、ぽちたてが Gtk2-perl版になってからは、まだ一人からしか使ってみた感想を聞いた事がありません。未完成な上に事実上ほぼ Linux/UNIX専用だとはいえ、本当にこの世で誰か他に使ってみた人は存在するのでしょうか？まあ、ぽちが使えればそれで構わないんですけどね。
Mar 28, 2011
OS を lenny から squeeze へ
遅れ馳せながら Debian GNU/Linux 5.0 lenny だったぽちPC の OS を最新安定版の Debian GNU/Linux 6.0 squeeze にしました。ついでに /usr/local/bin/ にインストールしていた Perl も最新安定版の 5.12.3 へと少しだけバージョンアップ。ぽち＊ぷ〜ちに置いてあるメモ類も順次 squeeze で確認を取って更新していく予定ですけども、暫くの間は lenny で確認したメモと squeeze で確認したメモが混在しちゃうかもしれません。
今後の予定としては、バージョン 2.2.6 以前とは API が大きく変わった新しい SDL Perl 2.5x系についてや、lenny ではビルド出来なかった Linux向け青空文庫ビューワー xjp2 の 2.9.x系についてのメモを書いてみようかなんて思っていたりするので、暇を見つけて書いて行こうっと。
Mar 18, 2011
東北地方太平洋沖地震
先週、3月11日14時46分、観測史上最悪の規模、マグニチュード9.0 の地震が発生しました。
発生当時在宅してたまたまテレビで NHK をつけていたぽちは、発生後の津波被害の中継を見てしまいました。まだ動いている自動車が真っ黒な波に飲まれていく光景はこの世のものとも思えず、今この瞬間、この光景の中で多くの方々が命を落としていると思うと、嘆声を上げる事以外何も出来ない自分がもどかしく無力感に苛まされてしまいました。
あまりにショック過ぎてとてもぽち＊ろぐでこの事を書く気にもなれなかったのですけども、一週間経った今日、やっとこの事について書く気になれました。とは言うものの、何か被災地の方々を元気づけられるような素敵な言葉を、今はまだぽちには見つける事が出来ません。唯々、この災害でお亡くなりになられた方々のご冥福と、被災地で被害に遭われた皆様、被災地で救難に従事する自衛官、消防官、警察官を始めとした全て方々のご無事をお祈りしています。
Jan 23, 2011
りゅうたまセッションに初参加
去年ルールブックを買って一通り読んだまま放ったらかしにしていたりゅうたまでしたけれども、やっとこさどどんとふを利用したオンラインセッションに参加しました。TRPG のセッションに参加するが久しぶりなので不安だったのですが、GM の武綾さんをはじめとしたセッション参加者の方々と楽しく遊ばせていただきました。
ぽちのキャラはミルッカという名前のハンター/アタックで、いつもヨボヨボ老犬のニパを連れ歩いている、まだ旅に出たばかりの女の子。いろいろあって、うっかり暴走気味のプレイになってしまったので、参加された方々に迷惑なプレイヤーだと思われてないといいなあ…。
今後も機会があったらりゅうたびで募集されるセッションにどんどん参加して行きたいと思っていますので、今回のセッション参加者の皆様もまた宜しくお願いします。
