pashanoid has asked for the wisdom of the Perl Monks concerning the following question:

Dear Bretheren, I wrote this charting script, it creates charts of wind/solar power generation for a small house. Everything is great, except that the mouse wheel scrolls individual charts up and down instead of moving all of them together. I can only scroll the entire page using the side scroll bar. Here is a picture of the program:

http://pashanoid.ru/images/windgen.png

Please help me stop the scroll wheel from moving individual charts up and down, and make it move the entire window!

#!/usr/bin/perl use strict; use warnings; use Tk; use Tk::Chart; use Tk::Chart::Lines; use Tk::Canvas::GradientColor; use Tk::Pane; use DBI; use utf8; use Tk::DateEntry; use POSIX qw/strftime/; use Time::Local; my ($mw, $pane); my (@data0, @data1, @data2, @data3); #my $datemin = '2012-01-16 05:59:06'; #my $datemax = '2012-01-16 10:07:32'; my $datemin; my $datemax; my $color_start = '#ffffff'; #my $color_end = '#DF776F'; my $color_end = '#bbbbbb'; &dates; #print "datemin = $datemin datemax=$datemax\n"; #my $date; my ($chart0, $chart1, $chart2, $chart3, $xlabelskip); my ($powermax, $powermin, $poweravg); my ($speedmax, $speedmin, $speedavg, $powersum); my ($battmax, $battmin, $battavg); my ($powersunmax, $powersunmin, $powersunavg, $powersunsum); my (@timeline, @speed, @power, @v_acc, @powersun); &update_data; &create_mw; &set_charts; &render; MainLoop(); exit; sub draw_charts { $chart0->clearchart; $chart1->clearchart; $chart2->clearchart; $chart3->clearchart; $chart0->destroy; $chart1->destroy; $chart2->destroy; $chart3->destroy; $mw->destroy; &create_mw; &update_data; &set_charts; &render; } sub render { $chart0->plot(\@data0); #u akb $chart1->plot(\@data1); #sun p $chart2->plot(\@data2); #wind p $chart3->plot(\@data3); #wind speed } sub create_mw { $mw = MainWindow->new(); $mw->geometry( "840x800" ); #$mw->resizable(1,1); $mw->title("SA wind generation from $datemin to $datemax"); $mw->optionAdd("*font", "*utf-8"); $mw->fontCreate('giant_rus', -family => 'nimbus sans l', -weight = +> 'normal', -size=>int(-13*13/10)); $mw->fontCreate('tiny_rus', -family => 'nimbus sans l', -weight => + 'normal', -size=>int(-12*12/10)); $pane = $mw->Scrolled(qw/Pane -scrollbars e -width 990 -height 960 +/)->pack; my $dateframe=$pane->Frame()->pack(-side=>'top', -anchor=>'nw', -p +adx=>'15'); my $datelabel = $dateframe->Label(-text => '&#1044;&#1080;&#1072;& +#1087;&#1072;&#1079;&#1086;&#1085;: ', -font => 'giant_rus')->pack(-s +ide => 'left'); my @daynames=(); foreach (0..6) { push @daynames,strftime("%a",0,0,0,1,1,1,$_); } my $datebegin = $dateframe->DateEntry( -font => 'giant_rus', -daynames => \@daynames, -todaybackground => 'green', -tex +tvariable => \$datemin, -formatcmd => sub { sprintf ("%d-%02d-%02d 00:00:00",$_[0] +,$_[1],$_[2]);}, -width => 18 )->pack(-side => 'left'); my $dateend = $dateframe->DateEntry( -font => 'giant_rus', -daynames => \@daynames, -todaybackground => 'green', -tex +tvariable => \$datemax, -formatcmd => sub { sprintf ("%d-%02d-%02d 00:00:00",$_[0] +,$_[1],$_[2]);}, -width => 18 )->pack(-side => 'left'); my $buttonok = $dateframe->Button( -text=>'Ok', -command=> \&draw_ +charts )->pack(-side => 'left'); } sub set_charts{ $chart0 = $pane->Lines( -title => "U &#1072;&#1082;&#1073; min: $battmin max +: $battmax avg: $battavg (m/s)", -titlefont => 'giant_rus', -textfont => 'tiny_rus', -titleheight => '5', -xlabelfont => 'tiny_rus', -ylabelfont => 'tiny_rus', -ylabel => 'V', -boxaxis => 1, -yticknumber => 5, -linewidth => 2, -bezier => 1, -alltickview => 1, -pointline => 0, -markers => [10, 9, 9], -xtickheight => 5, -ylongticks => 1, -ylongtickscolor => 'white', -xlongticks => 1, -xlongtickscolor => 'white', -width => 800, -height => 220, -yminvalue => $battmin, -ymaxvalue => $battmax, -xlabelskip => $xlabelskip, #)->pack(qw / -fill both -expand 1/); )->pack(); $chart0->enabled_gradientcolor(); $chart0->set_gradientcolor( -start_color => $color_start, -end_color => $color_end, -type => 'linear_vertical', ); $chart3 = $pane->Lines( -title => "&#1057;&#1086;&#1083;&#1085;&#1094;&#1077; +&#1075;&#1077;&#1085;&#1077;&#1088;&#1072;&#1094;&#1080;&#1103; min: +$powersunmin max: $powersunmax avg: $powersunavg (Wt) sum: $powersu +nsum (kWt*h)", -titlefont => 'giant_rus', -textfont => 'tiny_rus', -titleheight => '5', -xlabelfont => 'tiny_rus', -ylabelfont => 'tiny_rus', -ylabel => 'P', -boxaxis => 1, -yticknumber => 5, -linewidth => 2, -bezier => 1, -alltickview => 1, -pointline => 0, -markers => [10, 9, 9], -xtickheight => 5, -ylongticks => 1, -ylongtickscolor => 'white', -xlongticks => 1, -xlongtickscolor => 'white', -width => 800, -height => 220, -yminvalue => $powersunmin, -ymaxvalue => $powersunmax, -xlabelskip => $xlabelskip, -colordata => [ qw(orange) ], #)->pack(qw / -fill both -expand 1 /); )->pack(); $chart3->enabled_gradientcolor(); $chart3->set_gradientcolor( -start_color => $color_start, -end_color => $color_end, -type => 'linear_vertical', ); $chart2 = $pane->Lines( -title => "&#1042;&#1077;&#1090;&#1088;&#1086;&#1075;&#10 +77;&#1085;&#1077;&#1088;&#1072;&#1094;&#1080;&#1103; min: $powermin +max: $powermax avg: $poweravg (Wt) sum: $powersum (kWt*h)", -titlefont => 'giant_rus', -textfont => 'tiny_rus', -titleheight => '5', -xlabelfont => 'tiny_rus', -ylabelfont => 'tiny_rus', -ylabel => 'P', -boxaxis => 1, -yticknumber => 5, -linewidth => 2, -bezier => 1, -alltickview => 1, -pointline => 0, -markers => [10, 9, 9], -xtickheight => 5, -ylongticks => 1, -ylongtickscolor => 'white', -xlongticks => 1, -xlongtickscolor => 'white', -width => 800, -height => 220, -yminvalue => $powermin, -ymaxvalue => $powermax, -xlabelskip => $xlabelskip, -colordata => [ qw(blue) ], #)->pack(qw / -fill both -expand 1 /); )->pack(); $chart2->enabled_gradientcolor(); $chart2->set_gradientcolor( -start_color => $color_start, -end_color => $color_end, -type => 'linear_vertical', ); $chart1 = $pane->Lines( -title => "&#1057;&#1082;&#1086;&#1088;&#1086;&#1089; +&#1090;&#1100; &#1074;&#1077;&#1090;&#1088;&#1072; min: $speedmin ma +x: $speedmax avg: $speedavg (m/s)", -titlefont => 'giant_rus', -textfont => 'tiny_rus', -titleheight => '5', -xlabelfont => 'tiny_rus', -ylabelfont => 'tiny_rus', -ylabel => 'V', -boxaxis => 1, -yticknumber => 5, -linewidth => 2, -bezier => 1, -alltickview => 1, -pointline => 0, -markers => [10, 9, 9], -xtickheight => 5, -ylongticks => 1, -ylongtickscolor => 'white', -xlongticks => 1, -xlongtickscolor => 'white', -width => 800, -height => 220, -yminvalue => $speedmin, -ymaxvalue => $speedmax, -xlabelskip => $xlabelskip, -colordata => [ qw(green) ], )->pack(); $chart1->enabled_gradientcolor(); $chart1->set_gradientcolor( -start_color => $color_start, -end_color => $color_end, -type => 'linear_vertical', ); } sub dates { my $dbfile = 'wind.db'; my $dbh = DBI->connect("dbi:SQLite:dbname=$dbfile","",""); # my $sth; $sth = $dbh->prepare("select datetime('now','localtime', '-1 d +ay'), datetime('now','localtime');"); $sth->execute(); while (my @result = $sth->fetchrow_array()) { $datemin = $result[0]; $datemax = $result[1]; } $sth->finish; $dbh->disconnect; } sub update_data{ ($speedmax, $speedmin, $speedavg) = (0,0,0); ($powermax, $powermin, $poweravg, $powersum) = (0,0,0,0); ($powersunmax, $powersunmin, $powersunavg, $powersunsum) = (0,0,0, +0); @data0 =(); @data1 = (); @data2 = (); @data3 = (); @timeline = (); @speed = (); @power = (); @v_acc = (); @powersun = (); #print "sub datemax=$datemax datemin=$datemin\n"; my $count; my $dbfile = 'wind.db'; my $dbh = DBI->connect("dbi:SQLite:dbname=$dbfile","",""); # my $sth; $sth = $dbh->prepare(" SELECT max(speed), min(speed), avg(speed), max(power), min(power), avg(power), sum(power/60/60*10)/1000, max(v_acc), min(v_acc), avg(v_acc), max(sun_power_output), min(sun_power_output), avg(sun_powe +r_output), sum(sun_power_output/60/60*10)/1000 from wind where ((date < '$datemax') and (date > '$datemin')) +;"); $sth->execute(); while (my @result = $sth->fetchrow_array()) { ($speedmax, $speedmin, $speedavg, $powermax, $powermin, $power +avg, $powersum, $battmax, $battmin, $battavg, $powersunmax, $powersunmin, $powersunavg, $powersunsum) = @result; # = $result[0]; } $sth->finish; $speedavg= sprintf("%.2f", $speedavg); $poweravg = sprintf("%.3f", $poweravg); $powersum = sprintf("%.3f", $powersum); $battavg = sprintf("%.2f", $speedavg); $powersunavg = sprintf("%.3f", $powersunavg); $powersunsum = sprintf("%.3f", $powersunsum); $sth = $dbh->prepare(" SELECT strftime(\'%H:%M',date), speed, power, v_acc, sun_power +_output FROM wind WHERE ((date < '$datemax') and (date > '$datemin')) +;"); $sth->execute(); $count = 0; while (my @result = $sth->fetchrow_array()) { push (@timeline,$result[0]); push (@speed,$result[1]); if ($result[2] > 30){ push (@power,$result[2]); } else { push (@power, 0); } push (@v_acc,$result[3]); push (@powersun,$result[4]); $count++; } $sth->finish; $dbh->disconnect; $xlabelskip = int($count/12); $xlabelskip = 1 if ($xlabelskip < 1); @data0 = (\@timeline, \@v_acc); @data1 = (\@timeline, \@speed); @data2 = (\@timeline, \@power); @data3 = (\@timeline, \@powersun); }

