File Coverage

blib/lib/Chess/GameClock/GclkSettings.pm

Criterion	Covered	Total	%
statement	7	9	77.7
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	10	12	83.3

####-----------------------------------
### File	: GclkSettings.pm
### Author	: Ch.Minc
### Purpose	: Settings for GameClock
### Version	: 1.0 2006/1/26
####-----------------------------------


package GclkSettings ;

our $VERSION = '1.0' ;

use strict ;
use warnings ;

use Tk ;
use Tk::Radiobutton ;
use Tk::ProgressBar;
use Tk::Scale;
require Exporter ;

use Chess::GameClock::GclkData qw(:tout)  ;
#use Chess::GameClock::GclkDisplay qw(hmnsec loupe) ;

# aliasing
my @menu=@GclkData::menu ;
my %sous_menu=%GclkData::sous_menu ;
my %soussous=%GclkData::soussous ;
my %aide=%GclkData::aide ;
my @Mode=@GclkData::Mode ;
my %cad=%GclkData::cad ;

#use Chess::GameClock::GclkDisplay qw(hmnsec loupe) ;

our @ISA=qw(Exporter) ;

our @EXPORT_OK=qw (&menu ®lage $screensz) ;

our $varset ;
our $screensz ;

my %sous_menuref ;
my %soussous_ref ;
my %rb ;
my $wmv ;
my $wmb ;

our $whites ;
our $blacks ;
our $cadinit;


