Games-Risk

 view release on metacpan or  search on metacpan

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

#
# 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::Main;
# ABSTRACT: main prisk window
$Games::Risk::Tk::Main::VERSION = '4.000';
use POE          qw{ Loop::Tk };
use Image::Magick;
use Image::Size  qw{ imgsize };
use List::Util   qw{ min };
use MIME::Base64 qw{ encode_base64 };
use Moose;
use MooseX::Has::Sugar;
use MooseX::POE;
use MooseX::SemiAffordanceAccessor;
use Readonly;
use Tk;
use Tk::Action;
use Tk::Balloon;
use Tk::JPEG;
use Tk::PNG;
use Tk::Role::HasWidgets 1.112070; # _del_w
use Tk::Sugar;
use Tk::ToolBar;

with 'Tk::Role::HasWidgets';

use Games::Risk::I18n   qw{ T };
use Games::Risk::Logger qw{ debug };
use Games::Risk::Utils  qw{ $SHAREDIR };


Readonly my $K  => $poe_kernel;
Readonly my $mw => $poe_main_window; # already created by poe
Readonly my $WAIT_CLEAN_AI    => 1.000;
Readonly my $WAIT_CLEAN_HUMAN => 0.250;
Readonly my $FLASHDELAY       => 0.150;


# -- attributes

# a hash with all the actions.
has _actions => (
    ro,
    traits  => ['Hash'],
    isa     => 'HashRef[Tk::Action]',
    default => sub { {} },
    handles => {
        _set_action => 'set',
        _action     => 'get',
    },
);

# it's not usually a good idea to retain a reference on a poe session,
# since poe is already taking care of the references for us. however, we
# need the session to call ->postback() to set the various gui callbacks
# that will be fired upon gui events.
has _session => ( rw, weak_ref, isa=>'POE::Session' );

# zoom information
has _orig_bg_size => ( rw, isa=>'Games::Risk::Point' );
has _zoom         => ( rw, isa=>'Games::Risk::Point' );

# greyscale image
has _greyscale => ( rw, isa=>'Tk::Photo' );

