Games::Cards::Bridge::Chicago - Object for Bridge (card game) Chicago scoring

  use Games::Cards::Bridge::Chicago;
  sub show_score {
    my $chi = shift;
    printf "NS = %d \t EW = %d\n", $chi->NS_score, $chi->EW_score;
    printf "  Vul:  NS = %d \t EW = %d\n", $chi->NS_vul, $chi->EW_vul;
    printf "==COMPLETE==\n" if $chi->complete;
  }
  my $chi = Games::Cards::Bridge::Chicago->new;

  show_score($chi);
  foreach my $opts (
    { declarer => 'N', trump => 'H', bid => '4', made => '4' },
    { declarer => 'S', trump => 'C', bid => '3', down => '2', dbl => 1 },
    { declarer => 'E', trump => 'N', bid => '3', made => '3' },
    { declarer => 'W', trump => 'D', bid => '5', down => '3' },
  ){
    $chi->contract( %$opts );
    show_score($chi);
  }

package Games::Cards::Bridge::Chicago;

use strict;
use warnings;

use base qw(Class::Accessor);
use Games::Cards::Bridge::Contract;
use Carp;

our $VERSION = '0.01';

__PACKAGE__->mk_accessors(
	'contracts',	# array ref
	# these are all auto-calculated
	# scores:
	'NS_score',
	'EW_score',
	'NS_vul',	# bool
	'EW_vul',	# bool
	'complete',	# bool
	'dealer',	# N E S W
);

sub both_vul {
  my $self = shift;
  return $self->NS_vul && $self->EW_vul;
}

sub __hand_setup {
  my $self = shift;
  my $hands_played = scalar @{$self->contracts};
  my %states = (
    # num_played => [ dealer, NS_vul, EW_vul ]
    0 => [ 'N', 0, 0 ],
    1 => [ 'E', 1, 0 ],
    2 => [ 'S', 0, 1 ],
    3 => [ 'W', 1, 1 ],
  );
  my $state = $states{$hands_played} or do {
    $self->set('complete', 1);
    return 0;
  };
  $self->set('dealer', $state->[0]);
  $self->set('NS_vul', $state->[1]);
  $self->set('EW_vul', $state->[2]);
  return 1;
}

sub new {
  my $self = shift;
  my $class = ref($self) || $self;
  $self = bless {}, $class;
  $self->set($_, 0) for qw/NS_score EW_score NS_vul EW_vul complete/;
  $self->set('contracts', []);
  $self->set('dealer', 'N');
  $self->__hand_setup();
  return $self;
}

sub contract {
  my $self = shift;
  my $p = {@_};
  my $NS = $p->{declarer} =~ /^[NS]$/;
  my $EW = !$NS;
  my $contract = Games::Cards::Bridge::Contract->new(
	declarer=> $p->{declarer},
	trump	=> $p->{trump},
	bid	=> $p->{bid},
	made	=> $p->{made},
	down	=> $p->{down},
	vul	=> ($NS ? $self->NS_vul : $self->EW_vul),
	penalty	=> $p->{dbl},
  );
  push @{$self->contracts}, $contract;
  my $score = $contract->duplicate_score;
  my $scoreProperty =
	($NS && $score>0) || ($EW && $score<0)
	? 'NS_score'
	: 'EW_score'
  ;
  $self->set($scoreProperty, $self->$scoreProperty + abs $score);
  $self->__hand_setup();
  return $contract;
}

1;