view release on metacpan or  search on metacpan

lib/Tk/MTDial.pm  view on Meta::CPAN

=item -dialsize (250)
 
=item -dialvalue (0)

=item -dialcolor ('DarkGrey')

=item -dialborder (2)

=item -dialbordercolor1 ('grey38')

=item -dialbordercolor2 ('grey99')

=item -dialrovariable (undef)

=item -dialcommand (sub {return})

=back

=head2 createMTDial

Displays the dial, sets its initial parameters, binds the callback
routines. 

=head2 Not to be called by the user directly

=head3 ClassInit

Calls the base class initializer

=head3 Populate

Sets default values for the class parameters.

=head3 pushed

Routine called when button 1 is pushed

=head3 rotate

Routine called to rotate dial when the mouse moves

=head1 AUTHOR

W. Luis Mochán, Instituto de Ciencias Físicas, UNAM, México
C<mochan@fis.unam.mx> 

=head1 ACKNOWLEDGMENTS

This work was partially supported by DGAPA-UNAM under grants IN108413
and IN113016.   

=cut


use constant {
    PI=>4*atan2(1,1),
    id=>0.85, # indicator distance from center
    ir=>0.05,  # indicator radius
};

use base qw/Tk::Derived Tk::Canvas/;
use strict;
use warnings;

Construct Tk::Widget 'MTDial';


sub ClassInit {
    my($class, $mw) = @_;
    $class->SUPER::ClassInit($mw);
}

sub Populate {
    my($self, $args)=@_;
    my %args=%$args;
    $self->SUPER::Populate($args);
    #$self->Advertise();
    $self->ConfigSpecs(
	-width => [qw(SELF width Width), 500],
	-height=> [qw(SELF heigh Height), 500],
	-dialsize=>[qw(PASSIVE dialsize MTDialsize), 250],
	-dialvalue=>[qw(PASSIVE dialvalue MTDialvalue), 0],
	-dialcolor=>[qw(PASSIVE dialcolor MTDialcolor), 'DarkGrey'],
	-dialborder=>[qw(PASSIVE dialborder MTDialborder), 2],
	-dialbordercolor1=>[qw(PASSIVE dialbordercolor1 MTDialbordercolor1), 
			    'grey38'],
	-dialbordercolor2=>[qw(PASSIVE dialbordercolor2 MTDialbordercolor2), 
			    'grey99'],
	-dialrovariable=>[qw(PASSIVE dialrovariable MTDialrovariable), undef],
	-dialcommand=>[qw(CALLBACK dialbordercolor2 MTDialbordercolor2), 
		       sub {return}],
	DEFAULT => ['SELF']
	);
    $self->Delegates();
}

sub createMTDial {
    my ($self)=@_;
    my $ks=$self->cget(-dialsize);
    my $kc=$self->cget(-dialcolor);
    my $w=$self->cget(-width);
    my $h=$self->cget(-height);
    my $kb=$self->cget(-dialborder);
    my $kbc1=$self->cget(-dialbordercolor1);
    my $kbc2=$self->cget(-dialbordercolor2);
    $self->configure(-dialvalue=>${$self->cget(-dialrovariable)}) 
	if ref $self->cget(-dialrovariable);
    my $a=2*PI*$self->cget(-dialvalue);
    my $ca=cos($a);
    my $sa=sin($a);
    $self->create('oval', $w/2-$ks, $h/2-$ks, $w/2+$ks, $h/2+$ks,
		  -fill=>$kc, -width=>0, -tags=>[qw(dial)]); 
    $self->create('arc', $w/2-$ks, $h/2-$ks, $w/2+$ks, $h/2+$ks,
		  -style=>'arc', -start=>-135, -extent=>180, -width=>$kb,
		  -outline=>$kbc1 ); 
    $self->create('arc', $w/2-$ks, $h/2-$ks, $w/2+$ks, $h/2+$ks,
		  -style=>'arc', -start=>45, -extent=>180, -width=>$kb,
		  -outline=>$kbc2); 
    $self->create('arc', $w/2+(id*$ca - ir)*$ks, $h/2+(id*$sa - ir)*$ks,
		  $w/2+(id*$ca+ir)*$ks, $h/2+(id*$sa+ir)*$ks, 
		  -style=>'pie', -start=>-135, -extent=>180,