view release on metacpan or  search on metacpan

BikePower/Tk.pm  view on Meta::CPAN

sub tk_output {
    my($self) = @_;
    $self->_init_output;

    my $entry;
    for ($entry = 0; $entry < $self->N_entry; $entry++) {
	$self->calc();
	my $out;
	foreach $out (@BikePower::out) {
	    $self->{'_lab'}{$out}->[$entry]->configure
	      (-text => sprintf($BikePower::fmt{$out},
				$self->{'_out'}{$out}));
	}
	$self->_incr_output;
    }
}

sub load_air_resistance_icons {
    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
			 (-title => $s{'Warning'},
			  -text  => sprintf($s{'Overwrite existing file <%s>?'}, $file),
			  -default_button => $s{'No'},
			  -buttons => [$s{'Yes'}, $s{'No'}],
			  -popover => 'cursor');
		       return if $d->Show ne $s{'Yes'};
		   }
	       }
	   }
	   if (defined $file) {
	       $self->save_defaults($file);
	   }
       });

    my $mb_help = $menuframe->Menubutton(-text => $s{'Help'},
					 -underline => 0);
    $mb_help->pack(-side => 'right') if $Tk::VERSION < 800;
    $mb_help->command
      (-label => $s{'About...'},
       -underline => 0,
       -command => sub { 
	   require Tk::Dialog;
	   $top->Dialog(-text =>
			"BikePower.pm $BikePower::VERSION\n" .
			"(c) 1997,1998 Slaven Rezic")->Show;
       },
      );
    $mb_help->command
      (-label => $s{'Reference...'},
       -underline => 0,
       -command => sub { 
	   eval {
	       require Tk::Pod;
	       Tk::Pod->Dir($FindBin::Bin);
	       $top->Pod(-file => 'BikePower.pm');
	   };
	   if ($@) {
	       require Tk::Dialog;
	       $top->Dialog(-text => "Error: $@")->Show;
	   }
       });


    my $f = $top->Frame->pack;
    my $balloon = $f->Balloon;

    load_air_resistance_icons($f);
    {
	my $icon;
	foreach $icon ('up_down', 'change_wind') {
	    if (!defined $icons{$icon}) {
		eval { 
		    $icons{$icon} =
		      $f->Pixmap(-file => Tk::findINC("BikePower/$icon.xpm"));
		};
	    }
	}
    }

    my $row = 0;

    my $calc_button;
    my $autocalc = sub {
	$calc_button->invoke if $automatic;
    };

    my $labentry = sub {
	my($top, $row, $text, $varref, $unit, %a) = @_;
	my $entry = ($a{-forceentry} ? 'Entry' : $entry);
	$top->Label(-text => $text)->grid(-row => $row,
					  -column => 0,
					  -sticky => 'w');
	my $w;
	if (exists $a{-choices}) {
	    require Tk::BrowseEntry;

BikePower/Tk.pm  view on Meta::CPAN

    &$labentry($f, $row, $s{'Temperature'} . ':', \$self->{'T_a'}, '°C');
    $row++;

    &$labentry($f, $row, $s{'Velocity of headwind'} . ':',
	       \$self->{'H'}, 'm/s');
    if (defined $icons{'change_wind'}) {
 	my $btn = $f->Button(-image => $icons{'change_wind'},
			     -command => sub { $self->{'H'} = -$self->{'H'};
					       &$autocalc;
					   },
			    )->grid(-row => $row,
				    -column => 3,
				    -sticky => 'w',
				    -padx => 3);
	$balloon->attach($btn, -msg => $s{'toggle headwind and backwind'});
    }
    $row++;
    $f->Checkbutton(-text => $s{'Crosswind'},
		    -variable => \$self->{'cross_wind'},
		    -command => $autocalc,
		   )->grid(-row => $row,
			   -column => 0,
			   -sticky => 'w',
			   -ipady => 0,
			  ); $row++;

    &$labentry($f, $row, $s{'Grade of hill'} . ':', \$self->{'G'}, 'm/m',
	       -resolution => 0.01);
    if (defined $icons{'up_down'}) {
 	my $btn =$f->Button(-image => $icons{'up_down'},
			    -command => sub { $self->{'G'} = -$self->{'G'};
					      &$autocalc;
					  },
			   )->grid(-row => $row,
				   -column => 3,
				   -sticky => 'w',
				   -padx => 3);
	$balloon->attach($btn, -msg => $s{'toggle up and down hill'});
    }
    $row++;

    &$labentry($f, $row, $s{'Weight of cyclist'} . ':',
	       \$self->{'Wc'}, 'kg');
    $row++;
    &$labentry($f, $row, $s{'Weight of bike+clothes'} . ':',
	       \$self->{'Wm'}, 'kg');
    $row++;

    my @std_a_c =
      map { $BikePower::air_resistance{$_}->{'A_c'} . " (" .
	      $BikePower::air_resistance{$_}->{"text_$lang"}
	    . ")"
	} @BikePower::air_resistance_order;
    &$labentry($f, $row, '', \$self->{'A_c'}, 'm²',
	       -choices => \@std_a_c);
    my $ac_frame = $f->Frame(-relief => 'raised',
			     -borderwidth => 2)->grid(-row => $row,
						      -column => 0,
						      -sticky => 'w'); $row++;
    my $ac_mb = $ac_frame->Menubutton(-text => $s{'Frontal area'} . ':',
					-padx => 0,
					-pady => 0)->pack;
    $balloon->attach($ac_mb, -msg => $s{'set air resistance'});
    {
	my $i = 0;
	my $air_r;
	foreach $air_r (@BikePower::air_resistance_order) {
	    {
		my $i = $i; # wegen des Closures...
		my $icon = $BikePower::air_resistance{$air_r}->{'icon'};
		$ac_mb->command
		  ((defined $icon ? (-image => $icon) : (-label => $air_r)),
		   -command => sub { $self->{'A_c'} = $std_a_c[$i];
				     &$autocalc;
				 });
	    }
	    $i++;
	}
	if ($Tk::VERSION >= 800.010) {
	    $balloon->attach
	      ($ac_mb->cget(-menu),
	       -msg => ['',
			map { $BikePower::air_resistance{$_}->{"text_$lang"} }
			@BikePower::air_resistance_order]);
	}
    }

    {
	my @choices;
	foreach my $r (@BikePower::rolling_friction) {
	    push @choices, sprintf("%-6s ", $r->{'R'}) 
	      . "(" . $r->{"text_$lang"} . ")";
	}
	&$labentry($f, $row, $s{'Rolling friction'} . ':', \$self->{'R'},
		   undef,
		   -choices => \@choices); $row++;
    }

    &$labentry($f, $row, $s{'Transmission efficiency'} . ':',
	       \$self->{'T'}, undef,
	       -resolution => 0.01); $row++;
    
    my $res_frame = $top->Frame(-bg => 'yellow')->pack(-fill => 'x',
						       -ipady => 5);
    $res_frame->optionAdd('*' . substr($res_frame->PathName, 1) . "*background"
			  => 'yellow', 'userDefault');
    $row = 0;
    $res_frame->Label(-text => $s{'Resolve for'} . ':'
		     )->grid(-row => $row,
			     -column => 0,
			     -sticky => 'w');
    my $first_label = $res_frame->Label(-text => $s{'first'}
				       )->grid(-row => $row,
					       -column => 1);
    $balloon->attach($first_label, -msg => $s{'first value in table'});
    $res_frame->Label(-text => $s{'increment'})->grid(-row => $row,
							-column => 2);

    my $w;