Replies are listed 'Best First'.
Re: Stop mouse wheel from moving charts up/down Tk::Scrolled
by Marshall (Canon) on Jan 18, 2012 at 16:27 UTC
    I can't run your code because I don't have chart installed. But I think what you want to do here is put your charts inside of a frame and then scroll the frame (add Scrolled method to it), not a chart within the frame.

    Update: I tried installing more packages, but still can't run the code (SQLite db missing). Can you make something a LOT more simple that still demonstrates the problem. That means self-contained runnable code that is pared down to the bare essentials? Charts don't have to do anything meaningful - or use any fancy options- just get something simple that demo's the problem. This GUI stuff can get tricky but, if we can actually run your code, then I'm sure a solution will be forthcoming.

      I put the code and database here:

      http://pashanoid.ru/code/chart.pl

      http://pashanoid.ru/code/wind.db

      wind.db should be in same dir as chart.pl Thank you so much for your efforts!

        Your code bombs on my machine.
        I don't have Russian language fonts, but I'm not sure that is the problem.

        I can see the first chart before the code abends.

        Argument "" isn't numeric in numeric ge (>=) at C:/Perl/site/lib/Tk/Ch +art.pm line 1112. [WARNING] : -yminvalue and -ymaxvalue do not include all data at C:/Perl/site/lib/Tk/Chart/Lines.pm line 904 [BE CARREFUL] : -ymaxvalue option must be a number or real number at C:/Perl/site/lib/Tk/Chart/Lines.pm line 905 Process completed with exit code 255
