view release on metacpan or  search on metacpan

lib/Games/Pandemic/Tk/Main.pm  view on Meta::CPAN

#
# $self->_build_menu( $mnuname, $mnulabel, @submenus );
#
# Create the menu $label, with all the @submenus.
# @submenus is a list of [$name, $icon, $accel, $label] items.
# Store the menu items under the name menu_$mnuname_$name.
#
sub _build_menu {
    my ($self, $mnuname, $mnulabel, @submenus) = @_;
    my $menubar = $self->_w('menubar');
    my $s = $self->_session;

    my $menu = $menubar->cascade(-label => $mnulabel);
    foreach my $item ( @submenus ) {
        my ($name, $icon, $accel, $label) = @$item;

        # separators are easier
        if ( $name eq '---' ) {
            $menu->separator;
            next;
        }

        # regular buttons
        my $action = $self->_action($name);
        my $widget = $menu->command(
            -label       => $label,
            -image       => $icon,
            -compound    => 'left',
            -accelerator => $accel,
            -command     => $action->callback,
        );
        $self->_set_w("menu_${mnuname}_${name}", $widget);

        # create the bindings. note: we also need to bind the lowercase
        # letter too!
        $action->add_widget($widget);
        $accel =~ s/Ctrl\+/Control-/;
        $action->add_binding("<$accel>");
        $accel =~ s/Control-(\w)/"Control-" . lc($1)/e;
        $action->add_binding("<$accel>");
    }
}


#
# $main->_build_menubar;
#
# create the window's menu.
#
sub _build_menubar {
    my $self = shift;
    my $s = $self->_session;

    # no tear-off menus
    $mw->optionAdd('*tearOff', 'false');

    #$h->{w}{mnu_run} = $menubar->entrycget(1, '-menu');

    my $menubar = $mw->Menu;
    $mw->configure(-menu => $menubar );
    $self->_set_w('menubar', $menubar);

    # menu game
    my @mnu_game = (
    [ 'new',   'filenew16',   'Ctrl+N', T('~New game')   ],
    [ 'load',  'fileopen16',  'Ctrl+O', T('~Load game')  ],
    [ 'close', 'fileclose16', 'Ctrl+W', T('~Close game') ],
    [ '---'                                              ],
    [ 'quit',  'actexit16',   'Ctrl+Q', T('~Quit')       ],
    );
    $self->_build_menu('game', T('~Game'), @mnu_game);

    # menu view
    my @mnu_view = (
    [ 'show_cards', '', 'F2', T('Player ~cards') ],
    );
    $self->_build_menu('view', T('~View'), @mnu_view);

    # menu actions
    my @mnu_action = (
    [ 'action_build'    , '', 'b', T('~Build a research station') ],
    [ 'action_discover' , '', 'c', T('Discover a ~cure')          ],
    [ 'action_treat'    , '', 't', T('~Treat a disease')          ],
    [ 'action_share'    , '', 's', T('~Give a card')              ],
    [ 'action_pass'     , '', 'p', T('~Pass your turn')           ],
    [ '---'                                                       ],
    [ 'action_drop'     , '', 'd', T('~Drop some cards')          ],
    [ '---'                                                       ],
    [ 'continue'        , '', 'Return', T('Conti~nue')          ],
    );
    $self->_build_menu('action', T('~Action'), @mnu_action);
}


#
# $main->_build_status_bar;
#
# create the status bar at the right of the window.
#
sub _build_status_bar {
    my $self = shift;
    my $game = Games::Pandemic->instance;
    my $map  = $game->map;
    my $s    = $self->_session;
    my $tip  = $self->_w('tooltip');
    my $tipmsg;

    # the status bar itself is a frame
    my $sb = $mw->Frame->pack(right, fillx, -before=>$self->_w('canvas'));
    $self->_set_w( infobar => $sb );

#    # research stations
#    my $fstations = $sb->Frame->pack(top, padx10);
#    my $img_nbstations = $fstations->Label(
#        -image => image( catfile( $SHAREDIR, 'research-station-32.png' ) ),
#    )->pack(@TOP);
#    my $lab_nbstations = $fstations->Label->pack(@TOP);
#    $self->_set_w('lab_nbstations', $lab_nbstations );
#    $tipmsg = T("number of remaining\nresearch stations");