3
# PDL::Graphics::TriD::Tk - A Tk widget interface to the PDL::Graphics::TriD
4
# visualization package: $Revision: 1.6 $
7
# Instituto Nacional de Meteorologia
9
# jedwards@inmet.gov.br
11
# This distribution is free software; you can
12
# redistribute it and/or modify it under the same terms as Perl itself.
17
PDL::Graphics::TriD::Tk - A Tk widget interface to the PDL::Graphics::TriD.
24
# Opens a Tk window with an embedded TriD window - that's all
25
# see Demos/TkTriD_demo.pm for a better example
28
use PDL::Graphics::TriD;
29
use PDL::Graphics::TriD::GL;
31
use PDL::Graphics::TriD::Tk;
33
my $MW = MainWindow->new();
34
my $TriDW = $MW->Tk( )->pack(-expand=>1, -fill=>'both');
39
The widget is composed of a Frame and the Display device of the TriD output.
40
It inherits all of the attributes of a Tk Frame. All of the events associated
41
with this window are handled through Tk with the exception of the <expose> event
42
which must be handled by TriD because the Frame is never exposed.
43
Default Mouse bindings, defined for button1 and button3,
44
control TriD object orientation and size respectively.
48
package PDL::Graphics::TriD::Tk;
51
use PDL::Graphics::TriD;
52
use PDL::Graphics::OpenGL;
56
@PDL::Graphics::TriD::Tk::ISA = qw(Tk::Frame);
58
$PDL::Graphics::TriD::Tk::verbose=0;
60
Tk::Widget->Construct('Tk');
62
#$PDL::Graphics::TriD::Tk::VERSION = '$Revision: 1.6 $ ' ;
63
#$PDL::Graphics::TriD::Tk::VERSION =~ s/\$Revision: 1.6 $\s*$/$1/;
64
#sub Version {return $PDL::Graphics::TriD::Tk::VERSION;}
72
Used for widget initialization by Tk, this function should never be called directly
77
my($TriD, $args) = @_;
79
if(defined $PDL::Graphics::TriD::cur){
80
print "Current code limitations prevent TriD:Tk from being loaded after ";
81
print "another TriD graphics window has been defined. If you are running the ";
82
print "PDL demo package, please start it again and run this demo first.\n";
86
$args->{-height}=300 unless defined $args->{-height};
87
$args->{-width}=300 unless defined $args->{-width};
89
$TriD->SUPER::Populate($args);
90
# This bind causes GL to be initialized after the
91
# Tk frame is ready to accept it
92
$TriD->bind("<Configure>", [ \&GLinit ]);
93
print "Populate complete\n" if($PDL::Graphics::TriD::Tk::verbose);
100
Should be used in place of the Tk MainLoop. Handles all of the Tk
101
callbacks and calls the appropriate TriD display functions.
111
unless ($Tk::inMainLoop)
113
local $Tk::inMainLoop = 1;
114
while (Tk::MainWindow->Count)
116
DoOneEvent(Tk::DONT_WAIT());
119
if(defined $self->{GLwin}){
121
my @e = &glpXNextEvent();
122
# if($e[0] == &ConfigureNotify) {
123
# print "CONFIGNOTIFE\n" if($PDL::Graphics::TriD::verbose);
124
# $self->reshape($e[1],$e[2]);
129
my $job=shift(@{$self->{WorkQue}});
131
my($cmd,@args) = @$job;
143
GLinit is called internally by a Configure callback in Populate. This insures
144
that the required Tk::Frame is initialized before the TriD::GL window that will go inside.
149
my($self,@args) = @_;
151
if(defined $self->{GLwin}){
152
# print "OW= ",$self->width," OH= ",$self->height,"\n";
154
# print "NW= ",$self->width," NH= ",$self->height,"\n";
155
$self->{GLwin}{_GLObject}->XResizeWindow($self->width ,$self->height);
157
$self->{GLwin}->reshape($self->width,$self->height);
160
# width and height represent the largest size on my screen so that the
161
# graphics window always fills the frame.
162
my $options={parent=> ${$self->WindowId},
163
width=> $self->width,
164
height=>$self->height};
165
$options->{mask} = ( ExposureMask );
167
$self->{GLwin} = PDL::Graphics::TriD::get_current_window($options);
169
$self->{GLwin}->reshape($self->width,$self->height);
172
# This is an array for future expansion beyond the twiddle call.
174
$self->{WorkQue}= [];
177
$self->bind("<Button1-Motion>",[ \&buttonmotion, 1, Ev('x'),Ev('y')]);
178
$self->bind("<Button2-Motion>",[ \&buttonmotion, 2, Ev('x'),Ev('y')]);
179
$self->bind("<Button3-Motion>",[ \&buttonmotion, 3, Ev('x'),Ev('y')]);
188
refresh() causes a display event to be put at the top of the TriD work que.
189
This should be called at the end of each user defined TriD::Tk callback.
195
return unless defined $self->{GLwin};
196
# put a redraw command at the top of the work queue
197
my $dcall=ref($self->{GLwin})."::display";
198
unshift(@{$self->{WorkQue}}, [\&{$dcall},$self->{GLwin}]);
205
Trys to find a subroutine in PDL::Graphics::TriD when it is
206
not found in this package.
211
# This AUTOLOAD allows the PDL::Graphics::TriD::Tk object to act as the PDL::Graphics::TriD
212
# object which it contains. It seems slow and may not be a good idea.
217
use vars qw($AUTOLOAD);
219
# get subroutine name
221
# print "In AutoLoad $self $sub\n";
222
if(defined($self->{GLwin})){
224
return($self->{GLwin}->$sub(@args));
235
Default bindings for mousemotion with buttons 1 and 3
242
my($self,$but,$x,$y)=@_;
246
foreach my $vp (@{$self->viewports()}){
248
# my $out = Dumper($vp);
251
next unless $vp->{Active};
252
next unless defined $vp->{EHandler}{Buttons}[$but];
253
$vp->{EHandler}{Buttons}[$but]->mouse_moved($vp->{EHandler}{X},
256
$vp->{EHandler}{X} = $x;
257
$vp->{EHandler}{Y} = $y;
268
B<James P. Edwards, Instituto Nacional de Meteorologia Brasil>
270
jedwards@inmet.gov.br
added
removed
Graphics/TriD/TriD/Tk.pm
