Beefy Boxes and Bandwidth Generously Provided by pair Networks
Welcome to the Monastery
 
PerlMonks  

Tk::Gauge errors

by Anonymous Monk
on Aug 06, 2012 at 03:03 UTC ( #985593=perlquestion: print w/ replies, xml ) Need Help??
Anonymous Monk has asked for the wisdom of the Perl Monks concerning the following question:

Relatively new to writing Perl, I've recently come across an error that, for the life of me, I cannot figure out how to resolve when using Tk::Gauge. The issue comes when the window holding the gauge, and associated scripts, is opened, used, closed, and then re-opened within the same "session" of the script. The gauge refuses to continue working beyond that first presence.

Below is the error that Terminal is spitting out (I am running Ubuntu with 5.12.4 at the moment), followed by the actual code itself extracted from the main script.

############### # Error print # ############### prompt$ perl gaugetest2 XS_Tk__Callback_Call error:Can't use an undefined value as an ARRAY re +ference at /usr/local/share/perl/5.12.4/Tk/Gauge.pm line 408. XS_Tk__Callback_Call error:Can't use an undefined value as an ARRAY re +ference at /usr/local/share/perl/5.12.4/Tk/Gauge.pm line 408. Tk::Error: Can't use an undefined value as an ARRAY reference at /usr/ +local/share/perl/5.12.4/Tk/Gauge.pm line 408. Tk::Gauge::maxradius at /usr/local/share/perl/5.12.4/Tk/Gauge.pm line + 408 Tk::Gauge::centerpoint at /usr/local/share/perl/5.12.4/Tk/Gauge.pm li +ne 398 Tk::Gauge::setvalue at /usr/local/share/perl/5.12.4/Tk/Gauge.pm line +321 Tk::Gauge::tracew at /usr/local/share/perl/5.12.4/Tk/Gauge.pm line 38 +3 Tk::Trace::store at /usr/lib/perl5/Tk/Trace.pm line 94 Tie::Watch::callback at /usr/lib/perl5/Tie/Watch.pm line 399 Tie::Watch::Scalar::STORE at /usr/lib/perl5/Tie/Watch.pm line 453 Tk::Widget::traceVdelete at /usr/lib/perl5/Tk/Trace.pm line 182 Tk::Gauge::delete_traces at /usr/local/share/perl/5.12.4/Tk/Gauge.pm +line 299 Tk::Gauge::ConfigChanged at /usr/local/share/perl/5.12.4/Tk/Gauge.pm +line 279 Tk::After::once at /usr/lib/perl5/Tk/After.pm line 90 [once,[{},after#11,idle,once,[ConfigChanged,{},{}]]] ("after" script) Tk::Error: Can't use an undefined value as an ARRAY reference at /usr/ +local/share/perl/5.12.4/Tk/Gauge.pm line 408. Tk::Gauge::maxradius at /usr/local/share/perl/5.12.4/Tk/Gauge.pm line + 408 Tk::Gauge::centerpoint at /usr/local/share/perl/5.12.4/Tk/Gauge.pm li +ne 398 Tk::Gauge::setvalue at /usr/local/share/perl/5.12.4/Tk/Gauge.pm line +321 Tk::Gauge::tracew at /usr/local/share/perl/5.12.4/Tk/Gauge.pm line 38 +3 Tk::Trace::store at /usr/lib/perl5/Tk/Trace.pm line 94 Tie::Watch::callback at /usr/lib/perl5/Tie/Watch.pm line 399 Tie::Watch::Scalar::STORE at /usr/lib/perl5/Tie/Watch.pm line 453 Tk::Widget::traceVdelete at /usr/lib/perl5/Tk/Trace.pm line 182 Tk::Gauge::delete_traces at /usr/local/share/perl/5.12.4/Tk/Gauge.pm +line 299 Tk::Gauge::ConfigChanged at /usr/local/share/perl/5.12.4/Tk/Gauge.pm +line 279 Tk::After::once at /usr/lib/perl5/Tk/After.pm line 90 [once,[{},after#12,idle,once,[ConfigChanged,{},{}]]] ("after" script) ####### # end # ####### Perl code ######### #!/usr/bin/perl -w use Tk; use Tk::Table; use Tk::Gauge; use strict; use diagnostics; my $mw = MainWindow->new; $mw->geometry("75x75"); $mw->title("Gauge testing"); my $button = $mw->Button(-text => "Null", -command => \&button3_sub)- +>pack(-anchor=>'center'); our ($alpha,$alphaone,$beta,$betaone,$mh,$output_text,$gaugevar,$cur); sub button3_sub { $mh= (35+(29-1)*6); $cur=$mh; my $hw = $mw -> Toplevel; $hw ->geometry("650x450"); $hw ->title('Health Track (!!!WARNING:DO NOT EXIT THIS WINDOW UNTIL DO +NE)'); my $hf = $hw -> Frame(-background => 'white')->pack(-ipadx => 250, -fi +ll => 'both', -expand =>'yes'); my $left_frame = $hf -> Frame (-background=>'white')->pack(-side=>'lef +t', -fill => 'y'); my $right_frame = $hf->Frame(-background=>'white')->pack(-ipadx=>150, +-fill =>'y', -anchor=>'n',-expand=>1); $betaone = $left_frame->Entry(-background => "green",)->pack( +-anchor=>'nw'); my $beta_button = $left_frame->Button(-text => "Alpha Null", - +command => \&update_output)->pack(-anchor=>'nw'); $alphaone = $left_frame->Entry(-background => "red",)->pack(- +anchor=>'nw'); my $alpha_button = $left_frame->Button(-text => "Alpha Null", +-command => \&update_output)->pack(-anchor=>'nw'); $output_text = $left_frame->Text(-height=>5,-width=>15)->pack(-expand +=>0,); my $gauge= $right_frame->Gauge( -background => 'white', -bands =>[ { -piecolor => 'green', -minimum=> 50, -maximum=> 100, -tag=> 'Healthy', }, { -piecolor => 'yellow', -minimum=> 25, -maximum=> 50, -tag=> 'Bloodied', }, { -piecolor => 'red', -minimum=> 0, -maximum=> 25, -tag=> 'Critical', } ], -bandplace => 'underticks', -bandstyle=> 'pieslice', -bandwidth=> 0, -caption => 'Current Value', -captioncolor=> 'black', -extent => -180, -from => 0, -hubcolor => 'black', -huboutline => 'blue', -hubradius => 15, -majortickinterval => 10, -majorticklabelplace =>'outside', -finetickinterval => 1, -minortickinterval => 5, -margin =>40, -needles => [ { -arrowshape => [ 12, 23, 6 ], -color => 'black', -command => undef, -format => '%d', -radius => 196, -showvalue => 1, -tag => 'null', -title => 'null', -titlecolor => 'white', -titlefont =>'Helvetica-12', -titleplace => 'south', -variable => \$gaugevar, -width => 5, } ] , -start => 180, -to => 100, )->pack(-fill=>'both',-expand=>1); ##my $gaugebutton1 = $left_frame ->Button(-text => "Update", -command +=> \&gaugebutton1_sub)->pack(-side=>'bottom'); #currently pointless. +will leave in for possible diagnostics. } sub gaugebutton1_sub { $gaugevar=($cur/$mh)*100; }#above sub redundant(?) due to &update_output# sub update_output { my $beta = $betaone->get(); my $alpja = $alphaone->get(); if ($alpha eq "") { $alpha = 0; } if ($beta eq "") { $beta = 0; } $cur=$cur+$beta-$alpha; if ($cur gt $mh){$cur=$mh;} if ($cur lt 0){$cur=0;} my $output = "Current value:\n$cur"; $output_text->delete('0.0', 'end'); $output_text->insert("end", $output); $betaone->delete('0.0', 'end'); $alphaone->delete('0.0', 'end'); $gaugevar=($cur/$mh)*100; } MainLoop; ###end

If anyone has some ideas on what's wrong, I'd love to know how to fix it. I believe it can be fixed by framing the gauge within the GUI's primary window, but I'm hoping there's a solution that'll keep me from have to do that.

Comment on Tk::Gauge errors
Download Code
Re: Tk::Gauge errors
by Khen1950fx (Canon) on Aug 06, 2012 at 04:43 UTC
    Take a closer look at your first subroutine. Make sure that you declare your variables. So, fixed:
    sub button3_sub { my $mh = ( 35 + ( 29 - 1 ) * 6 ); my $cur = $mh; }
    As for the rest, I couldn't reproduce your problem. This worked for me.
    #!/usr/bin/perl use strict; use autodie; use warnings; use Tk; use Tk::Table; use Tk::Gauge; my $mw = MainWindow->new; $mw->geometry("75x75"); $mw->title("Gauge testing"); my $button = $mw->Button( -text => "Null", -command => \&button3_sub ) ->pack( -anchor => 'center' ); my ( $alpha, $alphaone, $beta, $betaone, $mh, $output_text, $gaugevar, + $cur ); sub button3_sub { my $mh = ( 35 + ( 29 - 1 ) * 6 ); my $cur = $mh; my $hw = $mw->Toplevel; $hw->geometry("650x450"); $hw->title('Health Track (!!!WARNING:DO NOT EXIT THIS WINDOW UNTIL + DONE)'); my $hf = $hw->Frame( -background => 'white' ) ->pack( -ipadx => 250, -fill => 'both', -expand => 'yes' ); my $left_frame = $hf->Frame( -background => 'white' ) ->pack( -side => 'left', -fill => 'y' ); my $right_frame = $hf->Frame( -background => 'white' ) ->pack( -ipadx => 150, -fill => 'y', -anchor => 'n', -expand => +1 ); $betaone = $left_frame->Entry( -background => "green", )->pack( -anchor => +'nw' ); my $beta_button = $left_frame->Button( -text => "Alpha Null", -command => \&update +_output ) ->pack( -anchor => 'nw' ); $alphaone = $left_frame->Entry( -background => "red", )->pack( -anchor => 'n +w' ); my $alpha_button = $left_frame->Button( -text => "Alpha Null", -command => \&update +_output ) ->pack( -anchor => 'nw' ); $output_text = $left_frame->Text( -height => 5, -width => 15 )->pack( -expand = +> 0, ); my $gauge = $right_frame->Gauge( -background => 'white', -bands => [ { -piecolor => 'green', -minimum => 50, -maximum => 100, -tag => 'Healthy', }, { -piecolor => 'yellow', -minimum => 25, -maximum => 50, -tag => 'Bloodied', }, { -piecolor => 'red', -minimum => 0, -maximum => 25, -tag => 'Critical', } ], -bandplace => 'underticks', -bandstyle => 'pieslice', -bandwidth => 0, -caption => 'Current Value', -captioncolor => 'black', -extent => -180, -from => 0, -hubcolor => 'black', -huboutline => 'blue', -hubradius => 15, -majortickinterval => 10, -majorticklabelplace => 'outside', -finetickinterval => 1, -minortickinterval => 5, -margin => 40, -needles => [ { -arrowshape => [ 12, 23, 6 ], -color => 'black', -command => undef, -format => '%d', -radius => 196, -showvalue => 1, -tag => 'null', -title => 'null', -titlecolor => 'white', -titlefont => 'Helvetica-12', -titleplace => 'south', -variable => \$gaugevar, -width => 5, } ], -start => 180, -to => 100, )->pack( -fill => 'both', -expand => 1 ); } sub gaugebutton1_sub { $gaugevar = ( $cur / $mh ) * 100; } sub update_output { my $beta = $betaone->get(); my $alpja = $alphaone->get(); if ( $alpha eq "" ) { $alpha = 0; } if ( $beta eq "" ) { $beta = 0; } $cur = $cur + $beta - $alpha; if ( $cur gt $mh ) { $cur = $mh; } if ( $cur lt 0 ) { $cur = 0; } my $output = "Current value:\n$cur"; $output_text->delete( '0.0', 'end' ); $output_text->insert( "end", $output ); $betaone->delete( '0.0', 'end' ); $alphaone->delete( '0.0', 'end' ); $gaugevar = ( $cur / $mh ) * 100; } MainLoop;

      Even with the fixed code you provided, I'm still getting the exact same error messages. Could it be a system-specific error? Beyond that, any ideas on how to possibly fix it? I recently compiled 5.16.0 on my computer, so if I insert 'require 5.16.0' after the Tk modules, I get an entirely different error of:

      Perl v5.16.0 required--this is only v5.12.4, stopped at gaugetest2 lin +e 10.

      If I can fix that, is there a chance it'd fix the errors I'm getting?

        Yes, that would fix it, chances are that one of the modules has a use v5.16.0 declaration, so anything less will crash it

        --linuxkid


        imrunningoutofideas.co.cc
Re: Tk::Gauge errors
by zentara (Archbishop) on Aug 06, 2012 at 09:08 UTC
    Hi, I see the same error as you on both versions of the script. I'm on Linux with Perl 14.2.

    I don't know the reason it is happening, but you can make a workaround by making your toplevel window reusable, inhibiting its Window Manager's Close icon, and packForgetting its old widgets. This works for me. ( the code could use some cleanup, but it shows the way) :-)

    #!/usr/bin/perl -w use Tk; use Tk::Table; use Tk::Gauge; use strict; use diagnostics; my $hw; # make a reusable toplevel my $mw = MainWindow->new; $mw->geometry("75x75"); $mw->title("Gauge testing"); my $button = $mw->Button(-text => "Null", -command => \&button3_sub)-> +pack(-anchor=>'center'); my ($alpha,$alphaone,$beta,$betaone,$mh,$output_text,$gaugevar,$cur); #our ($alpha,$alphaone,$beta,$betaone,$mh,$output_text,$gaugevar,$cur) +; sub button3_sub { $mh= (35+(29-1)*6); $cur=$mh; do_Toplevel(); #my $hw = $mw -> Toplevel; $hw ->geometry("650x450"); $hw ->title('Health Track (!!!WARNING:DO NOT EXIT THIS WINDOW UNTIL DO +NE)'); my $hf = $hw -> Frame(-background => 'white')->pack(-ipadx => 250, -fi +ll => 'both', -expand =>'yes'); my $left_frame = $hf -> Frame (-background=>'white')->pack(-side=>'lef +t', -fill => 'y'); my $right_frame = $hf->Frame(-background=>'white')->pack(-ipadx=>150, +-fill =>'y', -anchor=>'n',-expand=>1); $betaone = $left_frame->Entry(-background => "green",)->pack( +-anchor=>'nw'); my $beta_button = $left_frame->Button(-text => "Alpha Null", - +command => \&update_output)->pack(-anchor=>'nw'); $alphaone = $left_frame->Entry(-background => "red",)->pack(- +anchor=>'nw'); my $alpha_button = $left_frame->Button(-text => "Alpha Null", +-command => \&update_output)->pack(-anchor=>'nw'); $output_text = $left_frame->Text(-height=>5,-width=>15)->pack( +-expand=>0,); my $gauge= $right_frame->Gauge( -background => 'white', -bands =>[ { -piecolor => 'green', -minimum=> 50, -maximum=> 100, -tag=> 'Healthy', }, { -piecolor => 'yellow', -minimum=> 25, -maximum=> 50, -tag=> 'Bloodied', }, { -piecolor => 'red', -minimum=> 0, -maximum=> 25, -tag=> 'Critical', } ], -bandplace => 'underticks', -bandstyle=> 'pieslice', -bandwidth=> 0, -caption => 'Current Value', -captioncolor=> 'black', -extent => -180, -from => 0, -hubcolor => 'black', -huboutline => 'blue', -hubradius => 15, -majortickinterval => 10, -majorticklabelplace =>'outside', -finetickinterval => 1, -minortickinterval => 5, -margin =>40, -needles => [ { -arrowshape => [ 12, 23, 6 ], -color => 'black', -command => undef, -format => '%d', -radius => 196, -showvalue => 1, -tag => 'null', -title => 'null', -titlecolor => 'white', -titlefont =>'Helvetica-12', -titleplace => 'south', -variable => \$gaugevar, -width => 5, } ] , -start => 180, -to => 100, )->pack(-fill=>'both',-expand=>1); ##my $gaugebutton1 = $left_frame ->Button(-text => "Update", -command +=> \&gaugebutton1_sub)->pack(-side=>'bottom'); #currently pointless. +will leave in for possible diagnostics. } sub gaugebutton1_sub { $gaugevar=($cur/$mh)*100; }#above sub redundant(?) due to &update_output# sub update_output { my $beta = $betaone->get(); my $alpja = $alphaone->get(); if ($alpha eq "") { $alpha = 0; } if ($beta eq "") { $beta = 0; } $cur=$cur+$beta-$alpha; if ($cur gt $mh){$cur=$mh;} if ($cur lt 0){$cur=0;} my $output = "Current value:\n$cur"; $output_text->delete('0.0', 'end'); $output_text->insert("end", $output); $betaone->delete('0.0', 'end'); $alphaone->delete('0.0', 'end'); $gaugevar=($cur/$mh)*100; } MainLoop; ###end sub do_Toplevel { if ( !Exists( $hw ) ) { $hw = $mw->Toplevel(); $hw->protocol('WM_DELETE_WINDOW' => sub {}); #prevent WM close + button working $hw->title( "Toplevel" ); $hw->Button( -text => "Close", -command => sub { $hw->withdraw } )->pack; } else { #clear out old widgets my @w = $hw->packSlaves; foreach (@w) { $_->packForget; } $hw->Button( -text => "Close", -command => sub { $hw->withdraw } )->pack; $hw->deiconify(); $hw->raise(); } }

    I'm not really a human, but I play one on earth.
    Old Perl Programmer Haiku ................... flash japh

      Thank you so much zentara, from the testing I've done so far, the script changes work for me as well (although I did find out there was a typoed variable name in the process). I assume that I can extract the do_TopLevel sub and use it in places that are causing similar issues, replacing the variable names as needed? I'll likely continue stalking this to see if someone can figure out what's causing it. To which I'll ask: is it worth sending a bug report to the module page on CPAN even though it appears to have been left to gather dust by the author?

        As far as reusing that sub by replacing variable names, sure, Perl is free to modify.

        What I originally used it for, was I had problems with toplevels accumulating memory, even though they were being destroyed. This may be a another symptom of that.

        Tk::Gauge is old, and I doubt the author, has high priorities for it. A bug report can't hurt, but a better thing would be to offer to take over the module and fix it. :-)


        I'm not really a human, but I play one on earth.
        Old Perl Programmer Haiku ................... flash japh

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://985593]
Approved by ww
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others perusing the Monastery: (7)
As of 2014-10-22 01:16 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    For retirement, I am banking on:










    Results (112 votes), past polls