Graphics-VTK
view release on metacpan or search on metacpan
* examples/tcl2perl: Fixed so the tk -variable option changes
variables to a variable reference
2001-11-18 12:27 cerney
* examples/tcl2perl: Tweaks to handle callbacks correctly
2001-11-17 19:56 cerney
* examples/tcl2perl: Got Menus working
2001-11-17 08:48 cerney
* examples/tcl2perl: Updated to handle multiple pack widgets
2001-11-14 21:35 cerney
* examples/tcl2perl: Tk 'add' commands now work
2001-11-13 19:59 cerney
examples/old_examples/graphics/Decimate.pl view on Meta::CPAN
EndProgress();
}
);
#
######################################## Create top-level GUI
#
$MW->title("vtk Decimator v1.0");
$MW->{'.mbar'} = $MW->Frame('-relief','raised','-bd',2);
$MW->{'.mbar'}->pack('-side','top','-fill','x');
#
$MW->{'.mbar.file'} = $MW->{'.mbar'}->Menubutton('-text','File');
$MW->{'.mbar.edit'} = $MW->{'.mbar'}->Menubutton('-text','Edit');
$MW->{'.mbar.view'} = $MW->{'.mbar'}->Menubutton('-text','View');
$MW->{'.mbar.options'} = $MW->{'.mbar'}->Menubutton('-text','Options');
$MW->{'.mbar.help'} = $MW->{'.mbar'}->Menubutton('-text','Help');
foreach $_ (($MW->{'.mbar.file'},$MW->{'.mbar.edit'},$MW->{'.mbar.view'},$MW->{'.mbar.options'}))
{
$_->pack('-side','left');
}
$MW->{'.mbar.help'}->pack('-side','right');
#
# menu .mbar.file.menu
$MW->{'.mbar.file'}->command('-label','Open','-command',
sub
{
examples/old_examples/graphics/polyViewer.pl view on Meta::CPAN
## Create a little app for loading and viewing polygonal files
##
$VTK_DATA = 0;
$VTK_DATA = $ENV{VTK_DATA};
use Graphics::VTK::Tk::vtkInteractor;
# Create gui
$MW->title("vtk Polygonal Data Viewer");
$MW->{'.mbar'} = $MW->Frame('-relief','raised','-bd',2);
$MW->{'.mbar'}->pack('-side','top','-fill','x');
$MW->{'.mbar.file'} = $MW->{'.mbar'}->Menubutton('-text','File');
$MW->{'.mbar.view'} = $MW->{'.mbar'}->Menubutton('-text','View');
$MW->{'.mbar.help'} = $MW->{'.mbar'}->Menubutton('-text','Help');
foreach $_ (($MW->{'.mbar.file'},$MW->{'.mbar.view'}))
{
$_->pack('-side','left');
}
$MW->{'.mbar.help'}->pack('-side','right');
# menu .mbar.file.menu
$MW->{'.mbar.file'}->command('-label','Open','-command',
sub
{
OpenFile();
examples/old_examples/imaging/ViewerApp.pl view on Meta::CPAN
}
);
$MW->{'.top.menu.help'}->command('-label',"User Interface",'-command',
sub
{
HelpUI();
}
);
# Helper proc
#
sub AddFilterMenuItem
{
my $labelString = shift;
my $command = shift;
$MW->{'.top.menu.filters'}->checkbutton('-onvalue','on','-label',$labelString,'-offvalue','off','-command',"ActivateFilter $command",'-variable',\$$command);
}
# #1 -- To add a filter to the menu, call AddFilterMenuItem passing
# the "label" to use for the menu item and the name of your filter's
# instance. Example: Below is a filter called "gaussian" so we call
# AddFilterMenuItem Smoothing gaussian
AddFilterMenuItem('Smoothing','gaussian');
AddFilterMenuItem("Edge Directions",'gradient');
AddFilterMenuItem('Magnitude','magnitude');
AddFilterMenuItem("Flip Y",'flipY');
AddFilterMenuItem("Flip X",'flipX');
$MW->{'.top'}->configure('-menu','.top.menu');
# viewer frame
$MW->{'.top.f1'} = $MW->{'.top'}->Frame;
$viewer = Graphics::VTK::ImageViewer->new;
$MW->{'.top.f1.v1'} = $MW->{'.top.f1'}->vtkImageViewer('-width',512,'-height',512,'-iv',$viewer);
$MW->{'.top.f1.v1'}->pack('-padx',3,'-pady',3,'-side','left','-fill','both','-expand','t');
# annotation frames
$MW->{'.top.f2'} = $MW->{'.top'}->Frame;
$MW->{'.top.f2.f1'} = $MW->{'.top.f2'}->Frame;
$MW->{'.top.f2.f2'} = $MW->{'.top.f2'}->Frame;
examples/tcl2perl view on Meta::CPAN
%Parse::RecDescent::Procs = (); # hash of any procs defined
%Parse::RecDescent::Procs = (); # appears twice to avoid warning message
%Parse::RecDescent::MyVariables= (); # appears twice to avoid warning message
%Parse::RecDescent::MyVariables= (); # hash of any local variables used in the current context
# ( Will be translated to 'my' variables )
%Parse::RecDescent::GlobalVariables= (); # appears twice to avoid warning message
%Parse::RecDescent::GlobalVariables= (); # hash of any global variables used in the current context
%Parse::RecDescent::MenuPaths= (); # appears twice to avoid warning message
%Parse::RecDescent::MenuPaths= (); # Mapping of -menu paths used in menubutton commands to the
# pathname of the menubutton. This is used to translate
# the tcl way of adding menubutton commands using the 'menu'
# command to the perltk way of $menubutton->command(... syntax
###########################################
#################### Parse::RecDescent Grammer #################
my $parse = Parse::RecDescent->new(<<'EndGrammar');
main: statements /\s*\Z/ { $item[1] }
examples/tcl2perl view on Meta::CPAN
$class =~ s/^vtk//;
$Parse::RecDescent::vtkObjects{$varLookup} = 1;
['=', $varName,[ '->', "Graphics::VTK::".$class, 'new', @$args]];
}
# tk add command
tcl_tkadd: lvar 'add' tcl_arg tkoption(s?)
{
my ($rule, $name, $add, $method, $options) = @item;
# if name is a pre-defined MenuPath, then map it to
# a menubutton
if( defined( $Parse::RecDescent::MenuPaths{$name} )){
$name = $Parse::RecDescent::MenuPaths{$name};
}
# Flatten the options
my @options = map {@$_} @$options;
my %argHash = @options;
# convert -variable option to variable reference
if( defined( $argHash{-variable})){
my $varname = $argHash{-variable};
examples/tcl2perl view on Meta::CPAN
my $retVal = ['->',$name, $method, @options];
}
# tk methods command (currently only entry configure supported
tcl_tkentryconfig: lvar 'entryconfigure' tcl_arg tkoption(s?)
{
my ($rule, $name, $method, $entry, $options) = @item;
# if name is a pre-defined MenuPath, then map it to
# a menubutton
if( defined( $Parse::RecDescent::MenuPaths{$name} )){
$name = $Parse::RecDescent::MenuPaths{$name};
}
# Flatten the options
my @options = map {@$_} @$options;
my %argHash = @options;
# convert -variable option to variable reference
if( defined( $argHash{-variable})){
my $varname = $argHash{-variable};
examples/tcl2perl view on Meta::CPAN
my $outPath = shift @ARGV;
foreach $file (@ARGV)
{
if ($file =~ /\.tcl$/)
{ # Clear Global Variables
%Parse::RecDescent::vtkObjects = ();
%Parse::RecDescent::Procs = ();
%Parse::RecDescent::Objects = ();
%Parse::RecDescent::MyVariables= ();
%Parse::RecDescent::GlobalVariables= ();
%Parse::RecDescent::MenuPaths= ();
my $perl = basename($file);
$perl =~ s/\.tcl/.pl/;
my $preprocedFile = preProcessFile($file, basename($file));
open(TCL,"<$preprocedFile") || die "Cannot open $preprocedFile:$!";
print STDERR "$file => $perl\n";
my $prog = <TCL>;
close(TCL);
examples/tcl2perl view on Meta::CPAN
# Flatten the options
@$args = map {@$_} @$args;
my ($parent,$name) = ($path =~ /^(.*)\.([^.]+)$/);
my $retVal;
$widget = ucfirst($widget) unless( $widget =~ /^vtk/);
if (defined($parent) && defined($name)){
my %argHash = @$args;
# Save Menubutton -menu if present:
if( $widget eq 'Menubutton'){
if( defined($argHash{-menu})){
$Parse::RecDescent::MenuPaths{$argHash{-menu}} = $path;
delete $argHash{-menu};
}
}
# convert -variable option to variable reference
if( defined( $argHash{-variable})){
my $varname = $argHash{-variable};
$argHash{-variable} = "\\\$".$varname;
}
( run in 0.584 second using v1.01-cache-2.11-cpan-49f99fa48dc )