view release on metacpan or  search on metacpan

RotCanvas.pm  view on Meta::CPAN

package Tk::RotCanvas;

use vars qw/$VERSION/;
$VERSION = 1.2;

use Tk::widgets qw/Canvas/;
use base qw/Tk::Derived Tk::Canvas/;

use strict;
use Carp;

Construct Tk::Widget 'RotCanvas';

sub ClassInit {
    my $class = shift;

    $class->SUPER::ClassInit(@_);
}

sub Populate {
    my ($self, $args) = @_;

    $self->SUPER::Populate($args);
}

my %_cant_handle = (
		    bitmap => 1,
		    image  => 1,
		    arc    => 1,
		    text   => 1,
		    window => 1,
		   );

my %_rotate_methods = (
		       line      => \&_rotate_line,
		       polygon   => \&_rotate_poly,
		       oval      => \&_rotate_poly,
		      );

use constant PI => 3.14159269;

# This is the new rotate() method. It takes as input the
# id of the object to rotate, and the angle to rotate it with.
# It then rotates the object about its center by the given angle

sub rotate {
    my ($self, $id, $angle, $x, $y) = @_;

    unless (defined $angle) {
	croak "rotate: Must supply an angle -";
    }

    # Get the current coordinates of the object.
    my $type = $self->type($id);

    # For now, I don't know how to handle some of these!
    if (exists $_cant_handle{$type}) {
	croak "rotate: Can't handle objects of type '$type' yet -";
    }

    $_rotate_methods{$type}->($self, $id, $angle, $x, $y);
}

sub _rotate_line {
    my ($self, $id, $angle, $midx, $midy) = @_;

    # Get the old coordinates.