File Coverage

blib/lib/Chess/GameClock/GclkCounter.pm

Criterion	Covered	Total	%
statement	10	12	83.3
branch			n/a
condition			n/a
subroutine	4	4	100.0
pod			n/a
total	14	16	87.5

#!/usr/bin/perl -w
####-----------------------------------
### File	: GclkCounter.pm
### Author	: Ch.Minc
### Purpose	: Package for Counter
### Version	: 1.0 2006/1/26
### copyright GNU license
####-----------------------------------

package GclkCounter ;

our $VERSION = '1.0' ;

require Exporter ;
use warnings;
use strict;


use Time::HiRes qw(gettimeofday tv_interval);
use Tk ;
use Tk::Dialog ;

use Chess::GameClock::GclkData qw(:tout) ;

my %cad=%GclkData::cad ;

our @ISA=qw(Exporter) ;

our @EXPORT_OK=qw (&capture &stop $start) ;

sub new {
  my ($class,@args)=@_ ;
  my $self=[{}] ;
  return bless ($self,$class) ;
}


sub init {
  #build  the counter data array
  #usage $self->init(@values) i.e cadence color
  my ($self,$arg,$col)=@_ ;

  #my @default= ( {ct=>'0',   #cadence 1
  #               mv=>'0', # if 0 means KO else number of moves
  #               b=>'0',   # fisher ou bronstein
  #               f=>'0',
  #               byo=>'0'   # byo mode no time glue
  #                }
  #              ) ;

  my $rec;
  my @default ;
  my ($t,$c,$i)=split(' ',$arg) ;
  # concaténation des cadences si Cadence
  if ($c =~ /Cadence(\d)/) {
    for (1..$1) {
      @default=(@default,$cad{$t}{"Cadence" . $_}[$i]) ;
    }
  } else {
    for my $j (0..$#{$cad{$t}{$c}[$i]} ) {
      @default=(@default,$cad{$t}{$c}[$i][$j]);
    }
    ;
  }

  for (0..$#default) {
    my $st=$default[$_]{ct} ;
    $default[$_]{'ct'}=eval($st) ;warn $@ if $@;
  }

  @{$self}=( {state=>'Off',
	      newstate=>'Off',
	      color=>$col ,
	      mouse=>'',
	      cmpt=>'0',	# compteur temps joué
	      ct=>'0' ,		# temps disponible
	      mvt=>'0',		# number of moves
              mv=>'0',          # number of moves inside a cadence
	      ts=>'0',		# timestamp
	      indc=>'1'}) ;

  for my $k (0..$#default) {
    map {$self->[$k+1]{$_}=$default[$k]{$_} }  (qw/ct mv b f byo/)  ;
  }

  #  use Dumpvalue;
  #  my $dumper = new Dumpvalue;
  #  $dumper->dumpValues(@{$self});
}

