Games::Risk::Tk::Cards - cards listing

Games-Risk documentation Contained in the Games-Risk distribution.

Index

Code Index:

NAME

Top

Games::Risk::Tk::Cards - cards listing

VERSION

Top

version 3.103040

DESCRIPTION

Top

GR::Tk::Cards implements a POE session, creating a Tk window to list the cards the player got. It can be used to exchange cards with new armies during reinforcement.

METHODS

Top

card_add

    $K->post( cards => 'card_add', $card );

Player just received a new $card, display it.

card_del

    $K->post( cards => 'card_del', @cards );

Player just exchanged some @cards, remove them.

attack

    $K->post( cards => 'attack' );

Prevent user to exchange armies.

place_armies

    $K->post( cards => 'place_armies' );

Change exchange button state depending on the cards selected.

shutdown

    $K->post( 'gui-continents' => 'shutdown' );

Kill current session. The toplevel window has already been destroyed.

visibility_toggle

    $K->post( 'gui-continents' => 'visibility_toggle' );

Request window to be hidden / shown depending on its previous state.

SYNOPSYS

Top

    Games::Risk::Tk::Cards->new(%opts);

CLASS METHODS

Top

my $id = Games::Risk::Tk::Cards->spawn( %opts );

Create a window listing player cards, and return the associated POE session ID. One can pass the following options:

parent => $mw

A Tk window that will be the parent of the toplevel window created. This parameter is mandatory.

PUBLIC EVENTS

Top

The newly created POE session accepts the following events:

* card_add( $card )

Add $card to the list of cards owned by the player to be shown.

* card_del( $card )

Remove $card from the list of cards owned by the player to be shown.

* visibility_toggle()

Request window to be hidden / shown depending on its previous state.

SEE ALSO

Top

Games::Risk.

AUTHOR

Top

  Jerome Quelin

COPYRIGHT AND LICENSE

Top

This software is Copyright (c) 2008 by Jerome Quelin.

This is free software, licensed under:

  The GNU General Public License, Version 3, June 2007
Games-Risk documentation Contained in the Games-Risk distribution. 
#
# This file is part of Games-Risk
#
# This software is Copyright (c) 2008 by Jerome Quelin.
#
# This is free software, licensed under:
#
#   The GNU General Public License, Version 3, June 2007
#
use 5.010;
use strict;
use warnings;

package Games::Risk::Tk::Cards;
BEGIN {
  $Games::Risk::Tk::Cards::VERSION = '3.103040';
}
# ABSTRACT: cards listing

use POE              qw{ Loop::Tk };
use List::MoreUtils  qw{ any firstidx };
use Moose;
use MooseX::Has::Sugar;
use MooseX::POE;
use MooseX::SemiAffordanceAccessor;
use Readonly;
use Tk::Role::Dialog 1.101480;
use Tk::Sugar;
use Tk::Pane;

use Games::Risk::I18N      qw{ T };
use Games::Risk::Resources qw{ $SHAREDIR };

with 'Tk::Role::Dialog';

Readonly my $K => $poe_kernel;
Readonly my $WIDTH  => 95;
Readonly my $HEIGHT => 145;


# -- attributes

has _bonus => ( rw, isa=>'Int', default=>0 );
has _cards => (
    ro, auto_deref,
    traits  => ['Array'],
    isa     => 'ArrayRef',
    default => sub { [] },
    handles => {
        _remove_card   => 'delete',  # $self->_remove_card( $idx );
        _store_card    => 'push',    # $self->_store_card( $card );
    },
);
has _selected => (
    rw, auto_deref,
    traits  => ['Array'],
    isa     => 'ArrayRef',
    default => sub { [] },
    handles => {
        _clear_selected => 'clear', # $self->_clear_selected;
    },
);
has _state    => ( rw, isa=>'Str', default=>'' );
has _canvases => ( rw, isa=>'ArrayRef', auto_deref, default => sub { [] } );


# -- initialization / finalization

