#!/perl/bin/perl -w # always with warnings on..
use Tk 800.000;
use strict;
use vars qw/$edaType/;
use FileHandle;
my $edaType = "Visula";
use Cwd;
cadFileSelect();
sub cadFileSelect
{
my $edaType = shift;
my $cadFile = shift;
my $TOP = MainWindow->new;
$TOP->title("Select a file");
$TOP->geometry("+50+100");
$TOP->configure(-background => lc("aquamarine2"));
my $tFrame = $TOP->Frame;
my $bFrame = $TOP->Frame;
$tFrame->configure(-background => lc("PaleTurquoise"));
$bFrame->configure(-background => lc("PaleTurquoise"));
my $lab = $tFrame->Label(-text => "Select a file to open: ",
-background => "PaleTurquoise",
-anchor => 'e');
my $ent = $tFrame->Entry(-width => 50,
-textvariable => \$$cadFile,
-background => "PaleTurquoise",);
my $but = $tFrame->Button(-text => "Browse ...",
-background => "PaleTurquoise",
-activebackground => "PaleTurquoise",
-command => sub {
$$cadFile = fileDialog($edaType,$TOP);
});
my $quitButton = $bFrame->Button(-text => "Quit",
-width => 12,
-background => "PaleTurquoise",
-activebackground => "PaleTurquoise",
-command => sub {
$TOP->destroy; # strictly not necessary
Tk::exit;
});
my $continueButton = $bFrame->Button(-text => "Continue",
-width => 12,
-background => "PaleTurquoise",
-activebackground => "PaleTurquoise",
-command => sub {
if($$cadFile)
{
$TOP->destroy;
}
else
{
my $ch = $TOP->messageBox('-icon' => 'info',
-type => 'OK',
-title => 'Information',
-message => "Please select $edaTyp
+e input file");
}
});
Tk::grid($tFrame,
-row => 0,
-column => 0,
-sticky => 'w',
-padx => 10,
-pady => 10,
);
Tk::grid($bFrame,
-row => 1,
-column => 0,
-sticky => 's',
-padx => 10,
-pady => 10,
);
Tk::grid($quitButton,
-row => 0,
-column => 0,
-sticky => 'w',
-padx => 10,
-pady => 10,
);
Tk::grid($continueButton,
-row => 0,
-column => 1,
-sticky => 'w',
-padx => 10,
-pady => 10,
);
Tk::grid($lab,
-row => 1,
-column => 0,
-sticky => 'w',
-padx => 10,
-pady => 10,
);
Tk::grid($ent,
-row => 1,
-column => 1,
-sticky => 'w',
-padx => 10,
-pady => 10,
);
Tk::grid($but,
-row => 1,
-column => 2,
-sticky => 'w',
-padx => 10,
-pady => 10,
);
MainLoop;
}
sub fileDialog
{
#
# note now receiving more args...
#
my ($textWidget, $w, $mainWin) = @_;
my @types = setFileTypes($edaType);
my $file = undef;
# Loop until valid selection is made, or user hits "Cancel"
while(not defined($file))
{
my $_pwd = getcwd();
chdir("c:\\tmp") or print STDERR "\n\tERROR in chdir: $!\n";
$file = $w->getOpenFile(-filetypes => \@types);
if(defined($file) && $file ne '')
{
return $file;
chdir($_pwd); #back to orig dir
}
else
{
my $ch = $w->messageBox('-icon' => 'error',
-type => 'OKCancel',
-title => 'Message',
-message => "Please select a $edaType input file")
+;
if($ch eq "cancel")
{
$w->destroy;
chdir($_pwd); #back to orig dir
return $ch;
}
}
}
return $file;
}
sub setFileTypes
{
my $edaType = shift;
return (["Visula Cadif file", '*'],
["Visula Cadif file", 'cadif.file']
) if($edaType eq "Visula");
# ..........etc.
# ...and in case something is very wrong, and edatype doesn't match...
return undef;
}
| 