sub cntupdate {
  # active increment of counter
  my $self=shift ;
  my $tod=shift ;
  my $icad=$self->[0]{indc} ;	# indc pointe sur la cadence en cours

  if ( $self->[0]{state} eq "Off" &&  $self->[0]{newstate} eq "On") {
    #    $self->[0]{b}= $self->[$icad]{b} ; ### f ???
    $self->[0]{state}= $self->[0]{newstate} ;
    $self->[0]{ts}=$tod ;
  }

  # add on time when fisher is on and elapsed time or substracted
  # bronstein time
  if ( $self->[0]{state} eq "On" &&  $self->[0]{newstate} eq "Off") {
    my $delta=tv_interval($self->[0]{ts});
    $self->[0]{cmpt}+=$delta ;

    if ($self->[$icad]{byo}==1) {
      $self->[0]{ct}-=$delta ;
      $self->[0]{ct}+=$self->[$icad]{f}+ ($delta <= $self->[$icad]{b} ?$delta: $self->[$icad]{b}) ;
    }
    $self->[0]{state}= $self->[0]{newstate} ;

    # update move
    ($self->[0]{mv})++ ;
    ($self->[0]{mvt})++ ;

    # check limits
    #if mv = 0 means KO unless byo==0
    #if mv !=0 && last cadence loop on that cadence

    if (( $self->[0]{mv} ==  $self->[$icad]{mv}) && $self->[$icad]{mv} !=0 ) {

      # update  time limit & next cadence ,time checked in on-on

      $self->[0]{mv}=0 ;
      $self->[0]{indc}=$icad<$#{$self}? ++$icad : $#{$self} ;
      if ( $self->[$icad]{byo} ==0 && $self->[$icad]{b} !=0 ) { # japonais
	$self->[0]{ct}=
	  $self->[$icad]{b}*(int($self->[0]{ct}/$self->[$icad]{b})-int($delta/$self->[$icad]{b}));
      } else {
	$self->[0]{ct}=$self->[$icad]{ct}+ $self->[0]{ct}*$self->[$icad]{byo} ; # si b=0  canadien

      }
    }


    # byo-yomi japonais
    # deux cadences main time
    if ($self->[$icad]{mv} ==0 && $self->[$icad]{byo} ==0 ) {
      $self->[0]{ct} -=$delta ;
      #  main time épuisé passage au byo-yomi (dans $self->[icad]{b} !=0 )
      if ($self->[0]{ct} <= 0 ) {
        $self->[0]{mv}=0 ;
	$self->[0]{indc}=$icad<$#{$self}? ++$icad : $#{$self} ;
	$self->[0]{ct} +=$self->[$icad]{ct} ;
	# normalisation byo-yomi
	#	my $d1=int($self->[0]{ct}/$self->[$icad]{b}) ;
	#	my $d2=int($delta/$self->[$icad]{b}) ;
	#	$self->[0]{ct}=$self->[$icad]{b}*($d1-$d2) ;
      }

    }

  }


  #  if( $self->[0]{state} eq "Off" &&  $self->[0]{newstate} eq "Off"){
  #  # nothing to do
  #$self->print ;
  #  }


  if ( $self->[0]{state} eq "On" &&  $self->[0]{newstate} eq "On") {

    my $tchk ;
    # time limit
    if ($self->[$icad]{byo} ) {
      $tchk=$self->[$icad]{b} + $self->[0]{ct}-tv_interval($self->[0]{ts}) ;

    } else {
      # valable avant le byo-yomi -----$icad=2
      $tchk=$self->[0]{ct}-tv_interval($self->[0]{ts})  ;

    }
    unless (0<=$tchk ) {
      print "lost \n" ;
      my $lmw=MainWindow->new ;
      $lmw->withdraw ;
      $lmw->messageBox(-icon =>'info',
		       -message =>"GameOver for (Dépassement de temps pour les) $self->[0]{color}",
		       -title => 'GameClock Warning',
		       -type => 'Ok',
		       -default => 'Ok' ) ;
      $lmw->destroy ;
      return ;
    }
  }

}
sub start{

  #$cnt->start($cnt,$cnt_black,Mouse)
  #bouton start (re)initialise
  #mais ce sont les Noirs  mettent en marche
  my ($self,$wself,$bself,$mw,$white_mv,$black_mv)=@_ ;

  undef($wself->[0]{mouse}) ;
  undef($bself->[0]{mouse}) ;
  $wself->[0]{indc}=1 ;
  $bself->[0]{indc}=1 ;
  # time limits
  $wself->[0]{ct}=$wself->[1]{ct} ;
  $bself->[0]{ct}=$bself->[1]{ct} ;
  $wself->[0]{cmpt}=0 ;
  $bself->[0]{cmpt}=0 ;
  # reset move counters
  $wself->[0]{mv}=0 ;
  $bself->[0]{mv}=0 ;
  $wself->[0]{mvt}=0 ;
  $bself->[0]{mvt}=0 ;
  # state
  $wself->[0]{newstate}='Off';
  $bself->[0]{newstate}='Off' ;
  $wself->[0]{state}='Off';
  $bself->[0]{state}='Off' ;
  # Fix a bug :move counter don't show the value
  # after a setting with ®lage ?
  $white_mv->configure(-textvariable=>\$wself->[0]{mvt}) ;
  $black_mv->configure(-textvariable=>\$bself->[0]{mvt}) ;

  $mw->bind('',[\&capture, Ev('s'),$wself,$bself]) ;
  ##
  print "Counters ready to start\n" ;

}

sub stop{
  our @pile ;
  my ($mw,$but,$wself,$bself,@arg)=@_ ;

  # etat du bouton
  my $col=$but->cget(-background) ;
  if ($col eq 'red') {
    # etat rouge -arret
    $but->configure(-background=>pop @pile) ;
    $but->configure(-activebackground=>pop @pile) ;
    $bself->[0]{state}=pop @pile ;
    $wself->[0]{state}=pop @pile ;

    # actualise le timestamp
    my $self=$wself->[0]{state} eq 'On'?$wself:$bself ;
    $self->[0]{ts}=[gettimeofday];
    $mw->bind('',[\&capture, Ev('s'),$wself,$bself]) ;
  } else {
    # etat non rouge - marche
    # actualise les compteurs- passe à l'arret
    my $self=$wself->[0]{state} eq 'On'?$wself:$bself ;
    my $delta=tv_interval($self->[0]{ts});
    $self->[0]{cmpt}+=$delta ;
    $self->[0]{ct}-=$delta ;
    $mw->bind('',"") ;

    # sauve l'etat du bouton et des compteurs
    push(@pile,$wself->[0]{state} ) ;
    push(@pile,$bself->[0]{state} ) ;
    push(@pile,$but->cget(-activebackground)) ;
    push(@pile,$col) ;

    # bloque les compteurs
    $wself->[0]{state}='Off' ;
    $bself->[0]{state}='Off' ;
    $but->configure(-activebackground=>'red') ;
    $but->configure(-background=>'red') ;
  }
  ;
  ## a faire reactiver start en arret
  #print "pile:@pile \n" ;
}

