view release on metacpan or  search on metacpan

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

        # update attack dices
        foreach my $i ( 1 .. 3 ) {
            my $d = $attack->[$i-1] // 0;
            my $img = $mw->Photo( -file => $SHAREDIR->file('images', "dice-$d.png") );
            $self->_w("lab_attack_$i")->configure(-image=>$img);
        }

        # update defence dices
        foreach my $i ( 1 .. 2 ) {
            my $d = $defence->[$i-1] // 0;
            my $img = $mw->Photo( -file => $SHAREDIR->file('images', "dice-$d.png") );
            $self->_w("lab_defence_$i")->configure(-image=>$img);
        }

        # draw a line on the canvas
        my $c = $self->_w('canvas');
        state $i = 0;
        my $zoomx = $self->_zoom->coordx; my $zoomy = $self->_zoom->coordy;
        my $x1 = $src->coordx * $zoomx; my $y1 = $src->coordy * $zoomy;
        my $x2 = $dst->coordx * $zoomx; my $y2 = $dst->coordy * $zoomy;
        $c->createLine(
            $x1, $y1, $x2, $y2,
            -arrow => 'last',
            -tags  => ['attack', "attack$i"],
            -fill  => 'yellow', #$self->_curplayer->color,
            -width => 4,
        );
        my $srcid = $src->id;
        $c->raise('attack', 'all');
        $c->raise("country$srcid", 'attack');
        $c->idletasks;
        my $wait = $self->_curplayer->type eq 'ai' ? $WAIT_CLEAN_AI : $WAIT_CLEAN_HUMAN;
        $K->delay_set(_clean_attack => $wait, $i);
        $i++;

        # update result labels
        my $nul = $mw->Photo( -file=> $SHAREDIR->file('icons', '16', 'empty.png') );
        my $r1 = $attack->[0] <= $defence->[0] ? 'actcross16' : 'actcheck16';
        my $r2 = scalar(@$attack) >= 2 && scalar(@$defence) == 2
            ? $attack->[1] <= $defence->[1] ? 'actcross16' : 'actcheck16'
            : $nul;
        $self->_w('lab_result_1')->configure( -image => $r1 );
        $self->_w('lab_result_2')->configure( -image => $r2 );
    };


    event attack_move => sub {
        my $self = shift;

        my $c = $self->_w('canvas');
        $c->CanvasBind('<1>', undef);
        $c->CanvasBind('<3>', undef);
        $self->_action('attack_redo')->disable;
        $self->_action('attack_done')->disable;
        $self->_w('lab_step_attack')->configure(disabled);
    };



    event chnum => \&_do_country_redraw;
    event chown => \&_do_country_redraw;
    event _country_redraw => \&_do_country_redraw;
    sub _do_country_redraw {
        my ($self, $country) = @_[OBJECT, ARG0];
        my $c = $self->_w('canvas');

        my $id    = $country->id;
        my $owner = $country->owner;
        my $fakein  = $self->_fake_armies_in->{$id}  // 0;
        my $fakeout = $self->_fake_armies_out->{$id} // 0;
        my $armies  = ($country->armies // 0) + $fakein - $fakeout;

        # change radius to reflect number of armies
        my ($radius, $fill_color, $text) = defined $owner
                ? (8, $owner->color, $armies)
                : (6,       'white', '');
        $radius += min(16,$armies-1)/2;

        my $zoom = $self->_zoom;
        my $x = $country->coordx * $zoom->coordx;
        my $y = $country->coordy * $zoom->coordy;
        my $x1 = $x - $radius; my $x2 = $x + $radius;
        my $y1 = $y - $radius; my $y2 = $y + $radius;

        # update canvas
        $c->delete( "country$id" );
        #  - circle
        $c->createOval(
            $x1, $y1, $x2, $y2,
            -fill    => $fill_color,
            -outline => 'black',
            -tags    => [ "country$id", 'circle' ],
        );

        #  - text
        $c->createText(
            $x, $y+1,
            -fill => 'white',
            -tags => [ "country$id", 'text' ],
            -text => $text,
        );

        $c->raise("country$id&&circle", 'all');
        $c->raise("country$id&&text",   'all');
    };



    event flash_country => sub {
        my ($self, $country, $on, $left) = @_[OBJECT, ARG0 .. $#_];
        my $c = $self->_w('canvas');

        # first time that the country is flashed
        if ( not defined $on ) {
            # load greyscale image...
            my $magick = Image::Magick->new;
            $magick->Read( Games::Risk->new->map->greyscale );

            # and paint everything that isn't the country in white
            my $id = $country->id;
            my $grey = "rgb($id,$id,$id)";

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

            $mw->bind('Tk::Canvas', "<Shift-Button-$button>", undef);
        }
        foreach my $key ( qw{ Down End Home Left Next Prior Right Up } ) {
            $mw->bind('Tk::Canvas', "<Key-$key>", undef);
            $mw->bind('Tk::Canvas', "<Control-Key-$key>", undef);
        }

        # initial actions
        $c->CanvasBind('<Configure>', [$s->postback('_canvas_configure'), Ev('w'), Ev('h')] );
        $c->CanvasBind( '<Motion>',   [$s->postback('_canvas_motion'),    Ev('x'), Ev('y')] );
    }

}


no Moose;
__PACKAGE__->meta->make_immutable;
1;

__END__

=pod

=head1 NAME

Games::Risk::Tk::Main - main prisk window

=head1 VERSION

version 4.000

=head1 DESCRIPTION

This class implements the whole L<Tk> graphical interface. It is a POE
session driving events, reacting to user interaction & updating the
display as game changes status.

=head1 EVENTS

=head2 attack

    attack()

Request user to start attacking at will.

=head2 attack_info

    attack_info( $src, $dst, \@attack, \@defence )

Give the result of C<$dst> attack from C<$src>: C<@attack> and
C<@defence> dices.

=head2 attack_move

    attack_move()

Prevent user to re-attack till he moved the armies.

=head2 chnum

=head2 chown

    chnum( $country )
    chown( $country )

Force C<$country> to be redrawn: owner and number of armies.

=head2 flash_country

    flash_country( $country , [ $state, $left ] )

Request C<$country> to be flashed on the map. This is done by extracting
the country from the greyscale image, and paint it in white on the
canvas.

Once the image is created, the event yields itself back after
C<$FLASHDELAY>, and shows/hides the image depending on C<$state>. When
C<$left> hits 0 (decremented each state change), the image is discarded.

=head2 game_over

    game_over( $player )

Sent when C<$player> has won the game.

=head2 move_armies

    move_armies()

Request user to move armies if she wants to.

=head2 move_armies_move

    move_armies_move($src, $dst, $nb)

Request gui to move C<$nb> armies from C<$src> to C<$dst>.

=head2 new_game

    new_game()

Received when the controller started a new game. Display the new map,
action & statusbar.

=head2 place_armies

    place_armies( $nb [, $continent] )

Request user to place C<$nb> armies on her countries (maybe within
C<$continent> if supplied).

=head2 place_armies_initial

    place_armies_initial()

Request user to place 1 armies on her countries. this is initial
reinforcement, so there's no limit on where to put the army, and armies
are put one by one.

=head2 place_armies_initial_count

    place_armies_initial_count( $nb )

request user to place $nb armies on her countries. this is initial