Games::SGF::Go - A Go Specific SGF Parser

Games-SGF documentation Contained in the Games-SGF distribution.

Index

Code Index:

NAME

Top

Games::SGF::Go - A Go Specific SGF Parser

VERSION

Top

Version 0.993

SYNOPSIS

Top

  use Games::SGF::Go;

  my $sgf = new Games::SGF::Go;

  $sgf->readFile('somegame.sgf');

  # fetch Properties
  my $komi = $sgf->property('KM');
  my $handicap = $sgf->property('HA');

  # move to next node
  $sgf->next;

  # get a move
  my $move = $sgf->property('B');

  # add it to a board

  $board[ $move->[0] ][ $move->[1] ] = 'B';

DISCRIPTION

Top

Games::SGF::Go Extends Games::SGF for the game specifics of Go. These include adding the tags 'TB', 'TW', 'HA', and 'KM'. It will also parse and check the stone, move, and point types.

The stone, move and point types will be returned as an array ref containing the position on the board.

You can set application specific tags using setTag in Games::SGF. All the callbacks to Games::SGF have been set and thus can't be reset.

All other methods from METHODS in Games::SGF can be used as you normally would.

METHODS

Top

new

  my $sgf = new Games::SGF::Go;

This will create the Games::SGF::Go object.

point

stone

move

  $struct = $self->move(@cord);
  @cord = $self->move($struct);

If a point, stone, or move is passed in, it will be broken into it's parts and returned. If the parts are passed in it will construct the internal structure which the parser uses.

These override point in Games::SGF, stone in Games::SGF, and move in Games::SGF.

isPass

   $sgf->isPass($move);

The method will return true if the move was a pass.

This is represented in the SGF as an empty string:

  ;B[];W[]

pass

   $move = $sgf->pass;

This will return a $move which is a pass.

ALSO SEE

Top

Games::SGF

http://www.red-bean.com/sgf/go.html

AUTHOR

Top

David Whitcomb, <whitcode at gmail.com>

BUGS

Top

Please report any bugs or feature requests to bug-games-sgf at rt.cpan.org, or through the web interface at http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Games-SGF. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes

SUPPORT

Top

You can find documentation for this module with the perldoc command.

    perldoc Games::SGF::Go

You can also look for information at:

* RT: CPAN's request tracker

http://rt.cpan.org/NoAuth/Bugs.html?Dist=Games-SGF

* AnnoCPAN: Annotated CPAN documentation

http://annocpan.org/dist/Games-SGF

* CPAN Ratings

http://cpanratings.perl.org/d/Games-SGF

* Search CPAN

http://search.cpan.org/dist/Games-SGF

ACKNOWLEDGEMENTS

Top

COPYRIGHT & LICENSE

Top

Copyright 2008 David Whitcomb, all rights reserved.

This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. .

Games-SGF documentation Contained in the Games-SGF distribution. 
package Games::SGF::Go;

use strict;
use warnings;
require Games::SGF;
no warnings 'redefine';


our( @ISA ) = ('Games::SGF');
our $VERSION = 0.993;


sub new {
   my $inv = shift;
   my $class = ref $inv || $inv;
   my $self = $class->SUPER::new(@_);

   # add Go Tags

   # Territory Black
   $self->addTag('TB', $self->T_NONE, $self->V_POINT,
            $self->VF_EMPTY | $self->VF_LIST | $self->VF_OPT_COMPOSE);

   # Territory White
   $self->addTag('TW', $self->T_NONE, $self->V_POINT,
            $self->VF_EMPTY | $self->VF_LIST | $self->VF_OPT_COMPOSE);

   # Handicap
   $self->addTag('HA', $self->T_GAME_INFO, $self->V_NUMBER);

   # Komi
   $self->addTag('KM', $self->T_GAME_INFO, $self->V_REAL);

   
   # redefine tags so that stone becomes point
   $self->redefineTag('AB', "", $self->V_POINT,
               $self->VF_LIST | $self->VF_OPT_COMPOSE);
   $self->redefineTag('AW', "", $self->V_POINT,
               $self->VF_LIST | $self->VF_OPT_COMPOSE);

   # add Go CallBacks
   # Read
   $self->setPointRead( sub { 
         return $self->point( _readPoint($_[0]) );
   });
   $self->setMoveRead( sub {
      if( $_[0] eq "" ) {
         return $self->pass;
      } else {
         return $self->move( _readPoint($_[0]));
      }
   });

   # Check
   $self->setPointCheck(\&_checkPoint);
#   $self->setStoneCheck(\&_checkPoint);
   $self->setMoveCheck( sub {
      if( $self->isPass($_[0]) ) {
         return 1;
      } else {
         return &_checkPoint($_[0]);
      }
   });

   # Write
   $self->setPointWrite( \&_writePoint );
#   $self->setStoneWrite( \&_writePoint );
   $self->setMoveWrite( sub {
         if( $self->isPass( $_[0] ) ) {
            return "";
         } else {
            _writePoint($_[0]);
         }
      });
   

   return bless $self, $class; # reconsecrate
}

# SGF -> internal
sub _readPoint {
   my $text = shift;
   my( @cord ) = split //, $text;
   
   foreach( @cord ) {
      if( $_ ge 'a' and $_ le 'z' ) {
         $_ = ord($_) - ord('a'); # 0 - 25
      } elsif( $_ ge 'A' and $_ le 'Z' ) {
         $_ = ord($_) - ord('A') + 26; # 26 - 51
      } else {
         #error;
      }
   }
   return @cord;
}

# checks internal
sub _checkPoint {
   my $struct = shift;
   return 0 if @$struct <= 0;
   foreach( @$struct ) {
      if( /\D/ ) {
         return 0;
      }
      if( $_ < 0 or $_ > 52 ) {
         return 0;
      }
   }
   return 1;
}

# internal -> SGF
sub _writePoint {
   my $struct = shift;
   my $text = "";
   foreach(@$struct) {
      if( $_ < 26 ) {
         $text .= chr( ord('a') + $_ );
      } else {
         $text .= chr( ord('A') + $_ - 26 );
      }
   }
   return $text;
}


# if passed @cord will return @cord again
sub point {
   my $self = shift;
   if( $self->isPoint($_[0]) ) {
      return @{$_[0]};
   } else {
      return bless [@_], 'Games::SGF::Go::point';
   }
}
sub move {
   my $self = shift;
   if( $self->isMove($_[0]) ) {
      return @{$_[0]};
   } else {
      return bless [@_], 'Games::SGF::Go::move';
   }
}
sub stone {
   my $self = shift;
   if( $self->isStone($_[0]) ) {
      return @{$_[0]};
   } else {
      return bless [@_], 'Games::SGF::Go::stone';
   }
}


sub isPass {
   my $self = shift;
   my $move = shift;

   if( $self->isMove($move) ) {
      if( $move->[0] eq "" ) {
         return 1;
      }
   }
   return 0;
}


sub pass {
   my $self = shift;
   return $self->move("");
}

1;
__END__