has been undergoing many code changes recently, and one of the current weaknesses is that the Tk interface to the TriD 3d graph window has been temporarily removed as the new OpenGL module is integrated. It is promised that a cross-platform GUI integration tool will soon come for Tk, Gtk2, Wx, etc.
In the mean time, I have patched up a package for Tk, that works on linux only.
Here it is. screenshot
It is meant to show how to easily use Tk, to visualize the results of changing equation coefficients.
#!/usr/bin/perl
use warnings;
use Tk;
use PDL::LiteF;
use PDL::Graphics::TriD;
# this is the old TriD::Tk.pm from earlier PDL
# releases, slightly modified to use the new OpenGL module
# It works on linux only
package PDL::Graphics::TriD::Tk;
use Tk;
use PDL::Core;
use PDL::Graphics::TriD;
use PDL::Graphics::OpenGLQ;
use OpenGL;
use strict;
no warnings ('redefine'); # redefine MainLoop
@PDL::Graphics::TriD::Tk::ISA = qw(Tk::Frame);
$PDL::Graphics::TriD::Tk::verbose=0;
Tk::Widget->Construct('Tk');
# Populate is used for widget initialization by Tk,
# this function should never be called directly
sub Populate {
my($TriD, $args) = @_;
if(defined $PDL::Graphics::TriD::cur){
print "Current code limitations prevent TriD:Tk from being loaded afte
+r ";
print "another TriD graphics window has been defined. If you are runn
+ing the ";
print "PDL demo package, please start it again and run this demo first
+.\n";
exit;
}
$args->{-height}=300 unless defined $args->{-height};
$args->{-width}=300 unless defined $args->{-width};
$TriD->SUPER::Populate($args);
# This bind causes GL to be initialized after the
# Tk frame is ready to accept it
$TriD->bind("<Configure>", [ \&GLinit ]);
print "Populate complete\n" if($PDL::Graphics::TriD::Tk::verbose);
}
=head2 MainLoop
=for ref
Should be used in place of the Tk MainLoop. Handles all of the Tk
callbacks and calls the appropriate TriD display functions.
=cut
sub MainLoop
{
my ($self) = @_;
unless ($Tk::inMainLoop)
{
local $Tk::inMainLoop = 1;
while (Tk::MainWindow->Count)
{
DoOneEvent(Tk::DONT_WAIT());
if(defined $self->{GLwin}){
if( &XPending()){
my @e = &glpXNextEvent();
# if($e[0] == &ConfigureNotify) {
# print "CONFIGNOTIFE\n" if($PDL::Graphics::TriD::verbose);
# $self->reshape($e[1],$e[2]);
# }
$self->refresh();
}
my $job=shift(@{$self->{WorkQue}});
if(defined $job){
my($cmd,@args) = @$job;
&{$cmd}(@args);
}
}
}
}
}
=head2 GLinit
=for ref
GLinit is called internally by a Configure callback in Populate. This
+ insures
that the required Tk::Frame is initialized before the TriD::GL window
+that will go inside.
=cut
sub GLinit{
my($self,@args) = @_;
if(defined $self->{GLwin}){
# print "OW= ",$self->width," OH= ",$self->height,"\n";
# $self->update;
# print "NW= ",$self->width," NH= ",$self->height,"\n";
$self->{GLwin}{_GLObject}->XResizeWindow($self->width ,$self->height);
$self->{GLwin}->reshape($self->width,$self->height);
$self->refresh();
}else{
# width and height represent the largest size on my screen so that the
# graphics window always fills the frame.
my $options={parent=> ${$self->WindowId},
width=> $self->width,
height=>$self->height};
$options->{mask} = ( ExposureMask );
$self->{GLwin} = PDL::Graphics::TriD::get_current_window($options);
$self->{GLwin}->reshape($self->width,$self->height);
#
# This is an array for future expansion beyond the twiddle call.
#
$self->{WorkQue}= [];
$self->refresh();
$self->bind("<Button1-Motion>",[ \&buttonmotion, 1, Ev('x'),Ev('y')]);
$self->bind("<Button2-Motion>",[ \&buttonmotion, 2, Ev('x'),Ev('y')]);
$self->bind("<Button3-Motion>",[ \&buttonmotion, 3, Ev('x'),Ev('y')]);
}
}
=head2 refresh
=for ref
refresh() causes a display event to be put at the top of the TriD work
+ que.
This should be called at the end of each user defined TriD::Tk callbac
+k.
=cut
sub refresh{
my($self) = @_;
return unless defined $self->{GLwin};
# put a redraw command at the top of the work queue
my $dcall=ref($self->{GLwin})."::display";
unshift(@{$self->{WorkQue}}, [\&{$dcall},$self->{GLwin}]);
}
=head2 AUTOLOAD
=for ref
Trys to find a subroutine in PDL::Graphics::TriD when it is
not found in this package.
=cut
#
# This AUTOLOAD allows the PDL::Graphics::TriD::Tk object to act as t
+he PDL::Graphics::TriD
# object which it contains. It seems slow and may not be a good idea
+.
#
sub AUTOLOAD {
my ($self,@args)=@_;
use vars qw($AUTOLOAD);
my $sub = $AUTOLOAD;
# get subroutine name
# print "In AutoLoad $self $sub\n";
if(defined($self->{GLwin})){
$sub =~ s/.*:://;
return($self->{GLwin}->$sub(@args));
}
}
=head2 buttonmotion
=for ref
Default bindings for mousemotion with buttons 1 and 3
=cut
sub buttonmotion{
my($self,$but,$x,$y)=@_;
$but--;
foreach my $vp (@{$self->viewports()}){
# use Data::Dumper;
# my $out = Dumper($vp);
# print "$out\n";
# exit;
next unless $vp->{Active};
next unless defined $vp->{EHandler}{Buttons}[$but];
$vp->{EHandler}{Buttons}[$but]->mouse_moved($vp->{EHandler}{X},
$vp->{EHandler}{Y}, $x,$y);
$vp->{EHandler}{X} = $x;
$vp->{EHandler}{Y} = $y;
}
$self->refresh();
}
=head1 Author
B<James P. Edwards, Instituto Nacional de Meteorologia Brasil>
jedwards@inmet.gov.br
=cut
1;
package main;
# some default settings
my %var =(
's'=> 40,
'o'=> .5,
'i'=> .1,
'r' => .5,
'g' => .5,
'b' => .25
);
my $mw = MainWindow->new(-bg => 'white');
my $TriDW = $mw->Tk(-width => 500, -height => 500 )->pack(-side => 'le
+ft', -expand=>1, -fill=>'both');
# needed to make sure GL window sets up
$TriDW->waitVisibility;
my $button = $mw->Button(-text=>'Quit',
-command => sub{ exit })->pack();
my $button2 = $mw->Button(-text=>'interesting quark-like effect',
-command => sub{
$var{'s'} = 50;
$var{'o'} = .17;
$var{'i'} = 1.85;
$var{'r'} = .5;
$var{'g'} = .5;
$var{'b'} = .25;
&Torusdemos();
})->pack();
my $tframe1 = $mw->Frame()->pack(-side=>'right',-padx=>0);
my %scale;
for ('s','o','i','r','g','b'){
my $tframea = $tframe1->Frame(-bg =>'black')->pack(-side=>'left',-padx
+=>0);
$tframea->Label(-text => " $_ ")->pack(-side=>'top');
my $range0 = .1;
my $range1 = 5;
if( $_ eq 's'){ $range0 = 5; $range1 = 100 }
if( $_ =~ /[r|g|b]/ ){ $range0 = 0; $range1 = 10 }
$scale{$_} = $tframea->Scale(
-from => $range0,
-to => $range1,
-length => 500,
-orient => 'vertical',
-variable => \$var{$_},
-resolution => .01,
-borderwidth =>0,
-foreground => 'white',
-background => 'lightslategrey',
-troughcolor => 'powderblue',
)->pack(-side => 'left', -padx=>10);
$scale{$_}->bind('<ButtonRelease-1>', sub{ &Torusdemos() } );
}
&Torusdemos();
my $vp = $TriDW->{ GLwin }->current_viewport;
$vp->setview([3,3,3]);
$TriDW->MainLoop;
sub Torusdemos {
# seems to work to release the old data set
$TriDW->clear_viewports();
my $graph = $TriDW->{ GLwin }->current_viewport->graph();
$graph = new PDL::Graphics::TriD::Graph();
$graph->default_axes();
# $graph->delete_data( "TorusColors" );
# $graph->delete_data( "TorusLighting" );
my $data;
my $s = $var{'s'};
my $a = zeroes 2 * $s, $s / 2;
my $t = $a->xlinvals( 0, 6.284 );
my $u = $a->ylinvals( 0, 6.284 );
my $o = $var{'o'};
my $i = $var{'i'};
my $v = $o + $i * sin $u;
my $x = $v * sin $t;
my $y = $v * cos $t;
my $z = $i * cos( $u ) + $o * sin( 3 * $t );
# color
my $r = $var{'r'};
my $g = $var{'g'};
my $b = $var{'b'};
$data = new PDL::Graphics::TriD::SLattice(
[ $x, $y, $z ],
[
$r * ( 1 + sin $t ),
$g * ( 1 + cos $t ),
$b * ( 2 + cos( $u ) + sin( 3 * $t ) )
]
);
# black and white
# $data = new PDL::Graphics::TriD::SLattice_S( [ $x, $y, $z ] );
$graph->add_dataseries( $data, "demo" );
$graph->scalethings();
$TriDW->current_viewport()->graph( $graph );
$TriDW->refresh();
}
__END__