view release on metacpan or  search on metacpan

lib/Chess/GameClock/GclkSettings.pm  view on Meta::CPAN

####-----------------------------------


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 &reglage $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=>[\&reglage,$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 ;
		     }