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