view release on metacpan or  search on metacpan

examples/fretcalctk.pl  view on Meta::CPAN

my $rb4 = 0; # Out Units
my $rb5 = 0; # Calc Method

my $mw = MainWindow->new();

# Set app size and center
my $screen_width = $mw->screenwidth;
my $screen_height = $mw->screenheight;
my $pos_x = $screen_width / 2;
my $pos_y = $screen_height / 2;
my $size_x = 500;
#my $size_x = 400;
#my $size_y = 335;
#my $size_y = 365;
my $size_y = 450;
$mw->geometry($size_x.'x'.$size_y.'+'.$pos_x.'+'.$pos_y);

# Disable window resize
$mw->resizable(0,0);

# Set the title
$mw->title("FretCalcTk $VERSION");

# Create the menubar
my $menubar = $mw->Frame(-relief => 'raised',
                         -borderwidth => 2,
)->place(-x => 0, -y => 0, -relwidth => 1.0);

# Create the menubuttons
my $menu_file = $menubar->Menubutton(-text => 'File',
                                     -underline => 0,
                                     -tearoff => 0
)->pack(-side => 'left');

my $menu_calc = $menubar->Menubutton(-text => 'Calc',
                                        -underline => 0,
                                        -tearoff => 0
)->pack(-side => 'left');


my $menu_help = $menubar->Menubutton(-text => 'Help',
                                     -underline => 0,
                                     -tearoff => 0
)->pack(-side => 'left');

# Create menu items

# File menu items
$menu_file->command(-label => 'Print',
                    -command => [\&print, 'Print not implemented'],
                    -underline => 1);

$menu_file->separator();

$menu_file->command(-label => 'Exit',
                    -command => sub { exit },
                    -underline => 1);

# Calc menu items
# Mode Cascade
my $menu_mode_cascade = $menu_calc->menu->Menu();

$menu_mode_cascade->radiobutton(-label => 'Standard',
                           #-command => \&mode,
                           -variable => \$rb1,
                           -value => 'Standard');

$menu_mode_cascade->radiobutton(-label => 'Dulcimer',
                           #-command => \&mode,
                           -variable => \$rb1,
                           -value => 'Dulcimer');

$menu_calc->cascade(-label => 'Mode');

$menu_calc->entryconfigure('Mode', -menu => $menu_mode_cascade);

$menu_calc->separator();

# Precision Cascade
my $menu_prec_cascade = $menu_calc->menu->Menu();

$menu_prec_cascade->radiobutton(-label => '.1',
                           #-command => \&display_radiobutton2,
                           -variable => \$rb2,
                           -value => '.1');

$menu_prec_cascade->radiobutton(-label => '.01',
                           #-command => \&display_radiobutton2,
                           -variable => \$rb2,
                           -value => '.01');

$menu_prec_cascade->radiobutton(-label => '.001',
                           #-command => \&display_radiobutton2,
                           -variable => \$rb2,
                           -value => '.001');

$menu_prec_cascade->radiobutton(-label => '.0001',
                           #-command => \&display_radiobutton2,
                           -variable => \$rb2,
                           -value => '.0001');


$menu_calc->cascade(-label => 'Precision');

$menu_calc->entryconfigure('Precision', -menu => $menu_prec_cascade);


# Help menu items
$menu_help->command(-label => 'Help',
                    -command => [\&help, 'Help not implemented']);

$menu_help->separator();

$menu_help->command(-label => 'About',
                    -command => [\&about_dialog]);


### About Dialog ###
my $dialog_text = "FretCalcTk $VERSION\n\n";
$dialog_text .= "Copyright 2002 Douglas S. Sparling. All rights reserved.\n\n".
                "This program is free software; you can redistribute it ".
                "and/or modify it under the same terms as Perl itself.\n\n";
$dialog_text .= 'doug@dougsparling.com' . "\n";
$dialog_text .= 'http://www.dougsparling.com/software/fretcalc/' . "\n";
my $dialog_title = "FretCalcTk $VERSION";
my $dialog = $mw->Dialog(-text => $dialog_text, -title => $dialog_title,
                         -default_button => 'OK', -buttons => [qw/OK/]);


### Place our widgets ###

### Text Area ###
#my $text = $mw->Text()->place(-x => 0, -y => 28, -height => 400, -width => 180);
my $text = $mw->Scrolled('Text', -scrollbars => 'e')->place(-x => 0, -y => 28, -height => 410, -width => 180);

### Scale length/In units ###
$mw->Label(-text => 'Scale Length')->place(-x => 190, -y => 30);
my $scale_length = $mw->Entry(-validate => 'key',
                          -validatecommand => sub {
                          my($proposed, $chars, $current, $index, $type) = @_;
                          return $proposed =~ /^[\d\.\s]*$/;
                          },                          
)->place(-x => 190, -y => 50, -width => 120);

# In units (scale) radio buttons
$mw->Radiobutton(-text => 'Inches - Decimal',
                 -value => 1,
                 -variable => \$rb3)->place(-x => 190, -y => 80);

$mw->Radiobutton(-text => 'Inches - Fraction',
                 -value => 2,
                 -state => 'disabled',  # Not functional
                 -variable => \$rb3)->place(-x => 190, -y => 100);

$mw->Radiobutton(-text => 'Millimeters',
                 -value => 3,
                 -variable => \$rb3)->place(-x => 190, -y => 120);

$mw->Radiobutton(-text => 'Common',
                 -value => 4,
                 -state => 'disabled',  # Not functional
                 -variable => \$rb3)->place(-x => 190, -y => 140);

### Calc Method ###
$mw->Label(-text => 'Calc Method')->place(-x => 190, -y => 180);