SｇｆTxtConvertByTree

SGF->テキスト変換（変化図対応版）ソース

SGF->テキスト変換（変化図対応版）で使ったプログラムの変換部分ソースです。
EUC前提で作ってあります。ソースもEUCで保存してください。
Webインターフェース部分は非公開です。
※変数名とか練れてないので正直公開したくなかったです。ﾊｲ

仕様：

入力パラメータ

$sgf:sgfファイルを読み込んだもの。文字コードはEUC限定。SJISの２バイト目とかの処理はしてない。

戻り値

変換後の文字列（タグなし）文字コードはEUC。

処理概要

SGFのXX[yyy]をXX{nn}と変換し、$param[nn]=yyy とします。
つまり、SGFの構造部分と実データ部分を分離します。
その後、ゲーム情報部分と着手情報部分を分離し、
それぞれパラメータと実データを取り出し整形しています。
着手データは、ｎ分木の形で保存されます。

 $node ->{'DATA'}  
       ->{'CHILED'}[] （ 子$node　）
       ->{'PARENT'} （ 親$node ）
{'CHILED'}[0] が空の場合、枝はそこで終了します。
{'PARENT'} が空の場合、root ノードです。

次の変数は、グローバル変数です。

$movecnt : 着手番号（ｎ手目）
$brnch_no : 枝番号（分岐番号生成に利用）
$brn_sub_no : 枝内分岐番号（分岐番号生成に利用）
@branch_p ： 分岐ポイント スタック（参照）
@move_no : 分岐ポイント着手番号 スタック
@branch_name : 分岐番号 スタック

%mv : B,W の変換ハッシュ変数
%xleg,%yleg : x､y座標 の変換ハッシュ変数

免責・問い合わせ

このソースは、自由に改変、流用していただいて結構です。
著作権を放棄はしませんが、主張はしません。
当然、このプログラムを使って起きた問題に対して責任は取りません。
問い合わせ先：mailto:hebotaro@t-factory.jp

実ソース(sgf2txt_tree.pl)

#! /usr/bin/perl

%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;
	
	$msg .= "\n-- 以降着手 --\n";
	
	# 着手を 以下のListに変換
	# $node ->{'DATA'}  
	#       ->{'CHILED'}[] -> $node
	#       ->{'PARENT'}
	
	@moves = split /\;/, $move;
	
	my( $root );	# 着手データ n分木構造
	$err_msg = '';
	$ins_p = \$root;	# 着手ポイント
	$branch_p = [];
	foreach( @moves ){
		$val = $_;
		$ins_p = insert( $$ins_p, $val );	# ノードの挿入
		
		while( $val =~ m/\)/ ){
			$ins_p = pop @branch_p;		# '）' で枝終了 '(' でPushした、挿入点を復元
			if( $ins_p == null) { $err_msg = "カッコがバランスしていません。無視します。\n"; last; }
			$val =~ s/\)//;
		}
		if( $ins_p == null) { last; }
		while( $val =~ m/\(/ ){
			push @branch_p, $ins_p;		# '（' があるごとに挿入点 Push
			$val =~ s/\(//;
		}
	}
	
##	$msg .= $err_msg;   # エラーメッセージは無視（SGF上判定不可）
	
	push @branch_p, \$root;		# 分岐点 参照
	push @move_no, 0;			# 着手番号（n 手目）
	push @branch_name, '';		# 分岐（変化図番号）n-n
	$msg .= "--- 主筋 --- \n";
	$brnch_no = 1;
	while( $point = shift @branch_p ){
		$movecnt = shift @move_no;
		$branch_name = shift @branch_name;
		if( $branch_name ne '' ){
			$msg .= "<a name=\"brn$branch_name\">";
			$msg .= "変化図 $branch_name\n";
		}
		$brn_sub_no = 0;
		# 枝表示（主筋もひとつの枝）
		showdata( $$point );
		if( $branch_name ne '' ){
			$msg .= "--- 終了 ---<a href=\"#ret$branch_name\">（分岐点に戻る）</a>\n\n";
		} else {
			$msg .= "--- 終了 ---\n\n";
		}
		$brnch_no++;
	}
	
	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;
}

sub insert{
	my( $tree, $val ) = @_;
	unless( $tree ){
		$tree = {};
		$tree->{'DATA'} = $val;
		$tree->{'CHILED'} = [];
##		print $tree->{'CHILED'} . "\n";
		$tree->{'PARENT'} = $_[0];
		$_[0]= $tree;
		return \$tree;
	}
	$ins_p = insert($tree->{'CHILED'}[@{$tree->{'CHILED'}}] , $val );
	return $ins_p;
}

sub showdata {
	my($tree) = @_;
	return unless $tree;
	
	$movecnt++;			# 着手加算
	### print " $movecnt moves " . $tree->{DATA}, "\n";
	$brnch_msg = '';
	$cnt = @{$tree->{CHILED}};				# 子ノード数
	for( $lvl=1; $lvl<$cnt; $lvl++ ){		# 子ノード数分 変化図あり
		# print "now branch!$cnt\n";
		$brn_sub_no++;
		$bname = $brnch_no . '-' . $brn_sub_no;
		
		$brnch_msg .= "　<a name=\"ret$bname\"><a href=\"#brn$bname\">変化図 $bname</a>";
		push @branch_p, \$tree->{CHILED}[$lvl];		# 次分岐位置 Push
		push @move_no, $movecnt;					# 着手番号 Push
		push @branch_name, $bname;					# 分岐名 Push
	}
	$msg .= &make_move_msg( $tree->{DATA}, $movecnt, $brnch_msg );
	
	showdata( $tree->{CHILED}[0] );
}

sub make_move_msg{
	my( $mov, $cnt, $brnch_msg )=@_;
	my( $wok, @mvmv, $lb,$comment, $x, $msg );
	## print "$mv\n";
	# ラベル処理
	$msg = '';
	$wok = $mov . '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( $mov =~m/C\{(\d+?)\}/ ){
		$comment = '　' . $param[$1];
		$comment =~ s/\\([ \\])/$1/g;
		$comment =~ s/\\\\/\\/g;
	} else {
		$comment = '';
	}
	if( $mov =~ m/((B|W))\{(\d+?)\}/ ){
		$x = $1;
		## print "$1,$2,$3,$4\n";
		$msg .= "$mv{$1}$cnt手目　";
		if( $param[$3] =~ m/([a-z])([a-z])/ ){
			if( $xleg{$1} eq '' ){   # 座標はずれ。
				$mov_msg = '上位変化図以外';
			} else {
				$mov_msg = "$xleg{$1}の$yleg{$2}";
			}
			$msg .= "$mov_msg$brnch_msg$comment$lb\n";
		}
	}
	return $msg;
}