File Coverage

lib/Games/Sudoku/Component/TkPlayer/Selector.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

package Games::Sudoku::Component::TkPlayer::Selector;
{
  use strict;
  use warnings;
  use Carp;

  use Tk::widgets qw/Toplevel/;
  use base qw/Tk::Toplevel/;

  Construct Tk::Widget 'Selector';

  sub Populate {
    my $this = shift;

    $this->SUPER::Populate(@_);
    $this->transient($this->Parent->toplevel);
    $this->withdraw;
    $this->{result} = undef;
    $this->protocol(
      'WM_DELETE_WINDOW' => sub { $this->{result} = 0 }
    );
  }

  sub set_allowed {
    my ($this, $allowed_only, @allowed) = @_;

    my $target = 0;
    foreach my $id (1..$this->{size}) {
      my $color = 'gray';

      if ($allowed_only) {
        $target ||= shift @allowed if @allowed;
        $color = 'red';
        if ($id == $target) {
          $target = 0;
          $color  = 'gray';
        }
      }
      $this->{buttons}[$id]->configure(
        -background => $color,
      );
    }
  }

  sub setsize {
    my ($this, $size) = @_;

    $this->{size} = $size;

    foreach my $button (@{ $this->{buttons} }) {
      $button->destroy;
    }
    $this->{frame}->destroy if $this->{frame};

    my $blocksize = int(sqrt($size - 1)) + 1;

    my $frame = $this->Frame;
    foreach my $num (1..$size) {
      my $row = int(($num - 1) / $blocksize);
      my $col = ($num - 1) % $blocksize;

      $this->{buttons}[$num] = $this->Button(
        -text => $num,
        -font => [
          -size => 25,
        ],
        -command => sub { $this->{result} = $num }
      )->grid(
        -in     => $frame,
        -row    => $row,
        -column => $col,
        -sticky => 'news',
      );
    }
    $frame->pack(
      -side => 'left',
      -padx => 0,
      -pady => 0,
    );
    $this->{frame} = $frame;
    $this->bind('' => \&keypress);
  }

  sub keypress {
    my $this = shift;
    my $e = $this->XEvent;
    if ($e->K eq 'Escape') { $this->{result} = 0 }
    if (my ($num) = $e->K =~ /^(\d)$/) { $this->{result} = $num; }
  }

  sub Show {
    my $this = shift;

    $this->{old_focus} = $this->focusSave;
    $this->{old_grab}  = $this->grabSave;

    $this->Popup(
      -popover    => $this->Parent,
      -overanchor => 'c',
      -popanchor  => 'c',
    );

    $this->grab;

    if (my $focusw = $this->cget(-focus)) {
      $focusw->focus;
    }
    else {
      $this->focus;
    }

    $this->Wait;

    $this->{old_focus}->();
    $this->{old_grab}->();

    return $this->{result};
  }

  sub Wait {
    my $this = shift;

    $this->Callback(-showcommand => $this);
    $this->waitVariable(\$this->{result});
    $this->grabRelease;
    $this->withdraw;
    $this->Callback(-command => $this->{result});
  }
}

1;

__END__