Xcalcfin
smokemachine
created: 2006-01-05 14:57:08
perlmonks
prlmnks
Can any one help me to finish this?! 
#!/usr/bin/perl -w

#use strict;
require 5.002;
use Tk;
use Tk::Text;
use Tk::Menu;
use Tk::Scrollbar;
use Tk::DialogBox;
use Tk::ROText;
use Tk::Pixmap;
use Tk::Bitmap;

our $x=0;
our $y=0;
our $z=0;
our $t=0;
our $res='n';

our $sto='n';
our $rcl='n';
our $pnt='n';

our $sto0=0;
our $sto1=0;
our $sto2=0;
our $sto3=0;
our $sto4=0;
our $sto5=0;
our $sto6=0;
our $sto7=0;
our $sto8=0;
our $sto9=0;
our $stop0=0;
our $stop1=0;
our $stop2=0;
our $stop3=0;
our $stop4=0;
our $stop5=0;
our $stop6=0;
our $stop7=0;
our $stop8=0;
our $stop9=0;

our $xxx='17';

my $mw = MainWindow->new;
$mw->maxsize(qw(400 200));
$mw->minsize(qw(400 200));
$mw->title("Calculadora Financeira");
$mw->configure(-bg=>"black");
$label = $mw->Text(
			-background => 'light goldenrod',
			-borderwidth => '0',
			-width => '50',
			-height => '4',
			-state => 'disable'
			)->pack;
#my $fundo = $mw->Pixmap(
	#	-data => '/* XPM*/',
	#	-background => 'yellow',
	#	-file => 'calc.xpm',
	#	-width => '350',
	#	-height => '50'
	#	)->pack(-side => 'top');
########################################################
our $dis = $mw->Entry(
			-width => '10',
			)->pack;
$dis->place(-x=>'105',-y=>'20');
##############################################################################################################
my $enter = $mw->Button(
			-text => 'Enter',
			-command => sub{entersub()},
			-width =>'1',
			-height =>'1',
			-foreground => 'white',
			-background => 'black'
			)->pack;
$enter->place(-x=>'197',-y=>'155');
my $soma = $mw->Button(
			-text => '+',
			-command => sub{somasub()},
			-width =>'1',
			-height =>'1',
			-foreground => 'white',
			-background => 'black'
			)->pack;
$soma->place(-x=>'353',-y=>'170');
my $subitracao = $mw->Button(
			-text => '-',
			-command => sub{subtrasub()},
			-width =>'1',
			-height =>'1',
			-foreground => 'white',
			-background => 'black'
			)->pack;
$subitracao->place(-x=>'353',-y=>'140');
my $multiplicacao = $mw->Button(
			-text => 'x',
			-command => sub{multisub()},
			-width =>'1',
			-height =>'1',
			-foreground => 'white',
			-background => 'black'
			)->pack;
$multiplicacao->place(-x=>'353',-y=>'110');
my $divisao = $mw->Button(
			-text => '/',
			-command => sub{divisub()},
			-width =>'1',
			-height =>'1',
			-foreground => 'white',
			-background => 'black'
			)->pack;
$divisao->place(-x=>'353',-y=>'80');
#####################################################################################################################
my $CLx = $mw->Button(
			-text => 'CLx',
			-command => sub{CLxsub()},
			-width =>'1',
			-height =>'1',
			-foreground => 'white',
			-background => 'black'
			)->pack;
$CLx->place(-x=>133 + $xxx,-y=>'140');
my $xsy = $mw->Button(
			-text => 'xsy',
			-command => sub{xsysub()},
			-width =>'1',
			-height =>'1',
			-foreground => 'white',
			-background => 'black'
			)->pack;
$xsy->place(-x=>100 + $xxx,-y=>'140');
my $Rs = $mw->Button(
			-text => 'Rs',
			-command => sub{Rssub()},
			-width =>'1',
			-height =>'1',
			-foreground => 'white',
			-background => 'black'
			)->pack;
$Rs->place(-x=>66 + $xxx,-y=>'140');
my $SST = $mw->Button(
			-text => 'SST',
#			-command => sub{Rssub()},
			-width =>'1',
			-height =>'1',
			-foreground => 'white',
			-background => 'black'
			)->pack;
