embedding opengl in perl tk - perl

Question

I have an application written with perl Tk, showing some data on a canvas. Now I would like to be able to generate a 3d view of the data with opengl. Is there any way to embed an OpenGL widget or window inside an Tk window?
I've seen some posts in perlmonks that use Tk and glpCreateWindow to create a new separated OpenGL window but I want the OpenGL "canvas" to be inside the main Tk window.

Answer 1

Here's an adaption of the tk_demo script which comes with the OpenGL perl module
https://metacpan.org/source/CHM/OpenGL-0.66/examples/tk_demo.pl
The script was changed so that the opengl drawing appears in a Frame widget, and not in a Toplevel/MainWindow widget, so other Tk widgets may be contained within the same Toplevel. It's even possible to resize the Tk window, the opengl drawing will adapt accordingly.
There's one flaw though: it seems that it's not possible to start the opengl drawing using afterIdle(); at this point the container frame does not seem to exist yet and a X11 error happens. It's also not possible to use waitVisibility() here. Hence the workaround using after(1000,...).
#!/usr/local/bin/perl
#
# This is an example of combining the tk module and opengl
# You have to have TK installed for this to work.
# this program opens a window and when you hit a key in
# the window a callback that does some opengl stuff is
# executed.
# Yes, this is a totally lame program, but its a proof
# of concept sort of thing.
# We'll get something better next time :-)
#
use lib ('blib');
use strict;
use Tk;
use OpenGL;
my $top = MainWindow->new();
$top->Label(-text => "Hello, OpenGL!")->pack;
my $f = $top->Frame(-bg => "green", -width => 200, -height => 200)->pack(-expand => 1, -fill => "both");
$top->Button(-text => "Exit", -command => sub { $top->destroy })->pack;
my $kid;
sub CreateKid {
my $par = shift;
my $id = hex($par->id);
print " window id: $id -> ", (sprintf '%#x', $id),"\n";
my ($w, $h) = ($par->Width, $par->Height);
my ($xbord, $ybord) = (int($w/8), int($h/8));
$kid = glpOpenWindow( x => $xbord, y => $ybord, width=> ($w-2*$xbord),
height=> ($h-2*$ybord),parent=>$id);
}
sub ResetKid {
return unless $kid;
my $par = shift;
my $w = $par->Width;
my $h = $par->Height;
my ($xbord, $ybord) = (int($w/8), int($h/8));
$w = $w-2*$xbord;
$h = $h-2*$ybord;
glpMoveResizeWindow($xbord,$ybord,$w,$h);
glViewport(0,0,$w,$h);
print "viewport $w x $h, origin $xbord, $ybord\n";
DrawKid();
}
my $pending = 0;
sub DrawKid {
return unless $kid;
return if $pending++;
$top->DoWhenIdle(\&DrawKid_do);
}
sub DrawKid_do {
return unless $kid;
$pending = 0;
print "Drawing...\n";
glClearColor(0,0,1,1);
glClear(GL_COLOR_BUFFER_BIT);
glOrtho(-1,1,-1,1,-1,1);
glColor3f(1,0,0);
glBegin(GL_POLYGON);
glVertex2f(-0.5,-0.5);
glVertex2f(-0.5, 0.5);
glVertex2f( 0.5, 0.5);
glVertex2f( 0.5,-0.5);
glEnd();
glFlush();
}
sub DrawKid1 {
return unless $kid;
print "Visibility change\n";
DrawKid;
}
sub DrawKid2 {
return unless $kid;
print "Expose change\n";
DrawKid;
}
sub DoKey
{
my $w = shift;
return if $kid;
CreateKid $w;
DrawKid;
}
sub DoMouse
{
shift;
my ($b,$p) = (shift,shift);
print "mouse-$b $p\n";
}
$f->after(1000, sub { DoKey($f) });
$f->bind("<Any-ButtonPress>",[\&DoMouse, Ev('b'), Ev('#')]);
$f->bind("<KeyPress-q>",[$top, 'destroy']);
$f->bind("<KeyPress-Escape>",[$top, 'destroy']);
$f->bind("<Configure>",\&ResetKid);
$f->bind("<Visibility>",\&DrawKid1);
$f->bind("<Expose>",\&DrawKid2);
Tk::MainLoop();