http://www.perlmonks.org?node_id=586416

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

I tried my hand at learning Tk today. I wanted to make a calculator, and for all intents and purposes I did. Sort of.
I can't tell if it does what it is supposed to because I can't get the information to show up on the "screen." Supposedly there is a way to "refresh" it, but I can't figure it out.

use Tk; use strict; use warnings; my $number=0; my $total=0; my $plus=0; my $minus=0; my $times=0; my $divide=0; my $main = MainWindow -> new; $main -> minsize ("150", "200"); $main -> title ("Calculator!"); $main -> configure ( -background => '#FAEBD7'); my $menu_bar = $main -> Frame( -relief => 'ridge', -borderwidth => '3', -background => 'black', )->pack( -side => 'top', -fill => 'x'); my $file_button = $menu_bar -> Menubutton( -text => 'File', -activebackground => 'grey', -background => 'black', -foreground => 'white', )->pack( -side => 'left' ); $file_button -> command( -label => 'No Use', -activebackground => 'grey'); $file_button -> separator(); $file_button -> command( -label => 'Exit', -activebackground => 'grey', -command => sub{ $main -> destroy}); $file_button -> separator(); my $help_button = $menu_bar -> Menubutton( -text => 'Help!', -activebackground => 'grey', -background => 'black', -foreground => 'white', )->pack( -side => 'right'); $help_button -> command( -label => 'About', -activebackground => 'grey', -command => \&about_txt); $help_button -> command( -label => 'Help', -activebackground => 'grey', -command => \&help_txt); $help_button -> separator(); my $top = $main -> Frame( -background => '#FAEBD7', ) -> pack ( -side => 'top', -fill => 'x'); my $screen = $top -> Label( -text => "$number", -background => 'white', -width => 30, -borderwidth => 2, -relief => 'sunken', ) -> pack(-pady => 5); my $left_num = $top -> Frame( -background => '#FAEBD7', -width => 50, -height => 200, ) -> pack (-side => 'left', -padx => 5, -pady => 2); my $center_num = $top -> Frame( -background => '#FAEBD7', -width => 50, -height => 200, ) -> pack (-side => 'left', -padx => 5, -pady => 2); my $right_num = $top -> Frame( -background => '#FAEBD7', -width => 50, -height => 200, ) -> pack (-side => 'left', -padx => 5, -pady => 2); my $operators_1 = $top -> Frame( -background => '#FAEBD7', -width => 50, -height => 200, ) -> pack (-side => 'left', -padx => 5, -pady => 2); my $operators_2 = $top -> Frame( -background => '#FAEBD7', -width => 50, -height => 200, ) -> pack (-side => 'left', -padx => 5, -pady => 2); my $operators_3 = $top -> Frame( -background => '#FAEBD7', -width => 50, -height => 200, ) -> pack (-side => 'left', -padx => 5, -pady => 5); my $one = $left_num -> Button( -text => '1', -background => 'grey', -width => 5, -height => 2, -command => \&one, ) -> pack(); my $two = $center_num -> Button( -text => '2', -background => 'grey', -width => 5, -height => 2, -command => \&two, ) -> pack(); my $three = $right_num -> Button( -text => '3', -background => 'grey', -width => 5, -height => 2, -command => \&three, ) -> pack(); my $four = $left_num -> Button( -text => '4', -background => 'grey', -width => 5, -height => 2, -command => \&four, ) -> pack(); my $five = $center_num -> Button( -text => '5', -background => 'grey', -width => 5, -height => 2, -command => \&five, ) -> pack(); my $six = $right_num -> Button( -text => '6', -background => 'grey', -width => 5, -height => 2, -command => \&six, ) -> pack(); my $seven = $left_num -> Button( -text => '7', -background => 'grey', -width => 5, -height => 2, -command => \&seven, ) -> pack(); my $eight = $center_num -> Button( -text => '8', -background => 'grey', -width => 5, -height => 2, -command => \&eight, ) -> pack(); my $nine = $right_num -> Button( -text => '9', -background => 'grey', -width => 5, -height => 2, -command => \&nine, ) -> pack(); my $zero = $left_num -> Button( -text => '0', -background => 'grey', -width => 5, -height => 2, -command => \&zero, ) -> pack(); my $Plus = $operators_1 -> Button( -text => '+', -background => 'grey', -width => 5, -height => 2, -command => \&plus, ) -> pack(); my $Minus = $operators_1 -> Button( -text => '-', -background => 'grey', -width => 5, -height => 2, -command => \&minus, ) -> pack(); my $Times = $operators_2 -> Button( -text => '*', -background => 'grey', -width => 5, -height => 2, -command => \&times, ) -> pack(); my $Divide = $operators_2 -> Button( -text => '/', -background => 'grey', -width => 5, -height => 2, -command => \&divide, ) -> pack(); my $dec = $center_num -> Button( -text => '.', -background => 'grey', -width => 5, -height => 2, -command => \&dec, ) -> pack(); my $equals = $right_num -> Button( -text => '=', -background => 'grey', -width => 5, -height => 2, -command => \&equals, ) -> pack(); MainLoop; sub plus{ $plus=1; $minus=0; $times=0; $divide=0; 1; } sub minus{ $plus=0; $minus=1; $times=0; $divide=0; 1; } sub times{ $plus=0; $minus=0; $times=1; $divide=0; 1; } sub divide{ $plus=0; $minus=0; $times=0; $divide=1; 1; } sub dec{ if($number!~m/\./g){ $number .= '.' if $number!=0; $number = '0.' if $number==0; } } sub one{ $number .= "1" if $number!=0; $number=1 if $number==0; if( $plus==0 && $minus==0 && $times==0 && $divide==0){ $total=1; } 1; } sub two{ $number .= "2" if $number!=0; $number=2 if $number==0; if( $plus==0 && $minus==0 && $times==0 && $divide==0){ $total=2; } 1; } sub three{ $number .= "3" if $number!=0; $number=3 if $number==0; if( $plus==0 && $minus==0 && $times==0 && $divide==0){ $total=3; } 1; } sub four{ $number .= "4" if $number!=0; $number=4 if $number==0; if( $plus==0 && $minus==0 && $times==0 && $divide==0){ $total=4; } 1; } sub five{ $number .= "5" if $number!=0; $number=5 if $number==0; if( $plus==0 && $minus==0 && $times==0 && $divide==0){ $total=5; } 1; } sub six{ $number .= "6" if $number!=0; $number=6 if $number==0; if( $plus==0 && $minus==0 && $times==0 && $divide==0){ $total=6; } 1; } sub seven{ $number .= "7" if $number!=0; $number=7 if $number==0; if( $plus==0 && $minus==0 && $times==0 && $divide==0){ $total=7; } 1; } sub eight{ $number .= "8" if $number!=0; $number=8 if $number==0; if( $plus==0 && $minus==0 && $times==0 && $divide==0){ $total=8; } 1; } sub nine{ $number .= "9" if $number!=0; $number=9 if $number==0; if( $plus==0 && $minus==0 && $times==0 && $divide==0){ $total=9; } 1; } sub zero{ $number .= "0" if $number!=0; $number=0 if $number==0; if( $plus==0 && $minus==0 && $times==0 && $divide==0){ $total=0; } 1; } sub equals{ $number = $total + $number if $plus==1; $number = $total - $number if $minus==1; $number = $total * $number if $times==1; $number = $total / $number if $divide==1; 1; }

