view release on metacpan or  search on metacpan

lib/Games/Sudoku/Component/TkPlayer/View.pm  view on Meta::CPAN

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

  use Tk::JPEG;

  use Games::Sudoku::Component::TkPlayer::Splashscreen;
  use Games::Sudoku::Component::TkPlayer::Selector;

  sub new {
    my $class = shift;

    my %options = ref $_[0] ? %{ $_[0] } : @_;

    my $this = bless {
      mw  => $options{mw},
      sdk => $options{sdk},
      cmd => $options{cmd},
      ver => $options{ver},
      wgt => {},
    }, (ref $class || $class);
  }

  sub create {
    my $this = shift;
    my $mw   = $this->{mw};
    my $cmd  = $this->{cmd};
    my $ver  = $this->{ver};

    $mw->title("Sudoku Player $ver");

    $this->create_menu;
    $this->create_progressbar;
    $this->create_board;
    $this->create_sideboard;
    $this->create_selector;
    $mw->focus;
  }

  sub create_menu {
    my $this = shift;
    my $mw   = $this->{mw};

    $mw->configure(-menu => my $menu = $mw->Menu);

    $menu->cascade(
      -label     => '~Game',
      -menuitems => $this->create_menu_file,
      -tearoff   => 0,
    );

    $menu->cascade(
      -label     => '~Hint',
      -menuitems => $this->create_menu_hint,
      -tearoff   => 0,
    );
  }

  sub create_menu_file {
    my $this = shift;
    my $mw   = $this->{mw};
    my $cmd  = $this->{cmd};
    my $sdk  = $this->{sdk};
    my $wgt  = $this->{wgt};

    [
      [
        'command', '~New',
        -command => [ 'new_game', $cmd, $mw, $sdk, $wgt ],
      ],
      [
        'command', '~Load',
        -command => [ 'load_game', $cmd, $mw, $sdk, $wgt ],
      ],
      [
        'command', '~Save',
        -command => [ 'save_game', $cmd, $mw, $sdk, $wgt ],
      ],
      '',
      [
        'command', 'Loc~k',
        -command => [ 'lock', $cmd, $mw, $sdk, $wgt ],
      ],
      [
        'command', '~Unlock',
        -command => [ 'unlock', $cmd, $mw, $sdk, $wgt ],
      ],
      '',
      [
        'command', '~Rewind all',
        -command => [ 'rewind_all', $cmd, $mw, $sdk, $wgt ],
      ],
      [
        'command', '~Clear',
        -command => [ 'clear', $cmd, $mw, $sdk, $wgt ],
      ],
      '',
      [
        'command', '~Quit',
        -command => [ 'quit', $cmd, $mw ],
      ],
    ];
  }