sub _build_hidden    { 1 }
sub _build_title     { 'prisk - ' . T('cards') }
sub _build_icon      { $SHAREDIR->file('icons', '32','cards.png') }
sub _build_header    { T('Cards available') }
sub _build_resizable { 0 }
sub _build_ok        { T('Exchange') }
sub _build_hide      { T('Close') }


#
# session initialization.
#
sub START {
    my ($self, $s) = @_[OBJECT, SESSION];
    $K->alias_set('cards');

    #-- trap some events
    my $top = $self->_toplevel;
    $top->protocol( WM_DELETE_WINDOW => $s->postback('visibility_toggle'));
    $top->bind('<F5>', $s->postback('visibility_toggle'));
}


#
# session destruction.
#
sub STOP {
    warn "gui-cards shutdown\n";
}


# -- public events


event card_add => sub {
    my ($self, $card) = @_[OBJECT, ARG0];
    $self->_store_card( $card );
    $K->yield('_redraw_cards');
};



event card_del => sub {
    my ($self, @del) = @_[OBJECT, ARG0..$#_];

    # nothing selected any more
    $self->_clear_selected;
    $self->_set_bonus(0);
    $self->_w('label')->configure(-text=>T('Select 3 cards'));

    # remove the cards
    foreach my $c ( @del ) {
        my $idx = firstidx { $_ eq $c } $self->_cards;
        $self->_remove_card( $idx );
    }

    $K->yield('_redraw_cards');
    $K->yield('_change_button_state');
};



event attack               => \&_do_change_button_state;
event place_armies         => \&_do_change_button_state;
event _change_button_state => \&_do_change_button_state; # also internal event
sub _do_change_button_state {
    my ($self, $event) = @_[OBJECT, STATE];

    my $select;
    given ($event) {
        when ('attack') {
            $self->_set_state('attack');
            $select = 0;
        }
        when ('place_armies') {
            $self->_set_state('place_armies');
            $select = $self->_bonus;
        }
        default {
            $select = $self->_state eq 'place_armies' && $self->_bonus;
        }
    }
    $self->_w('ok')->configure( $select ? (enabled) : (disabled) );
}



event shutdown => sub {
    $K->alias_remove('cards');
};



event visibility_toggle => sub {
    my $self = shift;
    my $top = $self->_toplevel;
    my $method = $top->state eq 'normal' ? 'withdraw' : 'deiconify';
    $top->$method;
};


# -- private events

#
# event: _card_clicked()
#
# click on a card, changing its selected status.
#
event _card_clicked => sub {
    my ($self, $args) = @_[OBJECT, ARG1];
    my ($canvas, undef) = @$args;

    # get the lists
    my @cards    = $self->_cards;
    my @canvases = $self->_canvases;
    my @selected = $self->_selected;

    # get index of clicked canvas, and its select status
    my $idx = firstidx { $_ eq $canvas } @canvases;
    my $is_selected = any { $_ == $idx } @selected;

    # change card status: de/selected
    if ( $is_selected ) {
        # deselect
        $canvas->configure(-bg=>'white');
        @selected = grep { $_ != $idx } @selected;
    } else {
        # select
        $canvas->configure(-bg=>'black');
        push @selected, $idx;
    }


    if ( scalar(@selected) == 3 ) {
        # get types of armies
        my @types = sort map { $cards[$_]->type } @selected;

        # compute how much armies it's worth.
        my $combo = join '', map { substr $_, 0, 1 } @types;
        my $bonus;
        given ($combo) {
            when ( [ qw{ aci acj aij cij ajj cjj ijj jjj } ] ) { $bonus = 10; }
            when ( [ qw{ aaa aaj } ] ) { $bonus = 8; }
            when ( [ qw{ ccc ccj } ] ) { $bonus = 6; }
            when ( [ qw{ iii iij } ] ) { $bonus = 4; }
            default { $bonus = 0; }
        }
        $self->_set_bonus( $bonus );

        # update label
        local $" = ', ';
        my $text  = "@types = $bonus armies";
        $self->_w('label')->configure(-text=>$text);

    } else {
        # update label
        $self->_w('label')->configure(-text=>T('Select 3 cards'));
        $self->_set_bonus( 0 );
    }

    # FIXME: check validity of cards selected
    #$top->bind('<Key-Return>', $s->postback('_but_move'));
    #$top->bind('<Key-space>',  $s->postback('_but_move'));

    # store new set of selected cards
    $self->_set_selected( \@selected );

    $K->yield('_change_button_state');
};


#
# event: _card_double_clicked()
#
# double-click on a card, highlighting it on the board.
#
event _card_double_clicked => sub {
    my ($self, $args) = @_[OBJECT, ARG1];
    my $card = $args->[1];
    return if $card->type eq 'joker';   # joker is not a country, nothing to do
    $K->post( gui => flash_country => $card->country );
};


#
# event: _redraw_cards()
#
# ask to discard current cards shown, and redraw them. used when
# receiving a new card, or after exchanging some of them.
#
event _redraw_cards => sub {
    my ($self, $s) = @_[OBJECT, SESSION];

    # removing cards
    $_->destroy for $self->_canvases;

    # update gui
    my @canvases = ();
    my @selected = $self->_selected;
    my @cards    = $self->_cards;
    foreach my $i ( 0 .. $#cards ) {
        my $card = $cards[$i];
        my $country = $card->country;

        #
        my $is_selected = any { $_ == $i } @selected;

        # the canvas containing country info
        my $row = int( $i / 3 );
        my $col = $i % 3;
        my $c = $self->_w('frame')->Canvas(
            -width  => $WIDTH,
            -height => $HEIGHT,
            -bg     => $is_selected ? 'black' : 'white',
        )->grid(-row=>$row,-column=>$col);
        $c->CanvasBind('<1>', [$s->postback('_card_clicked'), $card]);
        $c->CanvasBind('<Double-1>', [$s->postback('_card_double_clicked'), $card]);

        # the info themselves
        my $img = $SHAREDIR->file('images', 'card-bg.png');
        $c->createImage(1, 1, -anchor=>'nw', -image=>$c->Photo(-file=>$img), -tags=>['bg']);

        if ( $card->type eq 'joker' ) {
            # only the joker!
            my $img = $SHAREDIR->file('images', 'card-joker.png');
            $c->createImage(
                $WIDTH/2, $HEIGHT/2,
                -image  => $c->Photo( -file => $img ),
            );
        } else {
            # country name
            $c->createText(
                $WIDTH/2, 15,
                -width  => 70,
                -anchor => 'n',
                -text   => $country->name,
            );
            # type of card
            my $img = $SHAREDIR->file( 'images', 'card-' . $card->type . '.png');
            $c->createImage(
                $WIDTH/2, $HEIGHT-10,
                -anchor => 's',
                -image  => $c->Photo( -file => $img ),
            );
        }

        # storing canvas
        push @canvases, $c;
    }

    $self->_set_canvases(\@canvases);
    $self->_toplevel->deiconify;
};


# -- private methods

#
# $self->_build_gui;
#
# called by tk:role:dialog to build the inner dialog.
#
sub _build_gui {
    my $self = shift;

    my $top = $self->_toplevel;

    #- top label
    my $label = $top->Label( -text => T('Select 3 cards') )->pack(top,fillx);
    $self->_set_w( label => $label );

    #- cards frame
    my $frame = $top->Scrolled('Frame',
        -scrollbars => 'e',
        -width      => ($WIDTH+5)*3,
        -height     => ($HEIGHT+5)*2,
    )->pack(top, xfill2);
    $self->_set_w( frame => $frame );

    #- force window geometry
    $top->update;    # force redraw
}


#
# $self->_finish_gui;
#
# called by tk:role:dialog to finish the inner dialog building.
# needed because win32 somehow mixes START with BUILD. very strange...
#
sub _finish_gui {
    my $self = shift;

    # prevent validation button to be clicked.
    $self->_w('ok')->configure(disabled);
}


#
# $self->_valid;
#
# called by tk:role:dialog when clicking on exchange button to
# trade armies.
#
sub _valid {
    my $self = shift;
    my @cards    = $self->_cards;
    my @selected = $self->_selected;
    $K->post( risk => 'cards_exchange', @cards[ @selected ] );
}


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




__END__