##
## go-utils.pl
##
## Utilities to convert go boards
##
## Copyright (C) 1999 Toni Cornelissen (toni@dse.nl)
##
## This program is free software; you can redistribute it and/or
## modify it under the terms of the GNU General Public License
## as published by the Free Software Foundation; either version 2
## of the Licence, or (at your option) any later version.
##
## This program is distributed in the hope that it will be useful,
## but WITHOUT ANY WARRANTY; without even the implied warranty of
## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
## GNU General Public License for more details.
##
## You should have received a copy of the GNU General Public License
## along with this program; if not, write to the Free Software
## Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
##
## Version 1.0 3 July 1999
## * Initial version
##
## Version 1.1 6 July 1999
## * Added meta information (Color of the first move) in the zeroth
## line of the board
## * Added the board2html function
##
## Version 1.2 19 Juli 1999
## * Improved the clean board algorithm
## Coordinates are cleaned of the board
##
## Version 1.3 28 August 1999
## * Included the display of hoshi and boarders
##
## Version 1.4 21 October 1999
## * Added the border=0 attribute so the diagrams can be
## hyperlinked without destroying the layout
## * Minor bug fixing
##
## Version 1.5 28 October 1999
## * Made attributes (like border) configurable
##
## Version 1.6 24 January 2001
## * inserted a \n between "img" and "src" every 5th line
##
## Version 1.7 28 August 2002
## Instead of a \n between "img" and "src" every 5th line,
## put one after every "img".
##
## Version 1.8 29 August 2002
## Added a final "
".
##
## Version 1.9 18 November 2002
## Converted all gif filenames to lower case, for consistency under Unix.
##
## Version 2.0 18 January 2003
## Converted all gif filenames to lower case, for consistency under Unix.
##
$go_utils_version_number = 2.0;
## characters used to mark stones, and some 8-) escape charaters
$go_utils_mark = "\\\<\\\\\\\)\\\]"; # Nick substituted a < in place of its entity
sub clean_board {
##
## This funtion will remove unwanted text from the board.
## This makes it possible to cut an paste a board and enter
## that board, without editing in this program.
##
## Example:
## The text:
## < < . . . . . .
## < < . . # O . . This is a ko
## < < . # O . O .
## < < . . # O . .
## < < . . . . . .
## < <
## < < Diagram 1
##
## Will result in the following board:
## . . . . . .
## . . # O . .
## . # O . O .
## . . # O . .
## . . . . . .
##
## Input:
## A string with the board (newlines included)
## Output:
## A list with on each line the cleared board.
## Remarks:
## This is not tested extensively some configurations might
## go wrong.
##
my $ascii_string = shift;
$spacer = " "; ## line added by nsw, 2001-01-24
$maxcountline = 5; ## line added by nsw, 2001-01-24
$countline = -1; ## line added by nsw, 2001-01-24
## add the final return
$acii_string .= "\n";
## if the border is placed to close to the board it may overwrite
## a go point so let's move it one place
$ascii_string =~ s/\|/ |/gs;
## change the counterparts of the markings to space
$ascii_string =~ s/[\>\/\(\[]/ /gs; # Nick substituted a > for its entity
## I need a space behind a 'go'-character,
## so I add an extra space at the end of
## each line
$ascii_string =~ s/([^\n\r]*)/$1 /g;
## Split the string in lines
my @ascii_list = split(/\n/, $ascii_string, /\n/);
my $go_chars = 0; ## number of go characters
my $nol = 0; ## number of lines
my @clean_board = (); ## the 'clean' board
my $totalsize = 0; ## the sum of the widths of the lines
## Loop over the lines
my $line = "";
foreach $line (@ascii_list) {
## count the number of go chars in this line
my $continue = 1;
while ($continue) {
my $save_line = $line;
my $clean_line = "";
## line with coordinates
$continue = ($line =~ s/(\d+)\s+((?:[\.\,\+\*\w\#][ $go_utils_mark]|\d\d)+)\s*\1/==/);
## if the coordinate field is not filled
if (!$1) {
$line = $save_line;
$continue = ($line =~ s/((?:[\.\,\+\*\w\#][ $go_utils_mark]|\d\d)+)/==/);
$clean_line = $1;
} ## no coordinates
else {
$clean_line = $2;
}
if (length($clean_line) > length($clean_board[$nol])) { # Nick substituted a > for its entity
$clean_board[$nol] = $clean_line;
## remove coordinates
$clean_board[$nol] =~ s/^a (b (c (d (e (f (g (h ([ij] (k (l (m (n (o (p (q (r (s (t (u (v (w (x (y (z )?)?)?)?)?)?)?)?)?)?)?)?)?)?)?)?)?)?)?)?)?)?)?)?$//i;
}
}
## calculate the total number of points
$totalsize += length($clean_board[$nol]);
## increase the number of lines
$nol++;
} ## loop over the lines
## calculate the average board width
my $avgsize = $totalsize / $nol;
## remove lines with less than average board size
for (my $i = $nol - 1; $i >= 0; $i--) { # Nick substituted a > for its entity
if (length($clean_board[$i]) < $avgsize) { # Nick substituted a < for its entity
splice(@clean_board, $i, 1);
}
}
## return the clean board
join("\n", @clean_board);
} ## clean_board
sub make_board {
##
## Converts a 'clean' board to a two dimensional array
## With standard contents of the points.
## These standard point information will be used for parsing
##
## Input:
## A string of 'clean' board lines seperatet by \n
## Meta tags
## Output:
## A two dimensional array of points
## Remarks:
## He clean board is assumed to be rectangular.
##
my @board = split(/\n/, shift);
my @options = @_;
my @board_arr = ();
## use the first line for meta information
## This code was taken from Jeffrey Friedl's (jfriedl@omron.co.jp) www.pl
## and adapted by me.
## parse options:
my $opt;
foreach $opt (@options) {
## next unless defined($board_arr[0]{$opt}) && $opt ne '';
if ($opt =~ m/\s*(\w+)\s*=\s*(.*)\s*/) {
$board_arr[0]{$1} = $2;
}
else {
$board_arr[0]{$opt} = 1;
}
}
my $i = 1;
## loop over the lines of the board
my $boardline = "";
foreach $boardline (@board) {
## loop over the points in a line
my $j;
for ($j = 0; $j < length($boardline) / 2; $j++) { # Nick substituted a < for its entity
## each two charaters is a point
my $point = substr($boardline, $j*2, 2);
## subsitute all hoshi -like to a star
$point =~ s/[\,\+\*]/\*/;
## remove all trailing white spaces
$point =~ s/\s*$//g;
## a single 0 is O
$point =~ s/^[0o]([$go_utils_mark]?)$/O$1/g;
## a single X is #
$point =~ s/^[Xx]([$go_utils_mark]?)$/\#$1/g;
## copy the point to the board
$board_arr[$i][$j+1] = $point;
}
## increase the board line
$i++;
}
## return the board
@board_arr;
} ## make_board
sub board2ascii {
##
## Converts the board to a printable ascii string of the board
##
## Input:
## A two dimensional array containing the board
## Output:
## A string containting the printable version of the board
## Remarks:
## If a point on the board contains more than 2 characters the
## layout will be distorted
##
my @board_arr = @_;
my $board_str = "";
my %mark = ( "<" => "\>" , # Nick put the <>> symbols back here in place of their entities.
"\\" =>"\/" , # Nick substituted a > for its entity
")" =>"\(" , # Nick substituted a > for its entity
"]" =>"\[" ); # Nick substituted a > for its entity
if ($board_arr[0]{"edge"} =~ /[nt]/i) {
if ($board_arr[0]{"edge"} =~ /[lw]/i) {
$board_str .= "+";
}
$board_str .= '-' x ($#{$board_arr[1]} * 2 -1 );
if ($board_arr[0]{"edge"} =~ /[er]/i) {
$board_str .= "+";
}
}
if ($board_str) {
$board_str .= "\n";
}
## loop over the lines
my $i;
for $i (1 .. $#board_arr) {
if ($board_arr[0]{"edge"} =~ /[lw]/) {
$board_str .= "|";
}
## loop over the points
my $j;
for $j (1 .. $#{$board_arr[$i]}) {
## copy the point
$point = $board_arr[$i][$j];
## empty points (and hoshi) are handled automaticaly
if (1 == length($point)) {
$board_str .= $point . " ";
}
else {
## points with a length of more than two should not occur,
## so don't handle this case
$board_str .= $point;
}
## place a corresponding marker on the other side of the stone
## if if there is space
$board_str =~ s/ (.)([$go_utils_mark]$)/$mark{$2}$1$2/s;
}
if ($board_arr[0]{"edge"} =~ /[er]/) {
$board_str .= "|";
}
$board_str .= "\n";
}
if ($board_arr[0]{"edge"} =~ /[bs]/) {
if ($board_arr[0]{"edge"} =~ /[lw]/) {
$board_str .= "+";
}
$board_str .= '-' x ($#{$board_arr[1]} * 2 -1 );
if ($board_arr[0]{"edge"} =~ /[er]/) {
$board_str .= "+";
}
}
## put the right edge closer to the board if possible
my $tmp;
if ($#board_arr == ($tmp = $board_str) =~ s/ \|?$/\|/gs) {
$board_str = $tmp;
}
else {
$board_str =~ s/\-(\+?)$/\-\-$1/gs;
}
## return the board
$board_str;
} ## board2ascii
sub board2html {
##
## Converts the board to a html string of the board using
## the gif created by Andrew Grant
##
## Input:
## The location of the gifs
## The width of the gifs (in pixels)
## The height of the gifs (in pixels)
## A two dimensional array containing the board
## Output:
## A string containting the htm version of the board
## Remarks:
## Borders of are not implemented (yet)
##
my $location = shift;
my @board_arr = @_;
my $board_str = "";
## This following section, and all lines using variables declared in it,
## was added by nsw, 2003-01-02. This code provides the labels around
## the edge of the board.
my $labelleft = ( $board_arr[0]{"label"} =~ /[lw]/ );
my $labelright = ( $board_arr[0]{"label"} =~ /[er]/ );
my $labeltop = ( $board_arr[0]{"label"} =~ /[nt]/ );
my $labelbottom = ( $board_arr[0]{"label"} =~ /[bs]/ );
my $toplabel = $#board_arr;
if ( ! ( $board_arr[0]{'edge'} =~ /[bs]/i )
&& ( $board_arr[0]{'edge'} =~ /[nt]/i ) ) { $toplabel = 19; };
my $leftlabel = 1;
if ( ! ( $board_arr[0]{'edge'} =~ /[lw]/i )
&& ( $board_arr[0]{'edge'} =~ /[er]/i ) ) { $leftlabel = 20-$#{$board_arr[1]}; };
%letters = ( 1 => "A", 2 => "B", 3 => "C", 4 => "D", 5 => "E",
6 => "F", 7 => "G", 8 => "H", 9 => "J", 10 => "K",
11 => "L", 12 => "M", 13 => "N", 14 => "O", 15 => "P",
16 => "Q", 17 => "R", 18 => "S", 19 => "T", 20 => "U",
21 => "V", 22 => "W", 23 => "X", 24 => "Y", 25 => "Z" );
my $sizex = $board_arr[0]{'width'};
my $sizey = $board_arr[0]{'height'};
my $sizexx = $sizex * 5/3;
## End of board-labelling code.
## initial code
# $board_str .= "\n"; # Nick substituted a > for its entity
## loop over the lines
my $i;
my $l;
## $board_str .= "
command, ## other lines start with a new line ## Version 1.5 no <pre> arround the gifs anymore ## that is not valid HTML $board_str .= ($i == 1) ? "" : "
"; # Nick substituted < > for their entities if ( $labelleft ) { ## Nick added this labelling code, 2003-01-02 $l = $toplabel+1-$i; $board_str .= ""; } ## loop over the points my $j; for $j (1 .. $#{$board_arr[$i]}) { ## before the file name considerlinebreak(); ## line added by nsw, 2001-01-24 $board_str .= " 0) { # Nick substituted > for its entity ## make a number of this point (so 5< will be 5, markings will be removed) $point += 0; ## determine the color of this move (^ = XOR) my $color = ((uc($board_arr[0]{'pl'}) eq "W") ^ ($point % 2)) ? "b" : "w"; # uc(..) added by Nick $board_str .= "${color}${point}"; # Nick deleted some superfluous tabs from the end of this line } ## anything else is a label else { ## check if the label is upper or lower case $board_str .= ## upper or lower case label ((ord($point) < 96) ? "u" : "l") . # Nick substituted < for its entity "c" . lc(${point}); } ## the final part $board_str .= ".gif\""; ## Nick commented off the next twelve lines # if ($board_arr[0]{'width'}) { # $board_str .= " width=\"" . $board_arr[0]{'width'} . "\""; # } # if ($board_arr[0]{'height'}) { # $board_str .= " height=\"" . $board_arr[0]{'height'} . "\""; # } # if (defined $board_arr[0]{'alt'}) { # $board_str .= " alt=\"" . $board_arr[0]{'alt'} . "\""; # } # if (defined $board_arr[0]{'border'}) { # $board_str .= " border=\"" . $board_arr[0]{'border'} . "\""; # } $board_str .= ">"; # Nick substituted > for its entity } if ( $labelright ) { ## Nick added this labelling code, 2003-01-02 $l = $toplabel+1-$i; $board_str .= ""; } } $board_str .= "\n
\n"; ## line added 2002-08-29 if ( $labelbottom ) { ## Nick added this labelling code, 2003-01-02 if ( $labelleft ) { ## Nick added this, 2003-10-05 $board_str .= ""; } for $l ( 0 .. $#{$board_arr[1]}-1 ) { $board_str .= ""; } $board_str .= "\n
\n"; } ## return the board string $board_str; } ## board2html sub board2sgf { ## ## Converts a board to an SGF-string ## ## Input: ## A two dimensional array containing the board ## Output: ## A string containting the SGF-codes ## my $board = $_; my $sgf_str = ""; my $initial_black = ""; my $initial_white = ""; my $label = ""; my $MA = ""; my $SQ = ""; my $TR = ""; my $CR = ""; my @move = (); ## loop over the lines my $i; for $i (1 .. $#board) { ## loop over the points my $j; for $j (1 .. $#{$board[$i]}) { ## copy the point $point = $board[$i][$j]; $location = chr($j + 96) . chr($i + 96); ##print "$location: $point\n"; ## a black stone? if ($point =~ /^\#[$go_utils_mark]?$/) { $initial_black .= "[" . $location . "]"; } ## a white stone? elsif ($point =~ /^O[$go_utils_mark]?$/) { $initial_white .= "[" . $location . "]"; } ## a move elsif ($point > 0) { # Nick substituted > for its entity ## this will overwrite an exsisting move number $point $move[$point] = $location; } ## a label elsif ($point !~ /[.*][$go_utils_mark]?/) { #elsif ($point ne ".") { $label .= "[" . $location . ":" . $point . "]"; } ## a mark ## no elsif (any stone can be marked) if ($point =~ /^.\<$/) { $MA .= "[" . $location . "]"; } # Nick substituted < for its entity if ($point =~ /^.\]$/) { $SQ .= "[" . $location . "]"; } if ($point =~ /^.\\$/) { $TR .= "[" . $location . "]"; } if ($point =~ /^.\)$/) { $CR .= "[" . $location . "]"; } } ## loop over points } ## loop over lines ## add the tokens if the initial excists if ($initial_black) { $initial_black = "AB" . $initial_black; } if ($initial_white) { $initial_white = "AW" . $initial_white; } ## labels and markings if ($label) { $label = "LB" . $label; } if ($MA) { $label .= "MA" . $MA; } if ($SQ) { $label .= "SQ" . $SQ; } if ($TR) { $label .= "TR" . $TR; } if ($CR) { $label .= "CR" . $CR; } ## get the size of the board my $szy = $#board; ## a rectangular board is assumed, ## so the length of the first row ## is as good as any other my $szx = $#{$board[1]}; ## ## Inital information ## ## game 1 (go) $sgf_str .= "(;GM[1]\n"; ## SGF version 4 $sgf_str .= "FF[4]\n"; ## Program $sgf_str .= "AP[go-utils.pl:$go_utils_version_number]\n"; ## User $sgf_str .= "US[Toni Cornelissen (toni\@dse.nl)]\n"; ## Size ## Force a square board? if ($board[0]{'sq'}) { $sgf_str .= "SZ[" . (($szx > $szy) ? $szx : $szy) . "]"; # Nick substituted > for its entity } else { $sgf_str .= "SZ[$szx" . ( ($szx != $szy) ? ":$szy]" : "]"); } ## New line $sgf_str .= "\n"; ## ## Initial position ## $sgf_str .= ";$label$initial_black$initial_white\n"; ## What is the first move $sgf_str .= "PL[$board[0]{'PL'}]\n"; my $black_move = (uc($board[0]{'PL'}) eq "B"); ## ## The moves ## ## move 0 does not exist my $m; for $m (1 .. $#move) { ## new move so ; $sgf_str .= ";"; ## keep the labels $sgf_str .= $label; ## whose move is it anyway? $sgf_str .= $black_move ? "B" : "W"; ## the location of the move $sgf_str .= "[" . $move[$m] . "]"; ## New line $sgf_str .= "\n"; ## negotiate black move negate? $black_move = ! $black_move; } ## loop over the moves ## End $sgf_str .= ")\n"; } ## board2sgf sub considerlinebreak ## procedure added by nsw, 2001-01-24 { if ( ++$countline == $maxcountline ) { $countline = 0; $spacer = "\n"; } else { $spacer = "\n"; ## replaced " " by "\n". 2002-08-28. } } 1;