Can anyone figure out what's wrong with it?
Thanks in advanced!

Replies are listed 'Best First'.
Re: Tk Screen Refresh
by rcseege (Pilgrim) on Nov 28, 2006 at 05:36 UTC
    The refresh issue can be fixed by slightly modifying the following:
    my $screen = $top -> Label( -textvariable => "$number", -background => 'white', -width => 30, -borderwidth => 2, -relief => 'sunken', ) -> pack(-pady => 5);
    To:
    my $screen = $top -> Label( -text => \$number, -background => 'white', -width => 30, -borderwidth => 2, -relief => 'sunken', ) -> pack(-pady => 5);

    There are other issues with the logic you're using for the numbers. Still, it's a pretty good first attempt.

    Rob
      Thanks, that does clear that up!
      Now that I can see what is going on, I can work out the logic issues.
Re: Tk Screen Refresh
by stonecolddevin (Parson) on Nov 28, 2006 at 06:01 UTC

    Andrew: put your code on this node, and wrap <readmore>$code</readmore> tags around it. that way, if you take it off your pad, it'll still be in the node for others who may have the same issues as you.

    meh.
      What do those tags do?

        They change long bouts of code into a link that says "Read more..." so that when you're viewing the node it doesn't take up 8 million pages of user screen. You click on the readmore link and it takes you to the node with replies and then shows the full code listing.

        meh.
