Beefy Boxes and Bandwidth Generously Provided by pair Networks
Clear questions and runnable code
get the best and fastest answer
 
PerlMonks  

Re^2: Error Not a tk object / Problems with multiple files

by reaper9187 (Scribe)
on Oct 16, 2012 at 11:50 UTC ( #999295=note: print w/ replies, xml ) Need Help??


in reply to Re: Error Not a tk object / Problems with multiple files
in thread Error Not a tk object / Problems with multiple files

Here you go:

#!/usr/local/bin/perl use Tk; # Main Window my $mw = new MainWindow; $mw->Frame(-background => 'red')->pack(-ipadx =>50, -side => "left", - +fill => "y"); #Making a text area my $txt = $mw -> Scrolled('Text',-width => 150, height => 40, -scrollb +ars=>'e', -font => "fixed 8 bold" ) -> pack (); $txt->insert('end', ""); #Declare that there is a menu my $mbar = $mw -> Menu(); $mw -> configure(-menu => $mbar); #The Main Buttons my $file = $mbar -> cascade(-label=>"File", -underline=>0, -tearoff => + 0); my $tool= $mbar -> cascade(-label =>"Tools", -underline=>0, -tearoff = +> 0); my $parser = $mbar -> cascade(-label =>"RL Parser", -underline=>0, -te +aroff => 0); my $help = $mbar -> cascade(-label =>"Help", -underline=>0, -tearoff = +> 0); ## File Menu ## $file -> command(-label => "Home", -underline=>0, -command=> \&home ); $file -> command(-label => "Check KPI definitions", -underline=>0, -command=> \&define ); $file -> checkbutton(-label =>"Check for faults", -underline => 0, -command => \&faults); $file -> separator(); $file -> command(-label =>"Exit", -underline => 1, -command => sub { exit } ); ## Tools Menu ## $tool -> command(-label => "Network planning", -underline=>0, -command=> \&nwplan ); $tool -> command(-label => " ", -underline=>0, -command=> \&optimize ); $tool -> separator(); $tool -> command(-label =>"Network Planning Rules", -underline =>1, -command => sub { $txt -> delete('1.0', 'end'); $txt->insert('end',"some text");}); ## Parse Menu ## $parser -> command(-label => "Parse the RL Dump", -underline=>0, -command=> \&parse ); ## Help Menu ## $help -> command(-label => "About", -underline=>0, -command=> \&help ); MainLoop; sub help { my ($opt) = @_; $mw->messageBox(-message=>"This function is not available yet"); } sub define { my $mw = new MainWindow; # Main Window my $frm_name = $mw -> Frame(); my $lab = $frm_name -> Label(-text=>"Enter KPI:"); my $ent = $frm_name -> Entry(); my $but = $mw -> Button(-text=>"Check", -command =>\&push_button1); my $textarea = $mw -> Frame(); #Creating Another Frame my $txt = $textarea -> Text(-width=>130, -height=>30, -font=> "fixed 1 +0 bold"); my $srl_y = $textarea -> Scrollbar(-orient=>'v',-command=>[yview => $t +xt]); my $srl_x = $textarea -> Scrollbar(-orient=>'h',-command=>[xview => $t +xt]); $txt -> configure(-yscrollcommand=>['set', $srl_y], -xscrollcommand=>['set',$srl_x]); $lab -> grid(-row=>1,-column=>1); $ent -> grid(-row=>1,-column=>2); $frm_name -> grid(-row=>1,-column=>1,-columnspan=>2); $but -> grid(-row=>4,-column=>1,-columnspan=>2); $txt -> grid(-row=>1,-column=>1); $srl_y -> grid(-row=>1,-column=>2,-sticky=>"ns"); $srl_x -> grid(-row=>2,-column=>1,-sticky=>"ew"); $textarea -> grid(-row=>5,-column=>1,-columnspan=>2); $txt -> insert('end',"some points" ); MainLoop; #This function will be executed when the button is pushed sub push_button1 { my $name = $ent -> get(); if($name eq "TCH Traffic") {$txt -> delete('1.0', 'end'); $txt -> insert('end',"some text"); } elsif($name eq "SDCCH Drop") {$txt -> delete('1.0', 'end'); $txt -> insert('end',"some text");} elsif($name eq "TCH Assignment") {$txt -> delete('1.0', 'end'); $txt -> insert('end'," some text");} elsif($name eq "TCH Blocking") {$txt -> delete('1.0', 'end'); $txt -> insert('end'," some text");} elsif($name eq "TCH Drop") {$txt -> delete('1.0', 'end'); $txt -> insert('end'," some text");} elsif($name eq "HOSR") {$txt -> delete('1.0', 'end'); $txt -> insert('end'," some text");} elsif($name eq "SDCCH Blocking") {$txt -> delete('1.0', 'end'); $txt -> insert('end',"some text");} else {$txt -> delete('1.0', 'end'); $txt -> insert('end'," Wrong Keyword. Please Try Again"); } } } sub nwplan { use Tk; #Global Variables my $gender = "TCH Drop"; # Main Window my $mw = new MainWindow; my $frm_name = $mw -> Frame(); my $lab = $frm_name -> Label(-text=>"Name:"); my $ent = $frm_name -> Entry(); my $frm_a = $mw -> Frame(); my $laba = $frm_a -> Label(-text=>"Name:"); my $enta = $frm_a -> Entry(); my $frm_b = $mw -> Frame(); my $labb = $frm_b -> Label(-text=>"Name:"); my $entb = $frm_b -> Entry(); #Define KPI my $frm_job = $mw -> Frame(); @set = (61,62, 63, 64 ,65 ,66 ,67 ,68 ,69 ,70 ,71 ,72, 73, 74, 75); #Gender my $frm_gender = $mw -> Frame(); my $lbl_gender = $frm_gender -> Label(-text=>"Enter the ARFCN of adjac +ent cell 1"); my $ent = $frm_gender -> Entry(); my $frm_gendera = $mw -> Frame(); my $lbl_gendera = $frm_gendera -> Label(-text=>"Enter the ARFCN of adj +acent cell 2"); my $enta = $frm_gendera -> Entry(); my $frm_genderb = $mw -> Frame(); my $lbl_genderb = $frm_genderb -> Label(-text=>"Enter the ARFCN of adj +acent cell 3"); my $entb = $frm_genderb -> Entry(); my $but = $mw -> Button(-text=>"Check", -command =>\&push_button2); #Text Area my $textarea = $mw -> Frame(); my $txt = $textarea -> Text(-width=>130, -height=>30, -font=> "fixed 1 +0 bold"); my $srl_y = $textarea -> Scrollbar(-orient=>'v',-command=>[yview => $t +xt]); my $srl_x = $textarea -> Scrollbar(-orient=>'h',-command=>[xview => $t +xt]); $txt -> configure(-yscrollcommand=>['set', $srl_y], -xscrollcommand=>['set',$srl_x]); #Geometry Management $lab -> grid(-row=>0,-column=>1); $ent -> grid(-row=>0,-column=>2); $lbl_gender -> grid(-row=>0,-column=>1); $frm_gender -> grid(-row=>2,-column=>1,-columnspan=>2); $laba -> grid(-row=>1,-column=>1); $enta -> grid(-row=>1,-column=>2); $lbl_gendera -> grid(-row=>1,-column=>1); $frm_gendera -> grid(-row=>3,-column=>1,-columnspan=>2); $labb -> grid(-row=>3,-column=>1); $entb -> grid(-row=>3,-column=>2); $lbl_genderb -> grid(-row=>3,-column=>1); $frm_genderb -> grid(-row=>4,-column=>1,-columnspan=>2); $but -> grid(-row=>4,-column=>2,-columnspan=>2); $txt -> grid(-row=>1,-column=>1); $srl_y -> grid(-row=>1,-column=>2,-sticky=>"ns"); $srl_x -> grid(-row=>2,-column=>1,-sticky=>"ew"); $textarea -> grid(-row=>5,-column=>1,-columnspan=>2); $txt -> insert('end'," some text"); MainLoop; ## Functions #This function will be executed when the button is pushed sub push_button2 { $gender = $ent ->get(); $gendera = $enta ->get(); $genderb = $entb ->get(); @list = (61,62,63,64,65,66,67,68,69,70,71,72,73,74,75 ); @final = (undef); @sum = (undef); if($gender >= 61 && $gender <= 75 && $gendera >= 61 && $gendera <= 75 + && $genderb >= 61 && $genderb <= 75) { $d = $gender -$gendera; $e = $gendera-$genderb; $f = $genderb-$gender; if( $d == -1 || $d == 0 || $d == 1 || $e == -1 || $e == 0 || $e == 1 + || $f== -1 || $f == 0 || $f == 1 ) { $txt -> delete('1.0', 'end'); $txt -> insert('end'," Incorrect Entries. Check the values entered Reason: Neigbor cell mismatch"); } else { foreach $key ( @list ) { $a = $gender -$key; $b = $gendera-$key; $c = $genderb-$key; if( $a == -1 || $a == 0 || $a == 1 || $b == -1 || $b == 0 || $b + == 1 || $c== -1 || $c == 0 || $c == 1 ) { next; } else { push( @final, $key); $txt -> delete('1.0', 'end'); } } $size = @final; @gender = ($gender,$gendera,$genderb); $txt -> delete('1.0', 'end'); $txt -> insert('end'," The set of allowed frequencies are \n"); $txt -> insert('end'," \t @final"); $x = $size; @i= (undef); for($i=0; $i<$x; $i++) { for($j=0; $j<3; $j++) { $i[$j] = $gender[$j] - $final[$i]; if($i[$j]<0) { $i[$j] = (-1)*$i[$j];} else { $i[$j]=$i[$j]; } } $total =0; foreach $xyz(@i) { $total = $total + $xyz; } push(@sum, $total); } shift(@sum); shift(@sum); $txt-> insert('end'," \n The distance matrix is given as: \n \t@sum"); $txt-> insert('end'," some text"); } } else { $txt -> delete('1.0', 'end'); $txt -> insert('end'," Please Check the frequencies entered"); } } } sub faults { #Global Variables my $gender = "TCH Drop"; # Main Window my $mw = new MainWindow; #Define KPI my $frm_job = $mw -> Frame(); #Gender my $frm_gender = $mw -> Frame(); my $lbl_gender = $frm_gender -> Label(-text=>"KPI Affected "); my $ent = $frm_gender -> Entry(); my $rdb_m = $frm_gender -> Radiobutton(-text=>"TCH Drop", -value=>"TCH Drop", -variable=>\$gender); my $rdb_f = $frm_gender -> Radiobutton(-text=>"TCH Blocking", -value=>"TCH Blocking",-variable=>\$gender); my $rdb_j = $frm_gender -> Radiobutton(-text=>"TCH assignment", -value=>"TCH Assignment",-variable=>\$gender); my $rdb_k = $frm_gender -> Radiobutton(-text=>"SDCCH Blocking", -value=>"SDCCH Blocking",-variable=>\$gender); my $rdb_t = $frm_gender -> Radiobutton(-text=>"SDCCH Drop", -value=>"SDCCH Drop",-variable=>\$gender); my $rdb_l = $frm_gender -> Radiobutton(-text=>"HOSR", -value=>"HOSR",-variable=>\$gender); my $but = $mw -> Button(-text=>"Check", -command =>\&push_button); #Text Area my $textarea = $mw -> Frame(); my $txt = $textarea -> Text(-width=>130, -height=>30, -font=> "fixed 1 +0 bold"); my $srl_y = $textarea -> Scrollbar(-orient=>'v',-command=>[yview => $t +xt]); my $srl_x = $textarea -> Scrollbar(-orient=>'h',-command=>[xview => $t +xt]); $txt -> configure(-yscrollcommand=>['set', $srl_y], -xscrollcommand=>['set',$srl_x]); #Geometry Management $lbl_gender -> grid(-row=>1,-column=>1); $rdb_m -> grid(-row=>1,-column=>2); $rdb_f -> grid(-row=>1,-column=>3); $rdb_j -> grid(-row=>1,-column=>4); $rdb_k -> grid(-row=>1,-column=>5); $rdb_l -> grid(-row=>1,-column=>6); $rdb_t -> grid(-row=>1,-column=>7); $frm_gender -> grid(-row=>3,-column=>1,-columnspan=>2); $but -> grid(-row=>4,-column=>1,-columnspan=>2); $txt -> grid(-row=>1,-column=>1); $srl_y -> grid(-row=>1,-column=>2,-sticky=>"ns"); $srl_x -> grid(-row=>2,-column=>1,-sticky=>"ew"); $textarea -> grid(-row=>5,-column=>1,-columnspan=>2); MainLoop; ## Functions #This function will be executed when the button is pushed sub push_button { if($gender eq "SDCCH Blocking") {$txt -> delete('1.0', 'end'); $txt -> insert('end',"*some text"); } elsif($gender eq "HOSR") { $txt -> delete('1.0', 'end'); $txt -> insert('end'," *some text"); } elsif($gender eq "SDCCH Drop") { $txt -> delete('1.0', 'end'); $txt -> insert('end',"*some text*"); } elsif($gender eq "TCH Blocking") {$txt -> delete('1.0', 'end'); $txt -> insert('end'," some text"); } elsif($gender eq "TCH Drop") {$txt -> delete('1.0', 'end'); $txt -> insert('end',"some text"); } elsif($gender eq "TCH Assignment") {$txt -> delete('1.0', 'end'); $txt -> insert('end',"some text"); } }} }


Comment on Re^2: Error Not a tk object / Problems with multiple files
Download Code
Re^3: Error Not a tk object / Problems with multiple files
by zentara (Archbishop) on Oct 16, 2012 at 11:59 UTC
    You said you were using Tcl/Tk, but it looks like a plain Perl/Tk script to me. In any event, your code problem almost certainly stems from having multiple new MainWindow and multiple MainLoop declarations. In Perl/Tk, as in the Highlander, there can only be 1 :-)

    The first MainWindow you declare is fine, but all those following ones should be converted to Toplevel windows, which exist under the the single MainLoop of the first MainWindow declared.

    Here is a simple usage of Toplevel

    #!/usr/bin/perl use strict; use warnings; use Tk; my $mw = MainWindow->new; $mw->Label(-text => 'Main Window')->pack; $mw->Button( -text => 'Quit Main', -command => sub{$mw->destroy}, )->pack; my $top = $mw->Toplevel; $top->Label(-text => 'Top level Window')->pack; $top->Button( -text => 'Exit Top level', -command => sub{$top->destroy}, )->pack; $top->transient($mw); MainLoop;

    I'm not really a human, but I play one on earth.
    Old Perl Programmer Haiku ................... flash japh
      Oh yes . it is Perl/Tk.
      Thank you so much for the prompt reply..
        Can you suggest me how to do that ??

        Sure, just substitute new Toplevel for new MainWindow, and remove all extra MainLoop declarations. A new MainWindow and MainLoop go in pairs, and you only need 1 pair.

        There is 1 problem with raising alot of Toplevel windows, and that is sometimes( depending on how your script is written) they can cause an accumulation of memory if repeatedly called. Here is a general purpose example:

        #!/usr/bin/perl use warnings; use strict; use Tk; my $mw = MainWindow->new; $mw->title( "MainWindow" ); my $spawn_button = $mw->Button( -text => "Toplevel", -command => \&do_Toplevel )->pack(); my $change_button = $mw->Button( -text => "Toplevel repacked", -command => \&do_Toplevel_repack )->pack(); ######### make a top level withdrawn ################## # make $tl global so it's memory space is reused my $tl = $mw->Toplevel(); $tl->protocol('WM_DELETE_WINDOW' => sub { print "do nothing here\n"; #prevents destruction of $tl #by WM control }); $tl->geometry('300x300-1-1'); $tl->title( "Toplevel" ); $tl->Button( -text => "Close", -command => sub { $tl->withdraw; $spawn_button->configure(-state=>'normal'); $change_button->configure(-state=>'normal'); })->pack(); $tl->withdraw; MainLoop; sub do_Toplevel { $spawn_button->configure(-state=>'disabled'); $change_button->configure(-state=>'disabled'); $tl->deiconify(); $tl->raise(); } sub do_Toplevel_repack { $spawn_button->configure(-state=>'disabled'); $change_button->configure(-state=>'disabled'); #clean out top level my @w = $tl->packSlaves; foreach (@w) { $_->packForget; } $tl->title( "Toplevel repack" ); $tl->geometry('300x500-1-1'); $tl->Button( -text => "Close1", -command => sub { $tl->withdraw; $spawn_button->configure(-state=>'normal'); $change_button->configure(-state=>'normal'); })->pack(); my $text = $tl->Scrolled('Text')->pack(); for (1..100){ $text->insert('end', "$_\n"); $text->see('end'); } #add whatever widgets you want here # Entries, etc $tl->Button( -text => "Add button to mainwindow", -command => sub { $mw->Button(-text=>'new Button')->pack(-side =>'bottom'); })->pack(); $tl->deiconify(); $tl->raise(); }
        The first thing to try is substitute all your secondary MainWindow/MainLoop declarations with new Toplevel and see how it goes. Watch your memory, and if it seems to gain with repeated use, then use the techniques in the above code to reuse your Toplevels by withdrawing them, and repacking them, for reuse.

        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: note [id://999295]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others romping around the Monastery: (6)
As of 2014-09-21 17:53 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    How do you remember the number of days in each month?











    Results (173 votes), past polls