$SST->place(-x=>33 + $xxx,-y=>'140');
my $RbS = $mw->Button(
			-text => 'R/S',
#			-command => sub{Rssub()},
			-width =>'1',
			-height =>'1',
			-foreground => 'white',
			-background => 'black'
			)->pack;
$RbS->place(-x=> $xxx,-y=>'140');

my $RCL = $mw->Button(
			-text => 'RCL',
			-command => sub{$rcl='s'},
			-width =>'1',
			-height =>'1',
			-foreground => 'white',
			-background => 'black'
			)->pack;
$RCL->place(-x=>133 + $xxx,-y=>'170');
my $STO = $mw->Button(
			-text => 'STO',
			-command => sub{$sto='s'},
			-width =>'1',
			-height =>'1',
			-foreground => 'white',
			-background => 'black'
			)->pack;
$STO->place(-x=>100 + $xxx,-y=>'170');
my $g = $mw->Button(
			-text => 'g',
#			-command => sub{$sto='s'},
			-width =>'1',
			-height =>'1',
			-foreground => 'white',
			-background => 'dark blue'
			)->pack;
$g->place(-x=>66 + $xxx,-y=>'170');
my $f = $mw->Button(
			-text => 'f',
#			-command => sub{$sto='s'},
			-width =>'1',
			-height =>'1',
			-foreground => 'white',
			-background => 'dark goldenrod'
			)->pack;
$f->place(-x=>33 + $xxx,-y=>'170');
my $OFF = $mw->Button(
			-text => 'OFF',
			-command => sub{exit},
			-width =>'1',
			-height =>'1',
			-foreground => 'white',
			-background => 'black'
			)->pack;
$OFF->place(-x=>$xxx,-y=>'170');





#################################################################################################################

my $zero=$mw->Button(
			-text => '0',
			-command => sub
					{
					if ($sto eq 's')
					{
					($pnt eq 's')?
					$stop0=$dis->get:
					$sto0=$dis->get;
					$sto='n';
					$res='s';
					$pnt='n';
					return;
					} elsif ($rcl eq 's')
					{
					$dis->delete('0.0','end');
					($pnt eq 's')?
					$dis->insert('end',$stop0):
					$dis->insert('end',$sto0);
					$rcl='n';
					$pnt='n';
					return;
					}
					if ($res eq 's')
					{
					$dis->delete('0.0','end');
					$res='n';
					}
					$dis->insert('end','0')},
			-width =>'1',
			-height =>'1',
			-foreground => 'white',
			-background => 'black'
			)->pack;
$zero->place(-x=>'245',-y=>'170');
my $ponto=$mw->Button(
			-text => '.',
			-command => sub
					{
					if($sto eq 's')
					{
					$pnt='s';
					return;
					} 
					if($rcl eq 's')
					{
					$pnt='s';
					return;
					} 
					if ($res eq 's')
					{
					$dis->delete('0.0','end');
					$res='n';
					}
					$dis->insert('end','.')
					},
			-width =>'1',
			-height =>'1',
			-foreground => 'white',
			-background => 'black'
			)->pack;
$ponto->place(-x=>'275',-y=>'170');
my $somatorio=$mw->Button(
			-text => 'E+',
#			-command => sub{$dis->insert('end','E')},
			-width =>'1',
			-height =>'1',
			-foreground => 'white',
			-background => 'black'
			)->pack;
$somatorio->place(-x=>'305',-y=>'170');
my $um=$mw->Button(
			-text => '1',
			-command => sub
					{
					if ($sto eq 's')
					{
					($pnt eq 's')?
					$stop1=$dis->get:
					$sto1=$dis->get;
					$sto='n';
					$res='s';
					$pnt='n';
					return;
					} elsif ($rcl eq 's')
					{
					$dis->delete('0.0','end');
					($pnt eq 's')?
					$dis->insert('end',$stop1):
					$dis->insert('end',$sto1);
					$rcl='n';
					$pnt='n';
					return;
					}

					if ($res eq 's')
					{
					$dis->delete('0.0','end');
					$res='n';
					}
					$dis->insert('end','1')
					},
			-width =>'1',
			-height =>'1',
			-foreground => 'white',
			-background => 'black'
			)->pack;