Re: Tk Screen Refresh
by rinceWind (Monsignor) on Nov 28, 2006 at 09:32 UTC

    Here's one I prepared earlier :).

    I originally posted this RPN calculator to batkins' Tk wiki before it got spamblatted. This formed a tutorial in using the grid geometry manager, which unfortunately seems to have been lost. darned spammers :(.

    Reverse Polish Notation syntax is easier for computers to deal with, and is easier to code. The Tk display and buttons would be the same for an algebraic calculator - converting this calculator to algebraic is left as an exercise for the reader.

    #!/usr/local/bin/perl use strict; use warnings; use Tk; my $main = MainWindow->new; my $disp = $main->Label(-text => 0) ->grid('-','-','-',-sticky => 'e'); my %button; for (0..9,qw!. + - * / En C!) { $button{$_} = $main->Button( -text => $_, -command => [\&click, $_] ); } $button{C}->grid($button{'/'},$button{'*'},$button{'-'},-sticky=>'nsew +'); $button{7}->grid($button{8},$button{9},$button{'+'},-sticky=>'nsew'); $button{4}->grid($button{5},$button{6},'^',-sticky=>'nsew'); $button{1}->grid($button{2},$button{3},$button{En},-sticky=>'nsew'); $button{0}->grid('-',$button{'.'},'^',-sticky=>'nsew'); $main->gridColumnconfigure($_, -weight => 1) for (0..3); $main->gridRowconfigure($_, -weight => 1) for (0..5); MainLoop; # Main scoped variables used to keep track of calculator status my @stack; my $current; # holds partial number being entered as string sub click { local $_ = shift; # Handle number entry - append to $current if (/\d|\./) { defined($current) ? ($current .= $_) : ($current = $_); # Clear key - first click, clear $current # second click, clear @stack # third click, calculator off } elsif (/C/) { defined($current) ? undef($current) : @stack ? (@stack=()) : $main->destroy; # Any other key, move $current to stack and process } else { { no warnings; # to handle the case when the user has + # pushed '.' more than once push @stack, $current+0 if defined($current) || !@stac +k; } undef $current; /\+/ and (@stack-1) ? push @stack,(pop(@stack) + pop(@stack)) : push @stack, 2*(pop @stack); /-/ and (@stack-1) ? push @stack,-(pop(@stack) - pop (@stack)) : push @stack, -(pop @stack); /\*/ and (@stack-1) ? push @stack,(pop(@stack) * pop (@stack)) : push @stack, (pop @stack)**2; /\// and (@stack-1) ? push @stack,1/(pop(@stack) / pop (@stack +)) : push @stack, 1/(pop @stack); } $disp->configure( -text => defined($current) ? $current : @stack ? $stack[-1] : 0); }

    --

    Oh Lord, won’t you burn me a Knoppix CD ?
    My friends all rate Windows, I must disagree.
    Your powers of persuasion will set them all free,
    So oh Lord, won’t you burn me a Knoppix CD ?
    (Missquoting Janis Joplin)