sub menu {
  ($whites,$blacks,$cadinit)=@_ ;

  $varset= $cadinit || "Blitz Usuel 0" ;
  $screensz=$screensz ||  2 ;

  # build main window menu

  my $mw=MainWindow->new(-title=>qq(Réglages Pendule)) ;
  $mw->geometry("320x6") ;
  #$mw->grabGlobal ;
  my $top=$mw->toplevel;

  my $menubar =$top->Menu(-type => 'menubar');
  $top->configure(-menu => $menubar);

  foreach my $m (@menu) {

    # creation des sous-menus en cascade
    $sous_menuref{$m} = $menubar->cascade(-label=>$m) ;

    # entrées des données des sous-menus

    map($soussous_ref{$m}{$_}= $sous_menuref{$m}->cascade(-label=>$_),@{$sous_menu{$m}});

  }

  foreach my $type (keys %soussous_ref) {
    for my $cadence (keys %{$soussous_ref{$type} }) {
      map {$rb{$type}{$cadence}[$_]=$soussous_ref{$type}{$cadence}->radiobutton(
										-indicatoron =>'1',
										-command=>[\®lage,$whites,$blacks,""],
										-label=>${$soussous{$type}{$cadence} }[$_],
										-variable=>\$varset,
										-value =>$type." ".$cadence . " ". $_) }   ( 0..$#{$soussous{$type}{$cadence} } ) ;
    }
  }
  for (qw/Cadence2 Cadence3 Cadence4/) {
    $rb{ReglagesManuels}{$_}[0]->configure (-state=>'disabled') ;
  }


  #$soussous_ref{Aide}{Bref}= $sous_menuref{Aide}->cascade(-label=>'En Bref') ;
  #my $cmd=$soussous_ref{Aide}{Bref}->command(-label=>'voir',-command=>\&voir) ;
  $sous_menuref{Aide}->command(-label=>'En Bref',-command=>[\&voir,%aide]) ;

  $soussous_ref{ReglagesManuels}{Options}->command(-label=>'Adjust',-command=>\&adjust) ;

  map {$rb{ReglagesManuels}{Mode}[$_]=$soussous_ref{ReglagesManuels}{Mode}->radiobutton(
											-indicatoron =>'1',
											-command=>sub{
											  #0=>x0.5,1,=>x0.75 2=>x1.00
											  &GclkDisplay::loupe(0.5+$screensz*0.25)},
											-label=>$Mode[$_],
											-variable=>\$screensz,
											-value =>$_) }   ( 0..$#Mode ) ;

  map {$rb{ReglagesManuels}{Mode}[$_]->configure (-state=>'disabled')} ( 0..$#Mode ) ; ;
}

sub adjust{
  use Tk::Spinbox ;

  my $sbxctw=MainWindow->new(-title=>qq(Adjustement Temps Blancs))
    ->Spinbox(-from=>'0',-to=>'1E6',-increment=>'1.0',-width=>'40' ) ;
  my $parentctw=$sbxctw->parent ;
  $parentctw->geometry("300x20+500+0") ;
  # my $val =$sbxctw->cget(-validate);
  # $sbxctw->configure(-validate => $val);
  $sbxctw->set($whites->[0]{ct})  ;
  $sbxctw->configure(-validate => 'key',
		     -command=>	sub{
		       $whites->[0]{ct}=$sbxctw->get ;
		     }
		    );
  $sbxctw->pack ;

  my $sbxctb=MainWindow->new(-title=>qq(Adjustement Temps Noirs))
    ->Spinbox(-from=>'0',-to=>'1E6',-increment=>'1.0',-width=>'40' ) ;
  my $parentctb=$sbxctb->parent ;
  $parentctb->geometry("300x20+500+50") ;
  $sbxctb->set($blacks->[0]{ct})  ;
  $sbxctb->configure(-validate => 'key',
		     -command=>	sub{
		       $blacks->[0]{ct}=$sbxctb->get ;
		     }
		    );
  $sbxctb->pack ;

  my $sbxmvw=MainWindow->new(-title=>qq(Adjustement Coups Blancs))
    ->Spinbox(-from=>'0',-to=>'1E6',-increment=>'1.0',-width=>'40' ) ;
  my $parentmvw=$sbxmvw->parent ;
  $parentmvw->geometry("300x20+820+0") ;
  $sbxmvw->set($whites->[0]{mv})  ;
  $sbxmvw->configure(-validate => 'key',
		     -command=>	sub{
		       my $diff=$whites->[0]{mv}-$sbxmvw->get ;
		       $whites->[0]{mv}-=$diff ;
                       $whites->[0]{mvt}-=$diff ;
		     }
		    );
  $sbxmvw->pack ;

  my $sbxmvb=MainWindow->new(-title=>qq(Adjustementcoups Noirs))
    ->Spinbox(-from=>'0',-to=>'1E6',-increment=>'1.0',-width=>'40' ) ;
  my $parentmvb=$sbxmvb->parent ;
  $parentmvb->geometry("300x20+820+50") ;
  $sbxmvb->set($blacks->[0]{mv})  ;
  $sbxmvb->configure(-validate => 'key',
		     -command=>	sub{
		       my $diff= $blacks->[0]{mv}-$sbxmvb->get ;
		       $blacks->[0]{mv}-=$diff ;
		       $blacks->[0]{mvt}-=$diff ;
		     }
		    );
  $sbxmvb->pack ;
}

sub voir {
  my %aide=@_ ;
  my $mwaide=MainWindow->new(-title=>"Help") ;
  my $b=$mwaide->Button(-text=>$aide{Fr}.$aide{En},
			-anchor=>'nw',
			-justify=>'left',
			-wraplength=>'250', # 0 par défaut
			-width=>'45')->pack(-fill=>'both') ;
  $b->configure(-text=>$aide{Fr}.$aide{En},
		-anchor=>'nw',
		-justify=>'left',
                -wraplength=>'250', # 0 par défaut
                -width=>'45');
}

sub reglage {

  ($whites,$blacks, my $cadence)=@_ ;

  # if $varset != Reglages Manuels init counter with $varset
  # note a call to menu before must call reglage as ($w,$b,"")
  # for not smashing $varset

  $varset= $cadence || $varset;

  print "reglage : $varset \n" ;


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

  my @status_var_h ;
  my @status_var_m ;
  my @status_var_s ;
  my @status_var_mv ;
  my $status_var_both=0 ;
  my $status_var_byo=1 ;
  my @status_var_bf ;
  my $status_bf ;
  my @set_hour ;
  my @set_mn ;
  my @set_sec ;
  my @set_mv ;
  my @set_fb ;
  my %proch1 ;

  if ($varset =~ /ReglagesManuels/) {
    my $mw = MainWindow->new(-title=>'Reglages Manuels');
    #$mw->configure(-background=>'blue') ;
    foreach (0,1) {
      $set_hour[$_]=$mw->Scale(-from =>0,-to =>12,-length=>'5c',-label=>"hrs ",-troughcolor=>'green',
			       -background=>'yellow',-variable=>\$status_var_h[$_])  ->pack(-side=>'left');
      $set_mn[$_]=  $mw->Scale(-from =>0,-to =>60,-length=>'5c',-label=>"mns ",-variable=>\$status_var_m[$_])  ->pack(-side=>'left');
      $set_sec[$_]= $mw->Scale(-from =>0,-to =>60,-length=>'5c',-label=>"secs",-variable=>\$status_var_s[$_])  ->pack(-side=>'left');
      $set_mv[$_]=  $mw->Scale(-from =>0,-to =>60,-length=>'5c',-label=>"coups",-variable=>\$status_var_mv[$_])->pack(-side=>'left');
      $set_fb[$_]=  $mw->Scale(-from =>0,-to =>60,-length=>'5c',-label=>"sec F/B",-variable=>\$status_var_bf[$_])->pack(-side=>'left');

      $set_fb[$_]->configure(	# -wraplength  =>'8',
				# -sliderlength=>'10',
				# -tickinterval=>'10',
			     -width       =>'10' ) ;
    }
    # backannotate
    my $t="ReglagesManuels" ;
    my @f=split(' ',$varset);
    my $c=$f[1] ;
    my $n=substr($c,7,1) ;
    my $i=0 ;			# mais cadence =[%cad1,%cad2,%cad3,%cad4]

    if (defined($whites->[$n]{ct})) {
      ($status_var_h[0],$status_var_m[0],$status_var_s[0])=&GclkDisplay::hmnsec($whites->[$n]{ct}) ;
      $status_var_mv[0]=$whites->[$n]{mv} ;
      $status_var_bf[0]=$whites->[$n]{b} + $whites->[$n]{f} ;
      $status_bf=$whites->[$n]{b} ? 0 : 1 ;
      $status_var_byo=$whites->[$n]{byo} ;
      ($status_var_h[1],$status_var_m[1],$status_var_s[1])=&GclkDisplay::hmnsec($blacks->[$n]{ct}) ;
      $status_var_mv[1]=$blacks->[$n]{mv} ;
      $status_var_bf[1]=$blacks->[$n]{b} + $blacks->[$n]{f} ;
      #$status_var_byo[1]=$blacks->[$n]{byo} ;  unicity of type
    }
    my $b=$mw->Button(-text=>'valider',
                      -command=>sub{
			foreach (0..1) {
			  $default[$_]{byo}=$status_var_byo ? 0 : 1 ;
			  my $j ;
			  $j=$status_var_both ==1 ? 0 :$_ ;
			  $default[$_]{ct}=60*($status_var_h[$j]*60+$status_var_m[$j])+$status_var_s[$j] ;
			  $default[$_]{mv}=$status_var_mv[$j] ;
			  $status_bf ?  $default[$_]{f}=$status_var_bf[$j] : $default[$_]{b}=$status_var_bf[$j] ;
			}
			;
			#			my $t="ReglagesManuels" ;
			#  my $c="Cadence1" ;
			#			my @f=split(' ',$varset);
			#			my $c=$f[1] ;
			#			my $i=0 ; # mais cadence =[%cad1,%cad2,%cad3,%cad4]
			map{ $cad{$t}{$c}[$i]{$_}=$default[0]{$_} } (qw/ct mv b f byo/)  ;
			$whites->init($varset,'blancs') ;
			map {$cad{$t}{$c}[$i]{$_}=$default[1]{$_}} (qw/ct mv b f byo/)  ;
			$blacks->init($varset,'noirs') ;
			# enable next cadence selection
			map {$proch1{"Cadence" . $_}="Cadence". ($_+1) } (0..4);
			$rb{ReglagesManuels}{$proch1{$c}}[0]->configure(-state=>'normal') if(defined($rb{ReglagesManuels}{$proch1{$c} }[0])) ;
			$mw->destroy ; })->pack(-side=>'bottom') ;

    my $bb=  $mw->Radiobutton(-text=>'Bronstein',-variable=>\$status_bf,-value=>'0')->pack(-side=>'bottom') ;
    my $bf=  $mw->Radiobutton(-text=>'Fisher   ',-variable=>\$status_bf,-value=>'1')->pack(-side=>'bottom') ;
    $status_bf ? $bf->select:$bb->select ;
    my $both=$mw->Checkbutton(-text=>'Jumelé   ',
                              -variable=>\$status_var_both,
                              -command=>sub{
				my $i=$status_var_both ? 0 : 1 ;
				$set_hour[1]->configure(-variable => \$status_var_h[$i]);
				$set_mn[1]  ->configure(-variable => \$status_var_m[$i]);
				$set_sec[1] ->configure(-variable => \$status_var_s[$i]);
				$set_mv[1]  ->configure(-variable => \$status_var_mv[$i]);
				$set_fb[1]  ->configure(-variable => \$status_var_bf[$i]);
			      }
			     )->pack(-side=>'bottom') ;
    my $byoyomi=$mw->Checkbutton(-text=>'Byo-Yomi ',
				 -variable=>\$status_var_byo
				)->pack(-side=>'bottom') ;
    $status_var_byo ? $byoyomi->deselect: $byoyomi->select ;
    $both->deselect ;
    #$both->invoke ;

  } else {
    $whites->init($varset,'blancs') ;
    $blacks->init($varset,'noirs') ;
  }
}
=head1 NAME

  GclkSettings - For setting the parameters with a GUI.

=head1 VERSION

Version 1.0

=cut


=head1 SYNOPSIS

This module is a GUI to set the parameters of GameClock.

=head1 EXPORT

&menu
®lage

=head1 FUNCTIONS

=head2 menu

Generate the menu window of the GUI

=cut

=head2 adjust

This routine is done to adjust the time and
move number of each players, not for the initial setting.

The main reason is for correcting mistakes
or for arbiters, when playing.

Of course, this must be done in halt mode,
but there is no check.

Note: the return key does not validate,
only the spin buttons can do that.

=head2 reglage

This routine provides the interface for
the manuel setting of data via ProgressBars

=cut

=head2 voir

A routine to show a hint in the menu

=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 GclkSettings