Better error message in double * typemap and refactor FFT tests
[Math-GSL.git] / examples / tkplotdataset
blob7baa8259d126d4b307250404438181e37b9a7172
1 #!/usr/bin/perl
2 use Tk;
3 use Tk::PlotDataset;
4 use Tk::LineGraphDataset;
5 use Math::GSL::SF qw/:all/;
6 use strict;
8 my ( %sets, $graph );
9 my $window = MainWindow->new( -title => 'Math::GSL Plot', );
10 my @popo = ("gsl_sf_bessel_J0", "gsl_sf_bessel_J1", "gsl_sf_bessel_Y0", "gsl_sf_bessel_Y1");
12 for my $n (0..3) {
13 my $del;
14 $window->Button(
15 -text => $popo[$n],
16 -command => sub {
17 region($popo[$n]);
18 $del->configure( -state => "normal" );
20 )->pack;
21 $del = $window->Button(
22 -text => "Remove " . $popo[$n],
23 -state => "disabled",
24 -command => sub {
25 delete_set($popo[$n]);
26 $del->configure( -state => "disabled" );
28 )->pack;
32 $window->Button( -text => "test", -command => [ \&region, "test", $window ] )
33 ->pack;
35 sub region {
36 my $name = shift;
37 if ($graph) { $graph->packForget(); }
39 my @region = map { $_ / 10 } ( -400 .. -1, 0, 1 .. 400 );
40 my @region2 = map { $_ / 10 } ( 1 .. 400 );
41 my %functions = (
42 "gsl_sf_bessel_J0" => \&sf_bessel_J0,
43 "gsl_sf_bessel_J1" => \&sf_bessel_J1,
44 "gsl_sf_bessel_Y0" => \&sf_bessel_Y0,
45 "gsl_sf_bessel_Y1" => \&sf_bessel_Y1,
46 "test" => \&test,
48 my @data1;
49 if ($name) {
50 if ( $name =~ /(Y1|Y0)$/ ) {
51 @data1 = map { $functions{$name}->($_) } (@region2);
53 else {
54 @data1 = map { $functions{$name}->($_) } (@region);
57 my $dataset1 = LineGraphDataset->new(
58 -name => $name,
59 -plottitle => [$name],
60 -xData => \@region,
61 -yData => \@data1,
62 -yAxis => 'Y',
64 # -color => 'red'
66 $sets{$name} = $dataset1;
68 $graph = $window->PlotDataset(
69 -width => 500,
70 -height => 500,
71 -background => 'snow'
72 )->pack( -fill => 'both', -expand => 1 );
74 my @datasets = values %sets;
75 $graph->addDatasets(@datasets);
76 $graph->plot;
79 sub delete_set {
80 my $name = shift;
81 delete $sets{$name};
82 &region;
85 sub sf_bessel_J0 {
86 return gsl_sf_bessel_J0( $_[0] );
89 sub sf_bessel_J1 {
90 return gsl_sf_bessel_J1( $_[0] );
93 sub sf_bessel_Y0 {
94 return gsl_sf_bessel_Y0( $_[0] );
97 sub sf_bessel_Y1 {
98 return gsl_sf_bessel_Y1( $_[0] );
101 sub test {
102 return $_[0] + 2;
105 MainLoop;
106 exit(1);