$um->place(-x=>'245',-y=>'140');
my $dois=$mw->Button(
			-text => '2',
			-command => sub
					{
					if ($sto eq 's')
					{
					($pnt eq 's')?
					$stop2=$dis->get:
					$sto2=$dis->get;
					$sto='n';
					$res='s';
					$pnt='n';
					return;
					} elsif ($rcl eq 's')
					{
					$dis->delete('0.0','end');
					($pnt eq 's')?
					$dis->insert('end',$stop2):
					$dis->insert('end',$sto2);
					$rcl='n';
					$pnt='n';
					return;
					}

					if ($res eq 's')
					{
					$dis->delete('0.0','end');
					$res='n';
					}
					$dis->insert('end','2')
					},
			-width =>'1',
			-height =>'1',
			-foreground => 'white',
			-background => 'black'
			)->pack;
$dois->place(-x=>'275',-y=>'140');
my $tres=$mw->Button(
			-text => '3',
			-command => sub
					{
					if ($sto eq 's')
					{
					($pnt eq 's')?
					$stop3=$dis->get:
					$sto3=$dis->get;
					$sto='n';
					$res='s';
					$pnt='n';
					return;
					} elsif ($rcl eq 's')
					{
					$dis->delete('0.0','end');
					($pnt eq 's')?
					$dis->insert('end',$stop3):
					$dis->insert('end',$sto3);
					$rcl='n';
					$pnt='n';
					return;
					}

					if ($res eq 's')
					{
					$dis->delete('0.0','end');
					$res='n';
					}
					$dis->insert('end','3')
					},
			-width =>'1',
			-height =>'1',
			-foreground => 'white',
			-background => 'black'
			)->pack;
$tres->place(-x=>'305',-y=>'140');

my $quatro=$mw->Button(
			-text => '4',
			-command => sub
					{
					if ($sto eq 's')
					{
					($pnt eq 's')?
					$stop4=$dis->get:
					$sto4=$dis->get;
					$sto='n';
					$res='s';
					$pnt='n';
					return;
					} elsif ($rcl eq 's')
					{
					$dis->delete('0.0','end');
					($pnt eq 's')?
					$dis->insert('end',$stop4):
					$dis->insert('end',$sto4);
					$rcl='n';
					$pnt='n';
					return;
					}

					if ($res eq 's')
					{
					$dis->delete('0.0','end');
					$res='n';
					}
					$dis->insert('end','4')
					},
			-width =>'1',
			-height =>'1',
			-foreground => 'white',
			-background => 'black'
			)->pack;
$quatro->place(-x=>'245',-y=>'110');
my $cinco=$mw->Button(
			-text => '5',
			-command => sub
					{
					if ($sto eq 's')
					{
					($pnt eq 's')?
					$stop5=$dis->get:
					$sto5=$dis->get;
					$sto='n';
					$res='s';
					$pnt='n';
					return;
					} elsif ($rcl eq 's')
					{
					$dis->delete('0.0','end');
					($pnt eq 's')?
					$dis->insert('end',$stop5):
					$dis->insert('end',$sto5);
					$rcl='n';
					$pnt='n';
					return;
					}

					if ($res eq 's')
					{
					$dis->delete('0.0','end');
					$res='n';
					} 
					$dis->insert('end','5')
					},
			-width =>'1',
			-height =>'1',
			-foreground => 'white',
			-background => 'black'
			)->pack;
$cinco->place(-x=>'275',-y=>'110');
my $seis=$mw->Button(
			-text => '6',
			-command => sub
					{
					if ($sto eq 's')
					{
					($pnt eq 's')?
					$stop6=$dis->get:
					$sto6=$dis->get;
					$sto='n';
					$res='s';
					$pnt='n';
					return;
					}  elsif ($rcl eq 's')
					{
					$dis->delete('0.0','end');
					($pnt eq 's')?
					$dis->insert('end',$stop6):
					$dis->insert('end',$sto6);
					$rcl='n';
					$pnt='n';
					return;
					}

					if ($res eq 's')
					{
					$dis->delete('0.0','end');
					$res='n';
					}
					$dis->insert('end','6')
					},
			-width =>'1',
			-height =>'1',
			-foreground => 'white',
			-background => 'black'
			)->pack;
