view release on metacpan or  search on metacpan

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

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

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

        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',      $mw->Photo(-file=>$SHAREDIR->file('icons', '16', 'cards.png')), 'F5', T('~Cards') ],
        [ 'show_continents', $mw->Photo(-file=>$SHAREDIR->file('icons', '16', 'continents.png')), 'F6', T('C~ontinents') ],
        );
        $self->_build_menu('view', T('~View'), @mnu_view);

        # menu actions
        my @mnu_actions = (
        [ 'place_armies_redo', 'actreload16',  'u', T('~Undo all') ],
        [ 'place_armies_done', 'navforward16', 'a', T('~Attack') ],
        [ 'attack_redo',       'actredo16',    'r', T('~Re-attack') ],
        [ 'attack_done',       'navforward16', 'c', T('~Consolidate') ],
        [ 'move_armies_done',  'playstop16',   'f', T('~Finish turn') ],
        );
        $self->_build_menu('actions', T('~Actions'), @mnu_actions);

        # menu help
        my @mnu_help = (
        [ 'help',  $mw->Photo(-file=>$SHAREDIR->file('icons', '16', 'help.png')), 'F1', T('~Help') ],
        [ 'about', $mw->Photo(-file=>$SHAREDIR->file('icons', '16', 'about.png')),  '', T('~About') ],
        );
        $self->_build_menu('help', T('~Help'), @mnu_help);
    }

    #
    # $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);
            if ( $accel ) {
                $accel =~ s/Ctrl\+/Control-/;
                $action->add_binding("<$accel>");
                $accel =~ s/Control-(\w)/"Control-" . lc($1)/e;
                $action->add_binding("<$accel>");
            }
        }
    }

    #
    # $main->_build_player_bar;
    #
    # create the player bar at the right of the window.
    #
    sub _build_player_bar {
        my $self = shift;
        my $s    = $self->_session;

        my $fright = $mw->Frame->pack(right, fill2, -before=>$self->_w('canvas'));
        $self->_set_w( player_bar => $fright );

        #-- players frame
        my $fpl = $fright->Frame->pack(top);
        $fpl->Label(-text=>T('Players'))->pack(top);
        my $fplist = $fpl->Frame->pack(top);
        $self->_set_w( fplayers => $fplist );

        #-- dices frame
        my $dice0   = $mw->Photo(-file=>$SHAREDIR->file('images', 'dice-0.png') );
        my $empty16 = $mw->Photo(-file=>$SHAREDIR->file('icons', '16', 'empty.png') );
        my $fdice = $fright->Frame->pack(top,fillx,pady(10));
        $fdice->Label(-text=>T('Dice arena'))->pack(top,fillx);
        my $fd1 = $fdice->Frame->pack(top,fill2);
        my $a1 = $fd1->Label(-image=>$dice0)->pack(left);
        my $a2 = $fd1->Label(-image=>$dice0)->pack(left);
        my $a3 = $fd1->Label(-image=>$dice0)->pack(left);
        my $fr = $fdice->Frame->pack(top,fill2);