view release on metacpan or  search on metacpan

lib/Games/Risk/GUI/Startup.pm  view on Meta::CPAN

    $h->{map} = $choices[0]; # FIXME: config
    my $fmap = $top->Frame->pack(top, xfill2, pad20);
    $fmap->Label(-text=>T('Map'), -anchor=>'w')->pack(top, fillx);
    $fmap->BrowseEntry(
        -variable           => \$h->{map},
        -listheight         => scalar(@choices)+1,
        -choices            => \@choices,
        -state              => 'readonly',
        -disabledforeground => 'black',
    )->pack(top );

    #-- frame for players
    my $fpl = $top->Frame->pack(top, xfill2, pad20);
    $fpl->Label(-text=>T('Players'), -anchor=>'w')->pack(top, fillx);
    $h->{button}{add_player} = $fpl->Button(
        -text    => T('New player...'),
        -command => $s->postback('_but_new_player'),
    )->pack(top,fillx);
    $h->{frame}{players} = $fpl;
    K->yield('_load_defaults');

    #-- bottom frame
    my $fbot = $top->Frame->pack(bottom, fillx, pad20);
    my $b_start = $h->{button}{start} = $fbot->Button(
        -text => T('Start game'),
        -command => $s->postback('_but_start'),
    );
    my $b_quit = $fbot->Button(
        -text => T('Quit'),
        -command => $s->postback('_but_quit'),
    );
    # pack after creation, to have clean focus order
    $b_quit->pack(right,pad1);
    $b_start->pack(right,pad1);

    # window binding
    $top->bind('<Key-Return>', $s->postback('_but_start'));
    $top->bind('<Key-Escape>', $s->postback('_but_quit'));

    $top->update;
    $top->Popup;
    $top->grab;
}


# -- gui events

#
# event: _but_color([$num])
#
# called when button to choose another color for player number $num has
# been clicked.
#
sub _ongui_but_color {
    my ($h, $s, $args) = @_[HEAP, SESSION, ARG0];

    my ($num) = @$args;
    my $top = $h->{toplevel};

    # creating popup window
    my $tc =$top->Menu;
    $tc->overrideredirect(1);  # no window decoration
    foreach my $i ( 0..$#COLORS ) {
        my $color = $COLORS[$i];
        my $row = $i < 5 ? 0 : 1;
        my $col = $i % 5;
        my $l = $tc->Label(
            -bg     => $color,
            -width  => 2,
        )->grid(-row=>$row, -column=>$col);
        $l->bind('<1>', $s->postback('_player_color', $num, $color));
    }

    # poping up
    $tc->Popup(
        -popover => $h->{players}[$num]{but_color},
        -overanchor => 'sw',
        -popanchor  => 'nw',
    );
    $top->bind('<1>', sub { $tc->destroy; $top->bind('<1>',undef); });
    #$tc->bind('<1>', sub { $tc->destroy; $top->bind('<1>',undef); });

    K->yield('_check_errors');
}


#
# event: _but_delete([$num])
#
# called when button to delete player number $num has been clicked.
#
sub _ongui_but_delete {
    my ($h, $args) = @_[HEAP, ARG0];

    # remove player
    my ($num) = @$args;
    $h->{players}[$num]{line}->destroy;
    delete $h->{players}[$num];

    # max players reached?
    K->yield('_check_nb_players');

    # check if we have enough players
    K->yield('_check_errors');
}


#
# event: _but_new_player()
#
# called when button to create a player has been clicked.
#
sub _ongui_but_new_player {
    my $h = $_[HEAP];

    my $players = $h->{players};
    my @players = grep { defined $_ } @$players;

    # pick a name
    my %names;
    @names{ @NAMES } = ();