$seis->place(-x=>'305',-y=>'110');

my $sete=$mw->Button(
			-text => '7',
			-command => sub
					{
					if ($sto eq 's')
					{
					($pnt eq 's')?
					$stop7=$dis->get:
					$sto7=$dis->get;
					$sto='n';
					$res='s';
					$pnt='n';
					return;
					} elsif ($rcl eq 's')
					{
					$dis->delete('0.0','end');
					($pnt eq 's')?
					$dis->insert('end',$stop7):
					$dis->insert('end',$sto7);
					$rcl='n';
					$pnt='n';
					return;
					}

					if ($res eq 's')
					{
					$dis->delete('0.0','end');
					$res='n';
					}
					$dis->insert('end','7')
					},
			-width =>'1',
			-height =>'1',
			-foreground => 'white',
			-background => 'black'
			)->pack;
$sete->place(-x=>'245',-y=>'80');
my $oito=$mw->Button(
			-text => '8',
			-command => sub
					{
					if ($sto eq 's')
					{
					($pnt eq 's')?
					$stop8=$dis->get:
					$sto8=$dis->get;
					$sto='n';
					$res='s';
					$pnt='n';
					return;
					} elsif ($rcl eq 's')
					{
					$dis->delete('0.0','end');
					($pnt eq 's')?
					$dis->insert('end',$stop8):
					$dis->insert('end',$sto8);
					$rcl='n';
					$pnt='n';
					return;
					}

					if ($res eq 's')
					{
					$dis->delete('0.0','end');
					$res='n';
					}
					$dis->insert('end','8')
					},
			-width =>'1',
			-height =>'1',
			-foreground => 'white',
			-background => 'black'
			)->pack;
$oito->place(-x=>'275',-y=>'80');
my $nove=$mw->Button(
			-text => '9',
			-command => sub
					{
					if ($sto eq 's')
					{
					($pnt eq 's')?
					$stop9=$dis->get:
					$sto9=$dis->get;
					$sto='n';
					$res='s';
					$pnt='n';
					return;
					}  elsif ($rcl eq 's')
					{
					$dis->delete('0.0','end');
					($pnt eq 's')?
					$dis->insert('end',$stop9):
					$dis->insert('end',$sto9);
					$rcl='n';
					$pnt='n';
					return;
					}

					if ($res eq 's')
					{
					$dis->delete('0.0','end');
					$res='n';
					}
					$dis->insert('end','9')
					},
			-width =>'1',
			-height =>'1',
			-foreground => 'white',
			-background => 'black'
			)->pack;
$nove->place(-x=>'305',-y=>'80');


MainLoop;


###################################################################################################################

sub entersub
{
$t=$z;
$z=$x;
$x=$dis->get;
$y=$x;
#$dis->delete('0.0','end');
$res='s';
}
sub somasub
{
if ($res eq 's')
{
$x+=$y;
} else
{
$x+=$dis->get;
}
$dis->delete('0.0','end');
$dis->insert('end',$x);
$y=$z;
$z=$t;
$res='s';
}
sub subtrasub
{
if ($res eq 's')
{
$x-=$y;
} else
{
$x-=$dis->get;
}
$dis->delete('0.0','end');
$dis->insert('end',$x);
$y=$z;
$z=$t;
$res='s';
}
sub multisub
{
if ($res eq 's')
{
$x*=$y;
} else
{
$x*=$dis->get;
}
$dis->delete('0.0','end');
$dis->insert('end',$x);
$y=$z;
$z=$t;
$res='s';
}
sub divisub
{
if ($res eq 's')
{
$x/=$y;
} else
{
$x/=$dis->get;
}
$dis->delete('0.0','end');
$dis->insert('end',$x);
$y=$z;
$z=$t;
$res='s';
}
###################################################################################################################
sub CLxsub
{
$x=0;
$dis->delete('0.0','end');
}
sub xsysub
{
$x = $y;
$y = $dis->get;
$dis->delete('0.0','end');
$dis->insert('end',$x);
$res='s';
}
sub Rssub
{
my $aj=$dis->get;
$dis->delete('0.0','end');
$dis->insert('end',$y);
$x=$y;
$y=$z;
$z=$t;
$t=$aj;
$res='s';
}
Re: Xcalcfin
zentara
created: 2006-01-05 17:09:45
perlmonks
prlmnks
Can any one help me to finish this?!

