##
## 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 "<br>".
##
## 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
#  $board_str .= "  generated HTML code\n";
#  $board_str .= "  go-utils $go_utils_version_number\n";
#  $board_str .= "  by Toni Cornelissen (toni\@dse.nl)\n";
#  $board_str .= "  using Andrew Grant's gif's\n\n";
#  $board_str .= "  Don't insert line breaks in this code,\n";
#  $board_str .= "  line breaks may cause blank horizontal lines.\n";
#  $board_str .= "-->\n";     # Nick substituted a > for its entity

  ## loop over the lines
  my $i;
  my $l;
## $board_str .= "<h3>$board_arr[0]{\"label\"} T=$labeltop L=$labelleft R=$labelright B=$labelbottom</h3>";

  if ( $labeltop ) {           ## Nick added this labelling code, 2003-01-02
    if ( $labelleft ) {        ## Nick added this, 2003-10-05
      $board_str .= "<img src=\"http://www.weddslist.com/cgi-bin/go-label.pl?height=$sizey&width=$sizexx&text= \" alt=\" \">";
    }
    for $l ( 0 .. $#{$board_arr[1]}-1 ) {
      $board_str .= "<img src=\"http://www.weddslist.com/cgi-bin/go-label.pl?height=$sizey&width=$sizex&text=$letters{$l+$leftlabel}\" alt=\"$letters{$l+$leftlabel}\">";
    }
    $board_str .= "\n<br>\n";
  }

  for $i (1 .. $#board_arr) {

    ## The board start with a <pre> command,
    ## other lines start with a new line
    ## Version 1.5 no &lt;pre&gt; arround the gifs anymore
    ## that is not valid HTML
    $board_str .= ($i == 1) ? "" : "<br>";  # Nick substituted < > for their entities

    if ( $labelleft ) {           ## Nick added this labelling code, 2003-01-02
      $l = $toplabel+1-$i;
      $board_str .= "<img src=\"http://www.weddslist.com/cgi-bin/go-label.pl?height=$sizey&width=$sizexx&text=$l\" alt=\"$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 .= "<img${spacer}src=\"${location}";   # Nick substituted a < for its entity
                                    ## above line modified by nsw, 2001-01-24

      ## copy the point
      $point = $board_arr[$i][$j];

      if ($point eq ".") {
        ## check on borders
        ## bordes have no effect on stones or markings,
        ## hoshi are not places on borders
        ## boards with a width or height of 1 are not handled correctely

        ## north
        if (($i == 1) && ($board_arr[0]{'edge'} =~ /[nt]/i)) {       # Nick substituted && for their entities
          if (($j == 1) && ($board_arr[0]{'edge'} =~ /[lw]/i)) {     # Nick substituted && for their entities
            $board_str .= "ulc";
          }
          elsif (($j == $#{$board_arr[1]}) && ($board_arr[0]{'edge'} =~ /[er]/i)) {   # Nick substituted && for their entities
            $board_str .= "urc";
          }
          else {
            $board_str .= "ts";
          }
        }
        ## south
        elsif (($i == $#board_arr) && ($board_arr[0]{'edge'} =~ /[bs]/i)) {           # Nick substituted && for their entities
          if (($j == 1) && ($board_arr[0]{'edge'} =~ /[lw]/i)) {                      # Nick substituted && for their entities
            $board_str .= "llc";
          }
          elsif (($j == $#{$board_arr[1]}) && ($board_arr[0]{'edge'} =~ /[er]/i)) {   # Nick substituted && for their entities
            $board_str .= "lrc";
          }
          else {
            $board_str .= "bs";
          }
        }
        ## west
        elsif (($j == 1) && ($board_arr[0]{'edge'} =~ /[lw]/i)) {                     # Nick substituted && for their entities
          $board_str .= "ls";
        }
        ## east
        elsif (($j == $#{$board_arr[1]}) && ($board_arr[0]{'edge'} =~ /[er]/i)) {     # Nick substituted && for their entities
          $board_str .= "rs";
        }
        ## center
        else {
          $board_str .= "p";
        }
      }
      ## hoshi
      elsif ($point eq "*") {
        $board_str .= "h";
      }
      ## a marked sport
      elsif ($point =~ /^[.*][$go_utils_mark]$/) {
        $board_str .= "ucx";
      }
      ## a black stone
      elsif ($point eq "#") {
        $board_str .= "b";
      }
      ## a marked black stone
      elsif ($point =~ /^\#[$go_utils_mark]$/) {
        $board_str .= "bt";
      }
      ## a white stone?
      elsif ($point eq "O") {
        $board_str .= "w";
      }
      ## a marked white stone
      elsif ($point =~ /^\O[$go_utils_mark]$/) {
        $board_str .= "wt";
      }
      ## a move
      elsif ($point > 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 .= "<img src=\"http://www.weddslist.com/cgi-bin/go-label.pl?height=$sizey&width=$sizexx&text=$l\" alt=\"$l\">";
    }

  }
  $board_str .= "\n<br>\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 .= "<img src=\"http://www.weddslist.com/cgi-bin/go-label.pl?height=$sizey&width=$sizexx&text= \" alt=\" \">";
    }
    for $l ( 0 .. $#{$board_arr[1]}-1 ) {
      $board_str .= "<img src=\"http://www.weddslist.com/cgi-bin/go-label.pl?height=$sizey&width=$sizex&text=$letters{$l+$leftlabel}\" alt=\"$letters{$l+$leftlabel}\">";
    }
    $board_str .= "\n<br>\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;