Re: Stop mouse wheel from moving charts up/down Tk::Scrolled
by thundergnat (Deacon) on Jan 18, 2012 at 19:47 UTC

    Like Marshall said, it's a LOT easier to give you help if you provide a complete runnable example of a script demonstrating the problem you are having.

    There appears to be two separate problems. First, the pane doesn't seem to get scroll wheel events bound correctly. (Tk::Chart overriding / grabbing them perhaps?) Second, even if the scroll events are bound correctly, if the pane doesn't have focus, it won't receive them.

    A kind of hacky fix is to bind the scroll wheel yourself, then make sure anything that grabs focus, releases it to the pane when done.

    Add the following lines to the end of your create_mw{} sub:

    ####################################### bindmousewheel($pane); $pane->focus; for ($datebegin, $dateend, $buttonok) { $_->bind('<Leave>', sub {$pane->focus} ); } #######################################

    and add the following bindmousewheel{} sub to your script:

    ####################################### sub bindmousewheel { my ($w) = @_; if ($^O =~ /Win32/) { $w->bind( '<MouseWheel>' => [ sub { $w->yview( 'scroll', -( $_[1] / 120 ) * 3, 'units' + ); }, Ev('D') ] ); } else { $w->bind( '<4>' => sub { $w->yview( 'scroll', -3, 'units' ) unless $Tk::strictM +otif; } ); $w->bind( '<5>' => sub { $w->yview( 'scroll', +3, 'units' ) unless $Tk::strictM +otif; } ); } } #######################################

    With those changes it works for me. (Or at least how I would expect.) Activeperl 5.10.1, WinXP, YMMV

    Update: you may need to override the scroll wheel binding for the individual charts and rebind to the pane. I didn't have to with the test script I used, but your circumstances might be different.

      I congratulate you on getting the code to run!

      I am also on Active State 5.10.1, WinXP but I am so far unable to get this to run. I see the first chart drawn, then a LONG pause, then abend with output as above.

      Binding specific button presses is tricky.
      So far I haven't gotten to "first base", i.e. getting the OP's code to run. Any suggestions?
      I've never see this: [BE CARREFUL] message before.

        I started looking at it before the OP posted the links to his db, so I just hacked up some dummy data.

        I blanked out the dates and update_data routines since they didn't seem pertinent to the problem:

        sub dates {} sub update_data{}

        Then put in some dummy data at the top just after the @dataX arrays were declared:

        @data0 = @data1 = @data2 = @data3 =([0..200], [300..500]);

        That got me able to run the script to try and troubleshoot. Lots of 'uninitialized' warnings, but it ran at least. Putting "no warnings qw/uninitialized/;" at the top reduced that clutter.

        UPDATE: FWIW here is the actual code I tested with:

        UPDATE 2: Crap. It needs some further modifications to work correctly under Linux. Added some lines to the render{} subroutine to rebind the scroll buttons if you aren't running under Win32.

      nope, does not do the trick...

      Database: http://pashanoid.ru/code/wind.db 750kb

      Code: http://pashanoid.ru/code/chart.pl 11k

      When I'm over one of the charts and move the wheel, the chart goes up or down. Please help me stop this silly behavior

      nope, does nothing, I'm still able to move the individual charts up and down... thank you for your help though...

        Did you follow the link I posted? Did you download and try the code that was modified to work under Linux? Since you replied to the parent node rather than the node with the actual code or the pointer to it, I assume not.

        It works for me on two different computers running two different Linux distros using two different versions of Perl.

        BTW, it is much easier to follow the conversation if you don't attach follow-up posts to random nodes in the thread.