## ## 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 .= "

$board_arr[0]{\"label\"} T=$labeltop L=$labelleft R=$labelright B=$labelbottom

"; if ( $labeltop ) { ## 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 .= "\"$letters{$l+$leftlabel}\""; } $board_str .= "\n
\n"; } for $i (1 .. $#board_arr) { ## The board start with a
 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 .= "\"$l\""; } ## 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 .= "\"$l\""; } } $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 .= "\"$letters{$l+$leftlabel}\""; } $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;