What is it supposed to do, compared to what it is currently doing? If it isn't a finished working script, you probably should have posted this as a question instead of a Code Contribution.

The first thing to do is enable strict, all you need to do is put a "my" before $label on line 52.

Otherwise it runs for me, but what sort of calculations is it supposed to perform?

I'm not really a human, but I play one on earth. flash japh
Re: Xcalcfin
jdporter
created: 2006-01-05 17:12:11
perlmonks
prlmnks

Some suggestions:

    Indent your code properly. See doc:perlstyle.
  • Give your variables meaningful names. Extremely short variable names are "false economy".
  • Perl understands real boolean values; use them. This lets you say if ( $sto ) rather than if ( $sto = 's' ).
  • Learn to use arrays and hashes.
  • Learn to use loops and subroutines for code re-use, rather than copy-and-paste.
  • Don't set the width of the buttons. Or if you must, set them to something that allows the strings to be visible. A width of 1 makes a lot of your buttons unreadable. (Also, since width and height are numeric parameters, don't quote them.)

As an example of looping for code re-use, I rewrote part of your code into the following: 
my %button_label =
(
	Sum    => '+',
	Subtra => '-',
	Multi  => 'x',
	Divi   => '/',
	Rs     => 'R/S',
);

my %placement =
(
	Enter  => [ 197,  155 ],
	Sum    => [ 353,  170 ],
	Subtra => [ 353,  140 ],
	Multi  => [ 353,  110 ],
	Divi   => [ 353,   80 ],
	CLx    => [ 150,  140 ],
	XsY    => [ 117,  140 ],
	Rs     => [  83,  140 ],
	SST    => [  50,  140 ],
	RbS    => [  17,  140 ],
	RCL    => [ 150,  170 ],
	STO    => [ 117,  170 ],
	OFF    => [  17,  170 ],
);


for (qw(
	Enter Sum Subtra Multi Divi
	CLx XsY Rs SST RbS RCL STO OFF
))
{
	my $w = $mw->Button( -text => $button_label{$_} || $_, )->pack;
	$w->place( -x => $placement{$_}[0], -y => $placement{$_}[1] );
}
We're building the house of the future together.
Re: Xcalcfin
liverpole
created: 2006-01-06 11:07:02
perlmonks
prlmnks
[smokemachine], your GUI looks very sharp.

The only suggestion I would make with regards its presentation is to perhaps make the result window (the Entry widget) larger: 

    our $dis = $mw->Entry( -width => '30' )->pack;    # Changed width from 10 to 30
