view release on metacpan or  search on metacpan

AbstractCanvas.pm  view on Meta::CPAN

# 524JDkqX: Tk::AbstractCanvas.pm by PipStuart     <Pip@CPAN.Org>, derived from Tk::WorldCanvas (by JosephSkrovan <Joseph@Skrovan.Com>
#    which was based on a version by RudyAlbachten <Rudy@Albachten.Com>)    and Tk::RotCanvas   (by AlaQumsieh    <AQumsieh@CPAN.Org>).
package     Tk::AbstractCanvas; # This module provides an alternative to Tk::Canvas which is able to zoom, pan, and rotate.
require     Tk::Derived;
require     Tk::Canvas;
use strict;use warnings;use utf8;
use         Tk;
use         Carp;
our $VERSION     = '1.82';my $d8VS='H7DMAlTk';
@Tk::AbstractCanvas::ISA = qw(Tk::Derived Tk::Canvas); Construct Tk::Widget 'AbstractCanvas';
sub Tk::Widget::ScrlACnv { shift->Scrolled('AbstractCanvas'=>@_) }
my %_can_rotate_about_center = ( # If objects can't rotate about their center, their center can at least rotate about another point on the canvas.
  line      => 1,
  polygon   => 1,
);
my %_rotate_methods = (
  line      => \&_rotate_line,
  text      => \&_rotate_line,
  image     => \&_rotate_line,
  bitmap    => \&_rotate_line,
  window    => \&_rotate_line,
  rectangle => \&_rotate_rect,
  arc       => \&_rotate_rect,
  grid      => \&_rotate_rect,
  oval      => \&_rotate_rect,
  polygon   => \&_rotate_poly,
);
use constant PI => 3.14159269;
sub ClassInit  { my($acnv, $mwin)= @_; $acnv->SUPER::ClassInit($mwin); }
sub InitObject {
  my($acnv, $args)= @_;
  my $pdat = $acnv->privateData();
  $pdat->{'bbox'              } = [0, 0, -1, -1];
  $pdat->{'scale'             } =  1    ;
  $pdat->{'movex'             } =  0    ;
  $pdat->{'movey'             } =  0    ;
  $pdat->{'bboxvalid'         } =  1    ;
  $pdat->{'inverty'           } =  0    ; # I guess these options are not really private since they have accessors but I'm not sure where better to store them
  $pdat->{'rect_to_poly'      } =  0    ;
  $pdat->{'oval_to_poly'      } =  0    ;
  $pdat->{'control_nav'       } =  0    ;
  $pdat->{'control_nav_busy'  } =  0    ; # flag to know not to allow other navs
  $pdat->{'control_zoom_scale'} = -0.001;
  $pdat->{'control_rot_scale' } = -0.3  ;
  $pdat->{'control_rot_mocb'  } =  undef; # MOtion  CallBack
  $pdat->{'control_rot_rlcb'  } =  undef; # ReLease CallBack
  $pdat->{'eventx'            } = -1    ;
  $pdat->{'eventy'            } = -1    ;
  $pdat->{'width'             } = $acnv->width( );
  $pdat->{'height'            } = $acnv->height();
  $acnv->configure(-confine     => 0);
  $acnv->ConfigSpecs( '-bandColor'  => ['PASSIVE',  'bandColor',  'BandColor', 'red' ], '-bandcolor'  => '-bandColor',
                      '-changeView' => ['CALLBACK', 'changeView', 'ChangeView', undef], '-changeview' => '-changeView');
  $acnv->CanvasBind('<Configure>' => sub {
    my $widt = $acnv->width( ); my $pwid = $pdat->{'width' };
    my $hite = $acnv->height(); my $phit = $pdat->{'height'};
    if($widt != $pwid || $hite != $phit) {
      my $bwid = $acnv->cget('-borderwidth'); _view_area_canvas($acnv, $bwid, $bwid, $pwid - $bwid, $phit - $bwid);
      $pdat->{'width' } = $widt; $pdat->{'height'} = $hite; my $bbox = $pdat->{'bbox'};
      my $left = $acnv->canvasx($bwid); my $rite = $acnv->canvasx($widt - $bwid);
      my $topp = $acnv->canvasy($bwid); my $botm = $acnv->canvasy($hite - $bwid);
      $acnv->viewAll() if(_inside(@$bbox, $left, $topp, $rite, $botm));
    }
  });
  $acnv->SUPER::InitObject($args);
}
sub invertY    { my $acnv = shift(); my $pdat = $acnv->privateData(); $pdat->{'inverty'     } = shift() if(@_); return($pdat->{'inverty'     }); }
sub rectToPoly { my $acnv = shift(); my $pdat = $acnv->privateData(); $pdat->{'rect_to_poly'} = shift() if(@_); return($pdat->{'rect_to_poly'}); }
sub ovalToPoly { my $acnv = shift(); my $pdat = $acnv->privateData(); $pdat->{'oval_to_poly'} = shift() if(@_); return($pdat->{'oval_to_poly'}); }
sub controlNav {