SGF->テキスト変換ソース
SGF->テキスト変換で使ったプログラムの変換部分ソースです。
EUC前提で作ってあります。ソースもEUCで保存してください。
Webインターフェース部分は非公開です。
仕様：
入力パラメータ
$sgf:sgfファイルを読み込んだもの。文字コードはEUC限定。SJISの２バイト目とかの処理はしてない。
戻り値
変換後の文字列（タグなし）文字コードはEUC。
処理概要
SGFのXX[yyy]をXX{nn}と変換し、$param[nn]=yyy とします。
つまり、SGFの構造部分と実データ部分を分離します。
その後、ゲーム情報部分と着手情報部分を分離し、
それぞれパラメータと実データを取り出し整形しています。
免責・問い合わせ
このソースは、自由に改変、流用していただいて結構です。
著作権を放棄はしませんが、主張はしません。
当然、このプログラムを使って起きた問題に対して責任は取りません。
問い合わせ先：mailto:hebotaro@t-factory.jp
実ソース(sgf2txt.pl)
#! /usr/bin/perl
# SGF -> テキスト 変換
# (C)hebotaro@t-factory.jp
%mv = ( 'B'=>'黒', 'W'=>'白' );
%xleg = ( 'a'=>'1','b'=>'2','c'=>'3','d'=>'4','e'=>'5',
'f'=>'6','g'=>'7','h'=>'8','i'=>'9','j'=>'10',
'k'=>'11','l'=>'12','m'=>'13','n'=>'14','o'=>'15',
'p'=>'16','q'=>'17','r'=>'18','s'=>'19' );
%yleg = ( 'a'=>'一','b'=>'二','c'=>'三','d'=>'四','e'=>'五',
'f'=>'六','g'=>'七','h'=>'八','i'=>'九','j'=>'十',
'k'=>'十一','l'=>'十二','m'=>'十三','n'=>'十四','o'=>'十五',
'p'=>'十六','q'=>'十七','r'=>'十八','s'=>'十九' );
1;
sub sgf2text{
my( $sgf ) = @_;
## 改行、空白とっぱらい。
$sgf =~ s/\n/ /g;
$sgf =~ s/\r//g;
##$sgf =~ s/\s//g;
##
## $sgf = $j->set(\$sgf)->euc;
# sgf 実データ、構造分離
$struct = $sgf;
$cnt = 0;
while( $struct =~ m/\[((\\.|.)*?)\]/ ){
$param[$cnt] = $1;
$struct =~ s/\[((\\.|.)*?)\]/\{$cnt\}/;
$cnt ++;
}
$struct =~ s/\s//g;
#print "$struct\n";
#foreach( @param ){
# $a = $j->set(\$_)->sjis;
# print "$a\n";
#}
# sgf 対局情報 / 着手情報分離
$struct =~ m/\(\;(([\\].|.)*?)\;(.*)\)/;
$info = $1;
$move = $3;
# print "info=$info\n";
## 対局情報 生成
#
$msg = '';
# EV[名前] 大会名
$msg = getParam('EV', $info, $msg, '', "\n" );
# GN[対局名] 対局名
$msg = getParam('GN', $info, $msg, '', "\n" );
# RO[n] トーナメントや番碁などの第n回戦か[]内に記入します。
$msg = getParam('RO', $info, $msg, 'ラウンド：', "\n" );
# DT[YYYY-MM-DD]
$msg = getParam('DT', $info, $msg, '対局日:', "\n" );
# PC[名前] 対局場所の名前を[]内に記入します。
$msg = getParam('PC', $info, $msg, '対局場所:', "\n" );
# PB[名前] 黒の対局者名を[]内に記入します。
$msg = getParam('PB', $info, $msg, '黒番:', " " );
# BR[棋力] 黒の対局者の棋力を[]内に記入します。
$msg = getParam('BR', $info, $msg, '', "\n" );
# PW[名前] 白の対局者名を[]内に記入します。
$msg = getParam('PW', $info, $msg, '白番:', " " );
# WR[棋力] 白の対局者の棋力を[]内に記入します。
$msg = getParam('WR', $info, $msg, '', "\n", );
# HA[n] 置き石数を半角数字で[]内に記入します。互先の場合は0と記入します。
$msg = getParam('HA', $info, $msg, '置き石：', "子\n" );
# KO[n] コミの値を半角数字[]内に記入します。
# 逆コミ(白からのコミ出し)の場合は負号(-)を付けます。
$msg = getParam('KO', $info, $msg, 'コミ：', "目\n" );
$msg = getParam('KM', $info, $msg, 'コミ：', "目\n" );
# RE[]
# 対局結果を[]内に記入します。 0：持碁
# B+x：黒x目勝ち、W+x：白x目勝ち
# B+R：黒中押勝ち、W+R：白中押勝ち
# B+T：白時間切れ負け、W+T：黒時間切れ負け
$wok = getParam('RE', $info, '', '', '' );
if( $wok =~ m/^0$/ ){
$msg .= '結果：引き分け' . "\n";
} elsif( $wok =~ m/^B\+R$/ ){
$msg .= '結果：黒中押勝ち' . "\n";
} elsif( $wok =~ m/^W\+R$/ ){
$msg .= '結果：白中押勝ち' . "\n";
} elsif( $wok =~ m/^B\+T$/ ){
$msg .= '結果：白時間切れ負け' . "\n";
} elsif( $wok =~ m/^W\+T$/ ){
$msg .= '結果：黒時間切れ負け' . "\n";
} elsif( $wok =~ m/^B\+([\d\.]*)$/ ){
$msg .= "結果：黒$1目勝ち" . "\n";
} elsif( $wok =~ m/^W\+([\d\.]*)$/ ){
$msg .= "結果：白$1目勝ち" . "\n";
} elsif( $wok =~ m/^B\+(.*)/ ){
$msg .= "結果：黒$1勝ち" . "\n";
} elsif( $wok =~ m/^W\+(.*)/ ){
$msg .= "結果：白$1勝ち" . "\n";
} elsif( $wok ne '' ){
$msg .= "結果：$wok" . "\n";
}
# RU[ルール名]
# 対局ルール名を[]内に記入します。
# SZ[x] 碁盤の路数を[]内に記入します。
$msg = getParam('SZ', $info, $msg, '碁盤サイズ：', "路盤\n" );
# 置き碁、盤面上コメント、AE（？）
# AW[xy][xy] AB[xy][xy] LB[xy][xy]
$setup = '';
$wok = $info . 'T';
undef @mvmv;
while( $wok =~ /AB(\{(.*?)\})([A-Z\(\)\;])/ ){
$ppp = $1;
@mvmv = ( @mvmv, getMoveList( $ppp ) );
$wok =~ s/AB(\{(.*?)\})([A-Z\(\)\;])/\3/;
}
$mvmv = join ',', @mvmv;
$setup .= '置き石 黒：' . $mvmv . "\n" if $mvmv ne '';
undef @mvmv;
while( $wok =~ /AW(\{(.*?)\})([A-Z\(\)\;])/ ){
@mvmv = ( @mvmv, getMoveList( $1 ) );
$wok =~ s/AW(\{(.*?)\})([A-Z\(\)\;])/\3/;
}
$mvmv = join ',', @mvmv;
$setup .= '置き石 白：' . $mvmv . "\n" if $mvmv ne '';
undef @mvmv;
while( $wok =~ /LB(\{(.*?)\})([A-Z\(\)\;])/ ){
@mvmv = ( @mvmv, getLabelList( $1 ) );
$wok =~ s/LB(\{(.*?)\})([A-Z\(\)\;])/\3/;
}
$mvmv = join ',', @mvmv;
$setup .= 'ラベル：' . $mvmv . "\n" if $mvmv ne '';
$msg .= $setup;
# C[]
$msg = getParam('GC', $info, $msg, '対局コメント：', "\n" );
$msg = getParam('C', $info, $msg, 'コメント：', "\n" );
## $msg = $j->set(\$msg)->sjis;
## print $msg;
# 分岐削除
# 最初の)までを確保
if( $move =~ m/(.*?)\)/ ){
$main_move = $1;
$move =~ s/(.*?)\)//;
# 以降 () のペアを削除
while( $move =~ m/\(.*?\)/ ){
$move =~ s/\(.*?\)//;
}
# 残りを連結
$main_move .= $move;
} else {
$main_move = $move;
}
# print $main_move;
@moves = split /\;/, $main_move;
## print @moves;
$msg .= "\n-- 以降着手 --\n";
$cnt = 0;
$paren = 0;
## $msg = '';
foreach( @moves ){
# ラベル処理
$wok = $_ . 'T';
undef @mvmv;
while( $wok =~ /LB(\{(.*?)\})([A-Z\(\)\;])/ ){
@mvmv = ( @mvmv, getLabelList( $1 ) );
$wok =~ s/LB(\{(.*?)\})([A-Z\(\)\;])/\3/;
}
$lb = join ',', @mvmv;
$lb = '(' . $lb . ')' if $lb ne '';
# コメント処理
if( m/C\{(\d+?)\}/ ){
$comment = ' ' . $param[$1];
$comment =~ s/\\([^\\])/$1/g;
$comment =~ s/\\\\/\\/g;
} else {
$comment = '';
}
$cnt++;
if( m/((B|W))\{(\d+?)\}/ ){
$x = $1;
## print "$1,$2,$3,$4\n";
$msg .= "$mv{$1}$cnt手目 ";
if( $param[$3] =~ m/([a-z])([a-z])/ ){
$msg .= "$xleg{$1}の$yleg{$2}$comment$lb\n";
}
}
}
return $msg;
}
sub getParam{
my( $cd, $src, $msgs, $pre, $sa )=@_;
my( $x );
if( ( $src =~ m/(;|\}|\()$cd\{(\d+?)\}/ ) ||
( $src =~ m/^($cd)\{(\d+?)\}/ ) ) {
$x = $param[$2];
$x =~ s/\\([^\\])/$1/g;
$x =~ s/\\\\/\\/g;
$msgs .= $pre . $x . $sa if $x ne '';
}
return $msgs;
}
sub getMoveList{
my( $list )=@_;
my( @lb );
undef @lb;
while( $list =~ m/\{(\d+?)\}/ ){
# print "$1\n";
if( $param[$1] =~ m/([a-z])([a-z])/ ){
@lb = (@lb, "$xleg{$1}の$yleg{$2}" );
}
$list =~ s/\{(\d+?)\}//;
}
return join ",", @lb;
}
sub getLabelList{
my( $list )=@_;
my( @lb );
undef @lb;
while( $list =~ m/\{(\d+?)\}/ ){
# print "$1\n";
if( $param[$1] =~ m/([a-z])([a-z]):(.+)/ ){
@lb = (@lb, "$3 $xleg{$1}の$yleg{$2}" );
}
$list =~ s/\{(\d+?)\}//;
}
return join ",", @lb;
}
以上。HeboTaro?
おまけ
上記プログラムを sgf2txt.pl として保存。それのフィルタ用インターフェース。
Windows用（というか、最終的にSJISに変換してるだけ（笑））
#! /usr/bin/perl
require 'sgf2txt.pl';
use Jcode;
my $j = new Jcode;
$sgf = '';
while(<>){$sgf.=$_;}
$sgf = $j->set(\$sgf)->euc;
$msg = &sgf2text( $sgf );
$msg = $j->set(\$msg)->sjis;
print $msg;
最新の20件
2005-04-16
2005-04-15
2005-04-13
2005-04-12