As for the actual code, I very much agree with [jdporter]'s points.  Here are some further suggestions I would add:
  1. Put back use strict.  Rather than comment it out to get rid of the one error:   Global symbol "$label" requires explicit package name at uu line 52., it's better to just fix the error by changing label = $mw->Text( ... ) to my label = $mw->Text( ... ), and then you get to keep the benefits of "use strict" afterwards.
  2. Add use warnings;.  Just because there aren't any warnings now, doesn't there won't be any later.  Do yourself a favor by protecting against them now.
  3. The only place where characters wrap 80-columns is the line separators:   #####################################.  Make them less than 80 characters for people who like the default terminal width.
  4. Use perltidy to clean up the indentation.  Then, try hard to imitate its style later, when you write more code!

    Wouldn't this: 

        sub CLxsub
    {
    $x=0;
    $dis->delete('0.0','end');
    }
    sub xsysub
    {
    $x = $y;
    $y = $dis->get;
    $dis->delete('0.0','end');
    $dis->insert('end',$x);
    $res='s';
    }
    sub Rssub
    {
    my $aj=$dis->get;
    $dis->delete('0.0','end');
    $dis->insert('end',$y);
    $x=$y;
    $y=$z;
    $z=$t;
    $t=$aj;
    $res='s';
    }
    be so much easier to read like this ...? 
       sub CLxsub {
       $x = 0;
       $dis->delete( '0.0', 'end' );
   }
                                                                                
   sub xsysub {
       $x = $y;
       $y = $dis->get;
       $dis->delete( '0.0', 'end' );
       $dis->insert( 'end', $x );
       $res = 's';
   }
                                                                                
   sub Rssub {
       my $aj = $dis->get;
       $dis->delete( '0.0', 'end' );
       $dis->insert( 'end', $y );
       $x   = $y;
       $y   = $z;
       $z   = $t;
       $t   = $aj;
       $res = 's';
   }
  5. Move all of the huge anonymous subroutines out of the button definitions!  They will be easier to read, and to maintain, as standalone, named subroutines.  You should only pass the subroutine names (and any arguments) to the button definitions.
  6. Be productively "lazy", and create subroutines for common functionality.  For example, there's no need to do this over and over again: 
           my $STO = $mw->Button(
                          -text => 'STO',
                          -command => sub{$sto='s'},
                          -width =>'1',
                          -height =>'1',
                          -foreground => 'white',
                          -background => 'black'
                          )->pack;
               $STO->place(-x=>100 + $xxx,-y=>'170');
    Instead, write a "wrapper" for a button, such as: 
    sub button($$$$$;$$$$) {
            my ($parent, $text, $pcmd, $x, $y, $fg, $bg, $width, $height) = @_;
                                                                                
            # Defaults
            $width  ||= 1;
            $height ||= 1;
            $fg     ||= 'white';
            $bg     ||= 'black';
                                                                                
            # Color abbreviations
            my $p_abb = {
                'db' => 'darkblue',
                'dg' => 'darkgoldenrod',
            };
            defined($p_abb->{$fg}) and $fg = $p_abb->{$fg};
            defined($p_abb->{$bg}) and $bg = $p_abb->{$bg};
                                                                                
            # Create the button widget (note command need not be given)
            my $b = $parent->Button(-text => $text);
            $pcmd and $b->configure(-command => $pcmd);
            $b->configure(-width => $width, -height => $height);
            $b->configure(-foreground => $fg, -background => $bg);
                                                                                
            # Place the button (no need to "pack" it first!), and return it
            $b->place(-x => $x, -y => $y);
            return $b;
          }
    One advantage of this is that you can default those parameters which are (almost) always the same, such as the height, width and colors.  Another is that, since you're now doing the place within the subroutine (and you don't need the "pack" first, by the way), you don't need to assign the button outside of the subroutine in most cases.  Finally, the button definition becomes much cleaner: 
              button($mw, 'Enter', [\&entersub],    197,      155);
          button($mw, '+',     [\&somasub],     353,      170);
          button($mw, '-',     [\&subtrasub],   353,      140);
          button($mw, 'x',     [\&multisub],    353,      110);
          button($mw, '/',     [\&divisub],     353,      80);
          button($mw, 'CLx',   [\&CLxsub],      133,      140);
          button($mw, 'xsy',   [\&xsysub],      100,      140);
          button($mw, 'Rs',    [\&Rssub],       66,       140);
          button($mw, 'SST',   [\&Rssub],       33,       140);
          button($mw, 'R/S',   [\&Rssub],       $xxx,     140);
          button($mw, 'RCL',   sub{$rcl = 's'}, $xxx+133, 140);
          button($mw, 'STO',   sub{$sto = 's'}, $xxx+100, 170);
          button($mw, 'g',     0,               $xxx+66,  170,  0, 'db');
          button($mw, 'f',     0,               $xxx+33,  170,  0, 'dg');
          button($mw, 'OFF',   sub{exit},       $xxx,     170);
That's all I can think of at the moment.  I hope it's helpful.
@ARGV=split//,"/:L"; map{print substr crypt($_,ord pop),2,3}qw"PerlyouC READPIPE provides"

perlmonks.org content © perlmonks.org and jdporter, liverpole, smokemachine, zentara

prlmnks.org © 2006 edmund von der burg (eccles & toad)

v 0.03