view release on metacpan or  search on metacpan

lib/Games/Go/AGA/DataObjects/Game.pm  view on Meta::CPAN

#===============================================================================
#
#         FILE:  Games::Go::AGA::DataObjects::Game.pm
#
#        USAGE:  use Games::Go::AGA::DataObjects::Game;
#
#      PODNAME:  Games::Go::AGA::DataObjects::Game
#     ABSTRACT:  model an AGA game
#
#       AUTHOR:  Reid Augustin (REID), <reid@hellosix.com>
#      CREATED:  11/19/2010 03:13:05 PM PST
#===============================================================================

use strict;
use warnings;

# the Game class is useful for tournament pairing
package Games::Go::AGA::DataObjects::Game;
use Moo;
use namespace::clean;

use Carp;
use Scalar::Util qw(refaddr weaken);
use Try::Tiny;
use Games::Go::AGA::Parse::Util qw( Rank_to_Rating );
use Games::Go::AGA::DataObjects::Types qw( isa_Int isa_CodeRef isa_Handicap isa_Komi );

our $VERSION = '0.152'; # VERSION

sub isa_Player   { die("$_[0] is not a Games::Go::AGA::DataObjects::Player\n") if (ref $_[0] ne 'Games::Go::AGA::DataObjects::Player') }
has black    => (
    is       => 'rw',
    isa      => \&isa_Player,
    weak_ref => 1, # Players have Games, Games have Players, so weaken
    trigger  => sub
        {
            my $self = shift;
            $self->_set_player('black', @_);
        },
);
has white    => (
    is       => 'rw',
    isa      => \&isa_Player,
    weak_ref => 1,
    trigger  => sub
        {
            my $self = shift;
            $self->_set_player('white', @_);
        },
);
has table_number    => (
    is       => 'rw',
    isa      => \&isa_Int,
    lazy => 1,
    default  => sub { 0 },
    trigger  => sub { shift->changed; },
);
has handi    => (
    is       => 'rw',
    isa      => \&isa_Handicap,
    lazy => 1,
    default  => sub { 0 },
    trigger  => sub { shift->changed; },
#   alias    => 'handicap',
);
has komi     => (
    is       => 'rw',
    isa      => \&isa_Komi,
    lazy => 1,
    default  => sub { 5.5 },
    trigger  => sub { shift->changed; },
);
has result   => (
    is       => 'rw',
    lazy => 1,
    default  => '?',
    trigger  => sub {
        my ($self, $new) = @_;

        if (ref $new) {     # better be a Games::Go::AGA::DataObjects::Player
            my $id = $new->id;
            if ($id eq $self->white->id) { $self->result('w'); return }
            if ($id eq $self->black->id) { $self->result('b'); return }
        }
        $new ||= '?';
        $new = lc $new;
        if ($new ne '?' and $new ne 'w' and $new ne 'b') {
            croak("result must be '?' (or false), 'w', 'b', or one of the players\n");
        }
        $self->{result} = $new;
        $self->changed;
    },
);
has change_callback   => (