1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106
|
#!/usr/bin/perl
use Tk;
use Tk::PlotDataset;
use Tk::LineGraphDataset;
use Math::GSL::SF qw/:all/;
use strict;
my ( %sets, $graph );
my $window = MainWindow->new( -title => 'Math::GSL Plot', );
my @popo = ("gsl_sf_bessel_J0", "gsl_sf_bessel_J1", "gsl_sf_bessel_Y0", "gsl_sf_bessel_Y1");
for my $n (0..3) {
my $del;
$window->Button(
-text => $popo[$n],
-command => sub {
region($popo[$n]);
$del->configure( -state => "normal" );
}
)->pack;
$del = $window->Button(
-text => "Remove " . $popo[$n],
-state => "disabled",
-command => sub {
delete_set($popo[$n]);
$del->configure( -state => "disabled" );
}
)->pack;
}
$window->Button( -text => "test", -command => [ \®ion, "test", $window ] )
->pack;
sub region {
my $name = shift;
if ($graph) { $graph->packForget(); }
my @region = map { $_ / 10 } ( -400 .. -1, 0, 1 .. 400 );
my @region2 = map { $_ / 10 } ( 1 .. 400 );
my %functions = (
"gsl_sf_bessel_J0" => \&sf_bessel_J0,
"gsl_sf_bessel_J1" => \&sf_bessel_J1,
"gsl_sf_bessel_Y0" => \&sf_bessel_Y0,
"gsl_sf_bessel_Y1" => \&sf_bessel_Y1,
"test" => \&test,
);
my @data1;
if ($name) {
if ( $name =~ /(Y1|Y0)$/ ) {
@data1 = map { $functions{$name}->($_) } (@region2);
}
else {
@data1 = map { $functions{$name}->($_) } (@region);
}
my $dataset1 = LineGraphDataset->new(
-name => $name,
-plottitle => [$name],
-xData => \@region,
-yData => \@data1,
-yAxis => 'Y',
# -color => 'red'
);
$sets{$name} = $dataset1;
}
$graph = $window->PlotDataset(
-width => 500,
-height => 500,
-background => 'snow'
)->pack( -fill => 'both', -expand => 1 );
my @datasets = values %sets;
$graph->addDatasets(@datasets);
$graph->plot;
}
sub delete_set {
my $name = shift;
delete $sets{$name};
®ion;
}
sub sf_bessel_J0 {
return gsl_sf_bessel_J0( $_[0] );
}
sub sf_bessel_J1 {
return gsl_sf_bessel_J1( $_[0] );
}
sub sf_bessel_Y0 {
return gsl_sf_bessel_Y0( $_[0] );
}
sub sf_bessel_Y1 {
return gsl_sf_bessel_Y1( $_[0] );
}
sub test {
return $_[0] + 2;
}
MainLoop;
exit(1);
|