# the strings that will appear in the status bar
has _status => (

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

    };



    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)";
            $magick->FloodfillPaint(fuzz=>0, fill=>'white', bordercolor=>$grey, invert=>1);
            $magick->Negate;                        # turn white in black
            $magick->Transparent( color=>'black' ); # mark black as transparent

            # resize the image to fit canvas zoom
            my $zoom = $self->_zoom;
            my $width  = $magick->Get('width');
            my $height = $magick->Get('height');
            $magick->Scale(width=>$width * $zoom->coordx, height=>$height * $zoom->coordy);

            # remove all the uninteresting bits around the country itself
            $magick->Trim;
            my $coordx = $magick->Get('page.x');
            my $coordy = $magick->Get('page.y');
            $magick->Set(page=>'0x0+0+0');          # reset the page (resize image to trimmed zone)

            # create the image and display it on the canvas
            my $img = $c->Photo( -data => encode_base64( $magick->ImageToBlob ) );
            $c->createImage($coordx, $coordy, -anchor=>'nw', -image=>$img, -tags=>["flash$country"]);

            $on   = 1;
            $left = 8;
        }
        my $method = $on ? 'raise' : 'lower';
        $c->$method("flash$country", 'background' );
        if ( $left ) {
            $K->delay( flash_country => $FLASHDELAY => $country, !$on, $left-1 );
        } else {
            $c->delete( "flash$country" );
        }
    };



    event game_over => sub {
        my ($self, $winner) = @_[OBJECT, ARG0];

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

        # announce the winner
        require Games::Risk::Tk::GameOver;
        Games::Risk::Tk::GameOver->new(
            parent => $mw,
            winner => $self->_curplayer,
        );
    };

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

    };

    # event: _canvas_attack_cancel()
    # user wants to deselect a country to attack from.
    event _canvas_attack_cancel => sub {
        my ($self, $s) = @_[OBJECT, SESSION];

        # cancel attack source
        $self->_clear_src;
        $self->_w('canvas')->CanvasBind( '<1>', $s->postback('_canvas_attack_from') );

        # update status msg
        $self->_set_status( sprintf T('Attacking from ...') );
    };

    # event: _canvas_attack_target()
    # user wants to select target for her attack.
    event _canvas_attack_target => sub {
        my $self = shift;

        my $curplayer = $self->_curplayer;
        my $country   = $self->_country;

        # checks...
        return unless defined $country;
        if ( $country->owner->name eq $curplayer->name ) {
            # we own this country too, let's just change source of attack.
            $K->yield('_canvas_attack_from');
            return;
        }
        return unless $country->is_neighbour( $self->_src );

        # update status msg
        $self->_set_status( sprintf T('Attacking %s from %s'),
            $country->name, $self->_src->name );

        # store opponent
        $self->_set_dst( $country );

        # update gui to reflect new state
        $self->_w('canvas')->CanvasBind('<1>', undef);
        $self->_w('canvas')->CanvasBind('<3>', undef);
        $self->_action('attack_done')->disable;

        # signal controller
        $K->post(risk => attack => $self->_src, $country);
    };

    # event: _canvas_configure( undef, [$canvas, $w, $h] )
    # Called when canvas is reconfigured. new width and height available
    # with ($w, $h). note that reconfigure is also window motion.
    event _canvas_configure => sub {
        my ($self, $args) = @_[OBJECT, ARG1];
        my ($c, $neww, $newh) = @$args;

        # check if we're at startup screen...
        my $map = Games::Risk->new->map;
        if ( defined $map ) {
            # in a game
            # create a new image resized to fit new dims
            my $magick = Image::Magick->new;
            $magick->Read( $map->background );
            $magick->Scale(width=>$neww, height=>$newh);

            # install this new image inplace of previous background
            my $img = $c->Photo( -data => encode_base64( $magick->ImageToBlob ) );
            $c->delete('background');
            $c->createImage(0, 0, -anchor=>'nw', -image=>$img, -tags=>['background']);
            $c->lower('background', 'all');

            # update zoom factors. note that we don't want to resize greyscale
            # image since a) it takes time, which is unneeded since this image
            # is not displayed and b) greyscale are quite close from country to
            # country, and resizing will blur this to the point that it's no
            # longer usable. therefore, just storing a zoom factor and using it
            # will be enough for greyscale.
            my $zoom = $self->_zoom;
            my $orig = $self->_orig_bg_size;
            $zoom->set_coordx( $neww / $orig->coordx );
            $zoom->set_coordy( $newh / $orig->coordy );

            # force country redraw, for them to be correctly placed on the new
            # map.
            $K->yield('_country_redraw', $_) foreach $map->countries;

        } else {
            # delete existing images
            $c->delete('startup');

            # create the initial welcome screen
            my @tags = ( -tags => ['startup'] );
            # first a background image...
            $c->createImage (
                $neww/2, $newh/2,
                -anchor => 'center',
                -image  => $mw->Photo( -file=>$SHAREDIR->file( "images", "splash.jpg") ),
                @tags,
            );
        }
    };

    # event: _canvas_motion( undef, [$canvas, $x, $y] )
    # Called when mouse is moving over the $canvas at coords ($x,$y).
    event _canvas_motion => sub {
        my ($self, $args) = @_[OBJECT, ARG1];

        my (undef, $x,$y) = @$args; # first param is canvas

        # correct with zoom factor
        my $zoom = $self->_zoom;
        $x /= defined($zoom) ? $zoom->coordx : 1;
        $y /= defined($zoom) ? $zoom->coordy : 1;

        # get greyscale pointed by mouse, this may die if moving too fast
        # outside of the canvas. we just need the 'red' component, since
        # green and blue will be the same.
        my $grey = 0;
        eval { ($grey) = $self->_greyscale->get($x,$y) };
        return unless defined $self->_map;
        my $country    = $self->_map->country_get($grey);