1package PDL::Graphics::OpenGL::Perl::OpenGL;
2
3BEGIN {
4   use PDL::Config;
5   if ($PDL::Config{USE_POGL}) {
6      eval "use OpenGL $PDL::Config{POGL_VERSION} qw()";
7      use OpenGL::Config;
8   }
9}
10
11BEGIN {
12   eval 'OpenGL::ConfigureNotify()';
13   if ($@) {
14      # Set up some X11 and GLX constants for fake XEvent emulation
15      {
16         no warnings 'redefine';
17         eval "sub OpenGL::GLX_DOUBLEBUFFER    () { 5 }";
18         eval "sub OpenGL::GLX_RGBA            () { 4 }";
19         eval "sub OpenGL::GLX_RED_SIZE        () { 8 }";
20         eval "sub OpenGL::GLX_GREEN_SIZE      () { 9 }";
21         eval "sub OpenGL::GLX_BLUE_SIZE       () { 10 }";
22         eval "sub OpenGL::GLX_DEPTH_SIZE      () { 12 }";
23         eval "sub OpenGL::KeyPressMask        () { (1<<0 ) }";
24         eval "sub OpenGL::KeyReleaseMask      () { (1<<1 ) }";
25         eval "sub OpenGL::ButtonPressMask     () { (1<<2 ) }";
26         eval "sub OpenGL::ButtonReleaseMask   () { (1<<3 ) }";
27         eval "sub OpenGL::PointerMotionMask   () { (1<<6 ) }";
28         eval "sub OpenGL::Button1Mask         () { (1<<8 ) }";
29         eval "sub OpenGL::Button2Mask         () { (1<<9 ) }";
30         eval "sub OpenGL::Button3Mask         () { (1<<10) }";
31         eval "sub OpenGL::Button4Mask         () { (1<<11) }";  # scroll wheel
32         eval "sub OpenGL::Button5Mask         () { (1<<12) }";  # scroll wheel
33         eval "sub OpenGL::ButtonMotionMask    () { (1<<13) }";
34         eval "sub OpenGL::ExposureMask        () { (1<<15) }";
35         eval "sub OpenGL::StructureNotifyMask    { (1<<17) }";
36         eval "sub OpenGL::KeyPress            () { 2 }";
37         eval "sub OpenGL::KeyRelease          () { 3 }";
38         eval "sub OpenGL::ButtonPress         () { 4 }";
39         eval "sub OpenGL::ButtonRelease       () { 5 }";
40         eval "sub OpenGL::MotionNotify        () { 6 }";
41         eval "sub OpenGL::Expose              () { 12 }";
42         eval "sub OpenGL::GraphicsExpose      () { 13 }";
43         eval "sub OpenGL::NoExpose            () { 14 }";
44         eval "sub OpenGL::VisibilityNotify    () { 15 }";
45         eval "sub OpenGL::ConfigureNotify     () { 22 }";
46      }
47   }
48}
49
50use warnings;
51use strict;
52
53=head1 NAME
54
55PDL::Graphics::OpenGL::Perl::OpenGL - PDL TriD OpenGL interface using POGL
56
57=head1 VERSION
58
59Version 0.01_10
60
61=cut
62
63our $VERSION = '0.01_10';
64$VERSION = eval $VERSION;
65
66
67=head1 SYNOPSIS
68
69This module provides the glue between the Perl
70OpenGL functions and the API defined by the internal
71PDL::Graphics::OpenGL one. It also supports any
72miscellaneous OpenGL or GUI related functionality to
73support PDL::Graphics::TriD refactoring.
74
75You should eventually be able to replace:
76
77    use PDL::Graphics::OpenGL
78by
79    use PDL::Graphics::OpenGL::Perl::OpenGL;
80
81This module also includes support for FreeGLUT and
82GLUT instead of X11+GLX as mechanism for creating
83windows and graphics contexts.
84
85=head1 EXPORT
86
87See the documentation for the OpenGL module.
88More details to follow as the refactored TriD module
89interface and build environment matures
90
91=head1 FUNCTIONS
92
93=head2 TBD
94
95=cut
96
97*glpOpenWindow = \&OpenGL::glpOpenWindow;
98
99*glpcOpenWindow = \&OpenGL::glpcOpenWindow;
100
101
102=head2 TBD
103
104=cut
105
106package PDL::Graphics::OpenGL::OO;
107use PDL::Graphics::TriD::Window qw();
108use PDL::Options;
109use strict;
110my $debug = 0;
111my (@fakeXEvents) = ();
112my (@winObjects) = ();
113#
114# This is a list of all the fields of the opengl object
115#
116#use fields qw/Display Window Context Options GL_Vendor GL_Version GL_Renderer/;
117
118=head2 new($class,$options,[$window_type])
119
120Returns a new OpenGL object with attributes specified in the options
121field, and of the 3d window type, if specified.  These attributes are:
122
123=for ref
124
125  x,y - the position of the upper left corner of the window (0,0)
126  width,height - the width and height of the window in pixels (500,500)
127  parent - the parent under which the new window should be opened (root)
128  mask - the user interface mask (StructureNotifyMask)
129  attributes - attributes to pass to glXChooseVisual
130
131Allowed 3d window types, case insensitive, are:
132
133=for ref
134
135  glut - use Perl OpenGL bindings and GLUT windows (no Tk)
136  x11  - use Perl OpenGL (POGL) bindings with X11 (disabled)
137
138=cut
139
140sub new {
141   my($class_or_hash,$options,$window_type) = @_;
142
143   my $isref = ref($class_or_hash);
144   my $p;
145#  OpenGL::glpSetDebug(1);
146
147   if($isref and defined $class_or_hash->{Options}){
148      $p = $class_or_hash->{Options};
149   }else{
150      my $opt = new PDL::Options(default_options());
151      $opt->incremental(1);
152      $opt->options($options) if(defined $options);
153      $p = $opt->options;
154   }
155
156   # Use GLUT windows and event handling as the TriD default
157   $window_type ||= $PDL::Config{POGL_WINDOW_TYPE};
158   # $window_type ||= 'x11';       # use X11 default until glut code is ready
159
160   my $self;
161   if ( $window_type =~ /x11/i ) {       # X11 windows
162      print STDERR "Creating X11 OO window\n" if $debug;
163      $self =  OpenGL::glpcOpenWindow(
164         $p->{x},$p->{y},$p->{width},$p->{height},
165         $p->{parent},$p->{mask}, $p->{steal}, @{$p->{attributes}});
166   } else {                              # GLUT or FreeGLUT windows
167      print STDERR "Creating GLUT OO window\n" if $debug;
168      OpenGL::glutInit() unless OpenGL::done_glutInit();        # make sure glut is initialized
169      OpenGL::glutInitWindowPosition( $p->{x}, $p->{y} );
170      OpenGL::glutInitWindowSize( $p->{width}, $p->{height} );
171      OpenGL::glutInitDisplayMode( OpenGL::GLUT_RGBA() | OpenGL::GLUT_DOUBLE() | OpenGL::GLUT_DEPTH() );        # hardwire for now
172      if ($^O ne 'MSWin32' and not $OpenGL::Config->{DEFINE} =~ /-DHAVE_W32API/) { # skip these MODE checks on win32, they don't work
173         if (not OpenGL::glutGet(OpenGL::GLUT_DISPLAY_MODE_POSSIBLE()))
174         {
175            warn "glutInitDisplayMode(GLUT_RGBA | GLUT_DOUBLE | GLUT_DEPTH | GLUT_ALPHA) not possible";
176            warn "...trying without GLUT_ALPHA";
177            # try without GLUT_ALPHA
178            OpenGL::glutInitDisplayMode( OpenGL::GLUT_RGBA() | OpenGL::GLUT_DOUBLE() | OpenGL::GLUT_DEPTH() );
179            if ( not OpenGL::glutGet( OpenGL::GLUT_DISPLAY_MODE_POSSIBLE() ) )
180            {
181               die "display mode not possible";
182            }
183         }
184      }
185
186      my($glutwin) = OpenGL::glutCreateWindow( "GLUT TriD" );
187      OpenGL::glutSetWindowTitle("GLUT TriD #$glutwin");        # add GLUT window id to title
188
189      $self = { 'glutwindow' => $glutwin, 'xevents' => \@fakeXEvents, 'winobjects' => \@winObjects };
190
191      OpenGL::glutReshapeFunc( \&_pdl_fake_ConfigureNotify );
192      OpenGL::glutCloseFunc( \&_pdl_fake_exit_handler );
193      OpenGL::glutKeyboardFunc( \&_pdl_fake_KeyPress );
194      OpenGL::glutMouseFunc( \&_pdl_fake_button_event );
195      OpenGL::glutMotionFunc( \&_pdl_fake_MotionNotify );
196      OpenGL::glutDisplayFunc( \&_pdl_display_wrapper );
197
198      OpenGL::glutSetOption(OpenGL::GLUT_ACTION_ON_WINDOW_CLOSE(), OpenGL::GLUT_ACTION_GLUTMAINLOOP_RETURNS()) if OpenGL::_have_freeglut();
199
200      OpenGL::glutMainLoopEvent();       # pump event loop so window appears
201   }
202   if(ref($self) ne 'HASH'){
203      die "Could not create OpenGL window";
204   }
205
206#  psuedo-hash style see note above
207#  no strict 'refs';
208#  my $self = bless [ \%{"$class\::FIELDS"}], $class;
209   #
210   $self->{Options} = $p;
211   $self->{window_type} = $window_type;
212   if($isref){
213      if(defined($class_or_hash->{Options})){
214         return bless $self,ref($class_or_hash);
215      }else{
216         foreach(keys %$self){
217            $class_or_hash->{$_} = $self->{$_};
218         }
219         return $class_or_hash;
220      }
221   }
222   bless $self,$class_or_hash;
223}
224
225=head2 default GLUT callbacks
226
227These routines are set as the default GLUT callbacks for when GLUT windows
228are used for PDL/POGL.  Their only function at the moment is to drive an
229fake XEvent queue to feed the existing TriD GUI controls.  At some point,
230the X11 stuff will the deprecated and we can rewrite this more cleanly.
231
232=cut
233
234sub _pdl_display_wrapper {
235   my ($win) = OpenGL::glutGetWindow();
236   if ( defined($win) and defined($winObjects[$win]) ) {
237      $winObjects[$win]->display();
238   }
239}
240
241sub _pdl_fake_exit_handler {
242   my ($win) = shift;
243   print "_pdl_fake_exit_handler: clicked for window $win\n" if $debug;
244   # Need to clean up better and exit/transition cleanly
245}
246
247sub _pdl_fake_ConfigureNotify {
248   print "_pdl_fake_ConfigureNotify: got (@_)\n" if $debug;
249   OpenGL::glutPostRedisplay();
250   push @fakeXEvents, [ 22, @_ ];
251}
252
253sub _pdl_fake_KeyPress {
254   print "_pdl_fake_KeyPress: got (@_)\n" if $debug;
255   push @fakeXEvents, [ 2, chr($_[0]) ];
256}
257
258{
259   my @button_to_mask = (1<<8, 1<<9, 1<<10, 1<<11, 1<<12);
260   my $fake_mouse_state = 16;  # default have EnterWindowMask set;
261   my $last_fake_mouse_state;
262
263   sub _pdl_fake_button_event {
264      print "_pdl_fake_button_event: got (@_)\n" if $debug;
265      $last_fake_mouse_state = $fake_mouse_state;
266      if ( $_[1] == 0 ) {       # a press
267         $fake_mouse_state |= $button_to_mask[$_[0]];
268         push @fakeXEvents, [ 4, $_[0]+1, @_[2,3], -1, -1, $last_fake_mouse_state ];
269      } elsif ( $_[1] == 1 ) {  # a release
270         $fake_mouse_state &= ~$button_to_mask[$_[0]];
271         push @fakeXEvents, [ 5, $_[0]+1 , @_[2,3], -1, -1, $last_fake_mouse_state ];
272      } else {
273         die "ERROR: _pdl_fake_button_event got unexpected value!";
274      }
275   }
276
277   sub _pdl_fake_MotionNotify {
278      print "_pdl_fake_MotionNotify: got (@_)\n" if $debug;
279      push @fakeXEvents, [ 6, $fake_mouse_state, @_ ];
280   }
281
282}
283
284=head2 default_options
285
286default options for object oriented methods
287
288=cut
289
290sub default_options{
291   {  'x'     => 0,
292      'y'     => 0,
293      'width' => 500,
294      'height'=> 500,
295      'parent'=> 0,
296      'mask'  => eval '&OpenGL::StructureNotifyMask',
297      'steal' => 0,
298      'attributes' => eval '[ &OpenGL::GLX_DOUBLEBUFFER, &OpenGL::GLX_RGBA ]',
299   }
300}
301
302
303=head2 XPending()
304
305OO interface to XPending
306
307=cut
308
309sub XPending {
310   my($self) = @_;
311   if ( $self->{window_type} eq 'glut' ) {
312      # monitor state of @fakeXEvents, return number on queue
313      print STDERR "OO::XPending: have " .  scalar( @{$self->{xevents}} ) . " xevents\n" if $debug > 1;
314      scalar( @{$self->{xevents}} );
315   } else {
316      OpenGL::XPending($self->{Display});
317   }
318}
319
320
321=head2 XResizeWindow(x,y)
322
323OO interface to XResizeWindow
324
325=cut
326
327sub XResizeWindow {
328  my($self,$x,$y) = @_;
329  OpenGL::glpResizeWindow($x,$y,$self->{Window},$self->{Display});
330}
331
332
333=head2 glpXNextEvent()
334
335OO interface to glpXNextEvent
336
337=cut
338
339
340sub glpXNextEvent {
341   my($self) = @_;
342   if ( $self->{window_type} eq 'glut' ) {
343      while ( !scalar( @{$self->{xevents}} ) ) {
344         # If no events, we keep pumping the event loop
345         OpenGL::glutMainLoopEvent();
346      }
347      # Extract first event from fake event queue and return
348      return @{ shift @{$self->{xevents}} };
349   } else {
350      return OpenGL::glpXNextEvent($self->{Display});
351   }
352}
353
354
355=head2 glpRasterFont()
356
357OO interface to the glpRasterFont function
358
359=cut
360
361sub glpRasterFont{
362   my($this,@args) = @_;
363   OpenGL::glpRasterFont($args[0],$args[1],$args[2],$this->{Display});
364}
365
366
367=head2 AUTOLOAD
368
369If the function is not prototyped in OO we assume there is
370no explicit mention of the three identifying parameters (Display, Window, Context)
371and try to load the OpenGL function.
372
373=cut
374
375sub AUTOLOAD {
376  my($self,@args) = @_;
377  use vars qw($AUTOLOAD);
378  my $sub = $AUTOLOAD;
379  return if($sub =~ /DESTROY/);
380  $sub =~ s/.*:://;
381  $sub = "OpenGL::$sub";
382  if(defined $debug){
383    print "In AUTOLOAD: $sub at ",__FILE__," line ",__LINE__,".\n";
384  }
385  no strict 'refs';
386  return(&{$sub}(@args));
387}
388
389
390=head2 glXSwapBuffers
391
392OO interface to the glXSwapBuffers function
393
394=cut
395
396sub glXSwapBuffers {
397	my($this,@args) = @_;
398	OpenGL::glXSwapBuffers($this->{Window},$this->{Display});  # Notice win and display reversed [sic]
399}
400
401
402=head1 AUTHOR
403
404Chris Marshall, C<< <devel dot chm dot 01 at gmail.com> >>
405
406=head1 BUGS
407
408Bugs and feature requests may be submitted through the PDL GitHub
409project page at L<https://github.com/PDLPorters/pdl/issues> .
410
411
412=head1 SUPPORT
413
414PDL uses a mailing list support model.  The Perldl mailing list
415is the best for questions, problems, and feature discussions with
416other PDL users and PDL developers.
417
418To subscribe see the page at L<http://pdl.perl.org/?page=mailing-lists>
419
420
421
422=head1 ACKNOWLEDGEMENTS
423
424TBD including PDL TriD developers and POGL developers...thanks to all.
425
426=head1 COPYRIGHT & LICENSE
427
428Copyright 2009 Chris Marshall.
429
430This program is free software; you can redistribute it and/or modify it
431under the terms of either: the GNU General Public License as published
432by the Free Software Foundation; or the Artistic License.
433
434See http://dev.perl.org/licenses/ for more information.
435
436
437=cut
438
4391; # End of PDL::Graphics::OpenGL::Perl::OpenGL
440