view release on metacpan or  search on metacpan

BikePower/Tk.pm  view on Meta::CPAN

    my $f = shift;
    my $air_r;
    foreach $air_r (keys %BikePower::air_resistance) {
	if (!defined $Bikepower::air_resistance{$air_r}->{'icon'}) {
	    eval {
		$BikePower::air_resistance{$air_r}->{'icon'} =
		  $f->MainWindow->Pixmap(-file =>
					 Tk::findINC("BikePower/$air_r.xpm"));
	    };
	}
    }
}

sub tk_interface {
    my($self, $parent, %args) = @_;

    my $lang = $args{'-lang'} || 'en';
    my %s;
    tie %s, 'Tie::Lang', $lang_s, $lang;

    require Tk::Balloon;
    require FindBin;
    push(@INC, $FindBin::Bin);

    my $entry = 'Entry';
    eval { require Tk::NumEntry;
	   Tk::NumEntry->VERSION(1.02);
	   require Tk::NumEntryPlain;
	   Tk::NumEntryPlain->VERSION(0.05);
       };
    if (!$@) { $entry = 'NumEntry' }

    my $automatic = 0;

    my $top = $parent->Toplevel(-title => 'Bikepower');
    $self->{'_top'} = $top;
    push(@interfaces, $top);

    $top->optionAdd("*font" => '-*-helvetica-medium-r-*-14-*',
		    'startupFile');

    require Tk::Menubar;
    my $menuframe = $top->Menubar(-relief => 'raised',
				  -borderwidth => 2,
				 );
    #my $menuframe = $top->Frame(-relief => 'raised',#
				#-borderwidth => 2,
			       #);
    #$menuframe->pack(-fill => 'x');

    my $mb_file = $menuframe->Menubutton(-text => $s{'File'},
					 -underline => 0);
    $mb_file->pack(-side => 'left') if $Tk::VERSION < 800;
    $mb_file->command(-label => $s{'New'},
		      -underline => 0,
 		      -command => sub {
			  eval {
			      $top->Busy;
			      my $bp = new BikePower;
			      $bp->tk_interface($parent);
			      $top->Unbusy;
			  };
			  warn $@ if $@;
		      });
    $mb_file->command(-label => $s{'Clone'},
		      -underline => 1,
 		      -command => sub {
 		          eval {
 		              $top->Busy;
 		              my $bp = clone BikePower $self;
			      $bp->tk_interface($parent, %args);
			      $top->Unbusy;
			  };
			  warn $@ if $@;
		      });
    $mb_file->command(-label => $s{'Close'},
		      -underline => 0,
 		      -command => sub { $top->destroy });

    my $mb_set = $menuframe->Menubutton(-text => $s{'Settings'},
					-underline => 0);
    $mb_set->pack(-side => 'left') if $Tk::VERSION < 800;
    $mb_set->command
      (-label => $s{'Load defaults'},
       -underline => 5,
       -command => sub { $self->load_defaults });
    $mb_set->command
      (-label => $s{'Load...'},
       -underline => 0,
       -command => sub {
	   my $file;
	   eval { 
	       $file = $top->getOpenFile
		 (-defaultextension => '*.pl');
	   };
	   if ($@) {
	       require Tk::FileSelect;
	       $self->{'_load_fd'} =
		 $top->FileSelect(-create => 0,
				  -filter => "*.pl");
	       $file = $self->{'_load_fd'}->Show;
	   }
	   if (defined $file) {
	       $self->load_defaults($file);
	   }
       });
    $mb_set->command
      (-label => $s{'Save as default'},
       -underline => 5,
       -command => sub { $self->save_defaults });
    $mb_set->command
      (-label => $s{'Save as...'},
       -underline => 0,
       -command => sub {
	   my $file;
	   eval { 
	       $file = $top->getSaveFile
		 (-defaultextension => '*.pl');
	   };
	   if ($@) {
	       require Tk::FileSelect;
	       $self->{'_save_fd'} = 
		 $top->FileSelect(-create => 1,
				  -filter => "*.pl");
	       $file = $self->{'_save_fd'}->Show;
	       if ($file) {
		   if ($file !~ /\.pl$/) {
		       $file .= ".pl";
		   }
		   if (-e $file) {
		       require Tk::Dialog;
		       my $d = $top->Dialog