Beefy Boxes and Bandwidth Generously Provided by pair Networks
Think about Loose Coupling

Updating table in the canvas

by kartiksharma (Initiate)
on Mar 05, 2013 at 07:21 UTC ( #1021766=perlquestion: print w/replies, xml ) Need Help??
kartiksharma has asked for the wisdom of the Perl Monks concerning the following question:

Hello people,

I have just started with perl TK and got struck. I am making a small game for practice in which I have a table on one tab and two text fields on another tab for entering rows and columns of the table.

When I enter rows and columns value in the text field and press the button, the command says that it will update the rows and columns values of the table and should show a new table with a new value. But, the table remains as it is and is not updating with new rows and columns.

Please help me with this as I am new to Perl and not able to solve this issue. I don't know how should I return the values from event subroutine of button

use strict; use warnings; use Tk; use Tk::NoteBook; my $rows; my $columns; #creating main window and font my $font = '{Calibri} 11'; my $mw=new MainWindow(-title => "Tab one",-background=>'Black'); $mw->minsize(qw(800 800)); #creating canvas my $canvas1 = $mw -> Canvas(-width=>800,-height=>550, -borderwidth => 2, -relief=>"raised",-bg=>"red")->pack(); my $canvas2 = $mw -> Canvas(-width=>800,-height=>250, -borderwidth => 2, -relief=>"raised",-bg=>"#8E8F97")->pack(); #creating table in canvas 1 my $table = $canvas1->Table(-rows => $rows,-columns => $columns, -scrollbars => 'se',-takefocus => 0)->pack( -expand => 1, -fill => + 'both' ); #Arranging canvas 2 my $frame1= $canvas2->Frame(-relief=>'groove',-borderwidth=>3, -bg=>'b +lue')->pack(-side=>'top',-fill=>'x'); my $lb1= $frame1->Label(-text=>'Enter number of rows: ',-bg=>'blue',-f +oreground=>'white')->pack(-side=>'left'); my $tf1= $frame1->Entry(-width=>8,-bg=>'white')->pack(-side=>'left',-p +ady=>3); my $frame2= $canvas2->Frame(-relief=>'groove',-borderwidth=>3, -bg=>'b +lue')->pack(-side=>'top',-fill=>'x'); my $lb2= $frame2->Label(-text=>'Enter number of Columns: ',-bg=>'blue' +,-foreground=>'white')->pack(-side=>'left'); my $tf2= $frame2->Entry(-width=>8,-bg=>'white')->pack(-side=>'left',-p +ady=>3); my $frame3= $canvas2->Frame(-relief=>'groove',-borderwidth=>3, -bg=>'b +lue')->pack(-side=>'top',-fill=>'x'); my $btn3= $frame3->Button(-text=>"Enter", -command =>\&push_button)->p +ack(); #Filling the tabel according to rows and columns for(my $row=0;$row<$rows;$row++) { for(my $column=0;$column<$columns;$column++) { my $label=$canvas1->Label(-text=>"$row $column",-height=>2,-wi +dth=>10,-relief=>"raised",-background=>'white'); my $old = $table->put($row,$column,$label); } } sub push_button { $rows= $tf1->get(); $columns= $tf2->get(); } MainLoop;

Replies are listed 'Best First'.
Re: Updating table in the canvas
by zentara (Archbishop) on Mar 05, 2013 at 13:51 UTC
    You are a beginner, so I'm going to show you some of the tricks you need to make your program work as you want. First of all, the code you presented is far from workable, as a first criticism you are not using Notebook tabs and the Canvas properly. You seem to be packing your table widgets into separate canvases, somehow hoping it will function. It won't work your way, as drag'ndrop on the canvases will not work out of the tables the way they are packed.

    I have a little example here, which I worked up for you, with comments trying to explain what is going on. It should pretty much do what you want, but I leave it to you to setup the rectangular grid within the canvas, and managing the drag'n'drop positions. The fake data I setup in the tables can easily be changed to which position in your rectangular canvas grid you wish to place them. There is still alot of detailed work to be done on the Canvas portion .... setting up the canvas rectangular grid depending on how many entries are in your tables, and checking for correctness , etc, etc. Good Luck, the game is a nice concept for teaching.

    #!/usr/bin/perl -w use warnings; use strict; use Tk; use Tk::NoteBook; require Tk::Pane; use Tk::LabEntry; my ($dx,$dy); my $mw = MainWindow->new; $mw->geometry( "600x500"); $mw->title("My New Game"); # ###program parameter hash my %tools = ( 'program1' => { 'PARM1' => 1, 'PARM2' => 'n', 'PARM3' => 'y', 'PARM4' => 'n', 'PARM5' => 'y', 'PARM6' => 'n', 'PARM7' => 'y', 'PARM8' => 'n', 'PARM9' => 'y', 'PARM10' => 'n' }, 'program2' => { 'PARM1' => 1, 'PARM2' => 2, 'PARM3' => 3, 'PARM4' => 4, 'PARM5' => 5, 'PARM6' => 6, 'PARM7' => 7, 'PARM8' => 8, 'PARM9' => 9, 'PARM10' => 10 }); my $tframe = $mw->Frame->pack(-fill=>'both'); my $mframe = $mw->Frame->pack(-expand=>1,-fill=>'both'); $tframe->Label(-text=>'My Game')->pack(); + ## create notebook my $book = $mframe->NoteBook( -dynamicgeometry=>0) ->pack(-expand=>1,-fill=>'both'); #####program1####### my $tab_cnt=1; my %panes; for my $tab (keys %tools){ ##create tab,scroll pane,frames my $tab_tab = $book->add("Game $tab_cnt", -raisecmd=> sub{ # $tab_spane->configure( -scrollregion => [0,0,$book->reqwidth +,$book->reqheight]); $mw->update}, -label => "$tab"); #->pack(-expand=>1,-fill=>'both'); # packing a page add causes a weird error my $tab_spane = $tab_tab->Scrolled('Pane', -background=>'slate grey', -scrollbars => 'osoe', )->pack(-expand=>1, -fill=>'both'); my $tab_frame1=$tab_spane->Frame( -background=>'blue')->pack(-side=>'left',-expand=>1,-fill=>'both +',-padx=>15); my $tab_frame2=$tab_spane->Frame( -background=>'red')->pack(-side=>'bottom',-anchor=>'s',-fill=>'x +'); $tab_cnt++; #create columns my $tab_column1 = $tab_frame1->Frame()->pack(-side=>'left',-exp +and=>1,-fill=>'both'); my $tab_column2 = $tab_frame2->Frame()->pack(-side=>'right',-ex +pand=>1,-fill=>'both'); ##now fill frames my $parm_cnt=1; print "Processing tool: $tab\n"; foreach my $parm (custom_sort(\%{$tools{$tab}})) { print " $parm = $tools{$tab}{$parm}\n"; if ($parm_cnt < 6 ){ my $tab_test=$tab_column1->LabEntry(-label => "$parm=") +; $tab_test->Subwidget('entry')->configure(-textvariable => \$t +ools{$tab}{$parm} ); $tab_test->configure(-labelPack=>[-side=>'left']); $tab_test->pack(-anchor=>'e'); } else { my $tab_test=$tab_column2->LabEntry(-label => "$parm=") +; $tab_test->Subwidget('entry')->configure(-textvariable => \$t +ools{$tab}{$parm} ); $tab_test->configure(-labelPack=>[-side=>'left']); $tab_test->pack(-anchor=>'e'); } $parm_cnt++; } #######run button############# my $run = $tab_tab->Button( -text => "\n Run $tab \n ", -command => [\&run, $tab], -background=>'slate grey')->pack; } # end of page creation loop # now add your canvas which will host the actual game my $game_tab = $book->add("Game Canvas", -raisecmd=> sub{ $mw->update}, -label => " Actual Game Canvas "); # make the actual Canvas my $scan = $game_tab->Scrolled('Canvas', -bg => 'black')->pack(-expan +d=>1, -fill=>'both'); # get the real canvas of the scrolled widget my $realcan = $scan->Subwidget('scrolled'); $realcan->bind('move', '<1>', sub {&mobileStart();}); $realcan->bind('move', '<B1-Motion>', sub {&mobileMove();}); $realcan->bind('move', '<ButtonRelease>', sub {&mobileStop();}); MainLoop; ####################### subs ################################# sub run { print "@_\n"; my $program = shift; # clear out any old game data by tag $scan->delete('move'); # switch to Game tab $book->raise( 'Game Canvas'); # I have the proper dereferencing here, # to show you how it would work my $y = 10; #starting print point foreach my $parm (custom_sort(\%{$tools{$program}})) { print " $parm = $tools{$program}{$parm}\n"; $scan->createText(50,$y, -text => "$parm @ $tools{$program}{$parm}", -fill =>'yellow', -anchor => 'nw', -font => 'big', -tags=> ['move'] ); $y +=50; } # set scroll region for canvas $scan->configure(-scrollregion=>[$scan->bbox("all")]); } sub custom_sort { my $hash = shift; return map { $_->[0] } sort { $a->[1] cmp $b->[1] || $a->[2] <=> $b->[2]} map { [ $_, /(\w+)(\d+)$/ ] } keys %$hash; } sub mobileStart { my $ev = $realcan->XEvent; ($dx, $dy) = (0 - $ev->x, 0 - $ev->y); $realcan->raise('current'); print "START MOVE-> $dx $dy\n"; } sub mobileMove { my $ev = $realcan->XEvent; $realcan->move('current', $ev->x + $dx, $ev->y +$dy); ($dx, $dy) = (0 - $ev->x, 0 - $ev->y); print "MOVING-> $dx $dy\n"; } sub mobileStop{&mobileMove;}

    I'm not really a human, but I play one on earth.
    Old Perl Programmer Haiku ................... flash japh
Re: Updating table in the canvas
by arnaud99 (Beadle) on Mar 05, 2013 at 10:40 UTC


    I have not played with Perl Tk in a while, but one thing strikes me as missing in your push_button sub. Consider updating it with the code that fills the table

    Hopefully this can give you a starting point to populate the table

    . . . my $tf2= $frame2->Entry(-width=>8,-bg=>'white')->pack(-side=>'left',-p +ady=>3); my $frame3= $canvas2->Frame(-relief=>'groove',-borderwidth=>3, -bg=>'b +lue')->pack(-side=>'top',-fill=>'x'); my $btn3= $frame3->Button(-text=>"Enter", -command =>\&push_button)->p +ack(); sub push_button { $rows= $tf1->get(); $columns= $tf2->get(); print "I have been summoned\n"; #move this here, Filling the table according to rows and columns for(my $row=0;$row<$rows;$row++) { print "$row\n"; for(my $column=0;$column<$columns;$column++) { print "\t$column\n"; my $label=$canvas1->Label( -text=>"$row $column", -height=>2,-width=>10, -relief=>"raised", -background=>'white'); $table->put($row,$column,$label); } } } MainLoop;

Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://1021766]
Approved by Lotus1
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others rifling through the Monastery: (5)
As of 2017-11-17 22:17 GMT
Find Nodes?
    Voting Booth?
    In order to be able to say "I know Perl", you must have:

    Results (275 votes). Check out past polls.