sub capture{
  my ($hashref,$mouse,$whites,$blacks )=@_ ;
  my $tod=[gettimeofday];
  my   ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday) = gmtime(time);
  # appel à l'init sans click
  $mouse=~ s/-// ;		# Ev('s') return Bn-
  if (!defined($whites->[0]{mouse})) {
    my $cb=$mouse eq 'B1' ;
    ($mouse eq 'B1') ? $blacks->[0]{mouse}='B1': $whites->[0]{mouse}='B1' ;
    ($mouse eq 'B3') ? $blacks->[0]{mouse}='B3': $whites->[0]{mouse}='B3' ;
  }
  # set the new counters state
  if ( $mouse eq $whites->[0]{mouse}) {
    $whites->[0]{newstate} ="Off" ;
    $blacks->[0]{newstate} ="On" ;
  } else {
    $whites->[0]{newstate} ="On" ;
    $blacks->[0]{newstate} ="Off" ;
  }
  $whites->cntupdate($tod) ;
  $blacks->cntupdate($tod) ;

  # print into the log

  my $str=sprintf("%02d:%02d:%02d",$hour,$min,$sec) ;
  print
    "Time: $str \n
     Whites move: $whites->[0]{mvt} whites time Av.:$whites->[0]{ct} #$whites->[0]{mv}\n
     Blacks move: $blacks->[0]{mvt} Blacks time Av.:$blacks->[0]{ct} #$blacks->[0]{mv}\n" ;

   }

sub print{
  my $self=shift ;
  #print " Counter elem: $$self[0]{state} \n" ;
  #print " Counter elem: $self->[0]->{state} \n" ;
  #print " Counter elem: $self->[0]{state} \n" ;
  # print the whole thing with refs
  for my $href ( @{$self} ) {
    print "{ ";
    for my $t ( keys %$href ) {
      print "$t=$href->{$t} ";
    }
    print "}\n";
  }
}


=head1 NAME

  GclkCounter - The Heart of GameClock

=head1 VERSION

Version 1.0

=cut

=head1 SYNOPSIS

This module does everythings at counter level.
It makes counters,inits them, update them, captures events,
start , halt , eventually print the internal datas

    use GclkCounter;

    $whites=GclkCounter->new ;
    $whites->init($arg,$color) ;
    $whites-> cntupdate{$timestamp);
    $whites->print ;
#  the functions hereafter are only used  inside callbacks
    &start($whites,$blacks,$mainwindow,$white_move_button,$black_move_button)= ;
    &stop($halt_button,$whites,$blacks) ;
    &capture($mouse_event,$whites,$blacks ) ;

=head1 EXPORT

&capture
&stop
$start

=head1 FUNCTIONS

=head2 new ;

Create object GclkCounter

=cut

=head2 init

  Get the parameters from GameClock directly or via Gamesettings
  and adapts the datas for the counters

=head2 cntupdate

When an event more precisely a mouse button is
released the state of the counter changes.
This determines the following actions:

=over 4

=item * Change the counter states.

=item * Check times

=item * Update the time counters

=item * Update the move counters

=item * Update the sequence pointers

=back

=head2 capture

When a mouse event occurs the first time
after enabling the start mode, it determines
the mouse button for each player, knowing that
the Blacks must push the button at first.
It set the newsate of each counter accorging
to the mouse button pressed, and after that,
it gets a timestamp for calling the methode cntupdate.

=cut

=head2 start

Initialization of the program to begin
the counting mode.

=cut

=head2 stop

This routines halt counters , necessary if
one player receive a phone call in a friendly
situation ;=) or in some case, when people need
that an arbiter comes.

=cut

=head2 print

Could help for people that wants add new cadences.

=cut


=head1 AUTHOR

Charles Minc, C<<  >>

=head1 BUGS

Please report any bugs or feature requests to
C, or through the web interface at
L.
I will be notified, and then you'll automatically be notified of progress on
your bug as I make changes.

=head1 SUPPORT

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

    perldoc GameClock

You can also look for information at:

=over 4

=item * AnnoCPAN: Annotated CPAN documentation

L

=item * CPAN Ratings

L

=item * RT: CPAN's request tracker

L

=item * Search CPAN

L

=back

=head1 ACKNOWLEDGEMENTS

=head1 COPYRIGHT & LICENSE

Copyright 2006 Charles Minc, all rights reserved.

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

=cut

  1;				# End of GclkCounter