view release on metacpan or  search on metacpan

BleedingOpenGL.pm  view on Meta::CPAN

	glTranslated
	glTranslatef
	glVertex2dv
	glVertex2fv
	glVertex2iv
	glVertex2sv
	glVertex3dv
	glVertex3fv
	glVertex3iv
	glVertex3sv
	glVertex4dv
	glVertex4fv
	glVertex4iv
	glVertex4sv
	glViewport
);

sub AUTOLOAD {
    # This AUTOLOAD is used to 'autoload' constants from the constant()
    # XS function.  If a constant is not found then control is passed
    # to the AUTOLOAD in AutoLoader.

    # NOTE: THIS AUTOLOAD FUNCTION IS FLAWED (but is the best we can do for now).
    # Avoid old-style ``&CONST'' usage. Either remove the ``&'' or add ``()''.
    if (@_ > 0) {

	# Is it an old OpenGL-0.4 function? If so, remap it to newer variant
    local($constname);
    ($constname = $AUTOLOAD) =~ s/.*:://;
    if (grep ($_ eq $constname, @rename_old)) {
    	eval "sub $AUTOLOAD { $AUTOLOAD" . "_s(\@_) }";
    	goto &$AUTOLOAD;
    }
    
	$AutoLoader::AUTOLOAD = $AUTOLOAD;
	goto &AutoLoader::AUTOLOAD;
    }
    local($constname);
    ($constname = $AUTOLOAD) =~ s/.*:://;
    $val = constant($constname, @_ ? $_[0] : 0);
    if (not defined $val) {
	if ($! =~ /Invalid/) {
	    $AutoLoader::AUTOLOAD = $AUTOLOAD;
	    goto &AutoLoader::AUTOLOAD;
	}
	else {
	    ($pack,$file,$line) = caller;
	    die "Your vendor has not defined OpenGL macro $constname, used at $file line $line.
";
	}
    }
    eval "sub $AUTOLOAD { $val }";
    goto &$AUTOLOAD;
}

bootstrap Acme::MITHALDU::BleedingOpenGL;

*OpenGL::Array::CLONE_SKIP = sub { 1 };  # OpenGL::Array is not thread safe
*OpenGL::Matrix::CLONE_SKIP = sub { 1 };  # OpenGL::Matrix is not thread safe

# The following material is directly copied from Stan Melax's original OpenGL-0.4
# (with modifications for OS/2).

%window_defaults=(
   'x'         => 0,
   'y'         => 0,
   'width'     => 500,
   'height'    => 500,
   'parent'    => 0,
   'steal'     => 0,
   'mask'      => (_have_glx() ? StructureNotifyMask() : 0),
   'attributes'=> [],
);


sub glpOpenWindow {
        # default values
        my(%a) = @_;
        my(%p) = %window_defaults;
        foreach $k (keys(%a)){
                exists($p{$k}) || warn "Not a valid parameter to glpOpenWindow: `$k'\n";
                #print "parameter $k now ",$a{$k}," was ",$p{$k},"\n";  
                $p{$k} = $a{$k};
        }
        #
        # glpcOpenWindow() no longer exported.  Use fully qualified
        # package name or (better!) glpOpenWindow()
        #
        glpcOpenWindow($p{'x'},$p{'y'},$p{'width'},$p{'height'},
                       $p{'parent'},$p{'mask'},$p{'steal'},
                       @{$p{'attributes'}});
}

# The following material is original to OpenGL-0.5, and provides compatibility
# with some of Stan's functions.

sub glpClipPlane { glClipPlane_p(@_) }

sub glpGetClipPlane { glGetClipPlane_p(@_) }

sub glpLoadMatrixd { glLoadMatrixd_p(@_) }

sub glpMultMatrixd { glMultMatrixd_p(@_) }

sub glpLoadMatrixf { glLoadMatrixf_p(@_) }

sub glpMultMatrixf { glMultMatrixf_p(@_) }

sub glpMainLoop {
  if (_have_glx()) {
     ## print "Control-D to quit...\n";
     ## while(<>){;} # control-D to quit
    print "Type <Enter> to quit...\n";
    until(<>){;} # control-D to quit
  } else {				# OS/2 PM
    OS2::Process_Messages(0) while 1;  
  }
}

if (_have_glp() && !_have_glx()) { eval <<EOE } # OS2, take into account %ENV?
  sub Button1Mask () {Button1MaskOS2()}
  sub Button2Mask () {Button3MaskOS2()}
  sub Button3Mask () {Button2MaskOS2()}
EOE

sub glpFlush {
  &glFlush;
  glXSwapBuffers() if __had_dbuffer_hack();
}

sub Acme::MITHALDU::BleedingOpenGL::Quad::DESTROY ($) {gluDeleteQuadric(shift)}
@Acme::MITHALDU::BleedingOpenGL::Quad::ISA = 'GLUquadricObjPtr';
sub __new_gluQuad () {bless gluNewQuadric(), 'Acme::MITHALDU::BleedingOpenGL::Quad'}

sub glpSolidSphere ($$$) {
  gluSphere(__new_gluQuad, shift, shift, shift);
}
unless (_have_glut()) {
  *glutSolidSphere = \&glpSolidSphere;
}


sub glpFullScreen
{
  my $params = {};

  $params->{original_x} = glutGet(0x0064);	# GLUT_WINDOW_X
  $params->{original_y} = glutGet(0x0065);	# GLUT_WINDOW_Y
  $params->{original_w} = glutGet(0x0066);	# GLUT_WINDOW_WIDTH
  $params->{original_h} = glutGet(0x0067);	# GLUT_WINDOW_HEIGHT

  glutFullScreen();

  $params->{w} = glutGet(0x0066);		# GLUT_WINDOW_WIDTH
  $params->{h} = glutGet(0x0067);		# GLUT_WINDOW_HEIGHT

  return $params;
}

sub glpRestoreScreen
{
  my($params) = @_;

  glutPositionWindow($params->{original_x},$params->{original_y});
  glutReshapeWindow($params->{original_w},$params->{original_h});
  glutPostRedisplay();
}

sub glpCheckExtension
{
  my(@extensions) = @_;

  # Get/cache OpenGL Version
  if (!$gl_version)
  {
    $gl_version = glGetString(0x1F02); #GL_VERSION
    return 'Unable to retrieve OpenGL version; need context?' if (!$gl_version);
  }
  return "Not a numeric version: '$version'" if ($gl_version !~ m|^(\d+\.\d+)|);
  $gl_version = $1;

  # Get/cache OpenGL Extension Installations
  if (!scalar(%$glext_installed))
  {
    my $inst = glGetString(0x1F03); #GL_EXTENSIONS
    foreach my $ext (split(' ',$inst))
    {
      $glext_installed->{$ext} = $glext_dependencies->{$ext} || 0;
    }
  }
  if (!scalar(%$glext_installed))
  {
    return 'Unable to retrieve extensions; need context?' 
  }

  foreach my $ext (@extensions)
  {
    return "$ext not installed" if (!defined($glext_installed->{$ext}));

    # Check implementation
    my($ver,$deps) = split(';',$glext_installed->{$ext});
    return "$ext not implemented" if (!$ver);
    return "Needs at least OpenGL $ver" if ($gl_version < $ver);
    next if (!$deps);

    # Check dependencies
    foreach my $dep (split(',',$deps))
    {
      my $stat = glpCheckExtension("GL_$dep");
      return "Depends on $deps" if ($stat);
    }
  }
  return 0;
}
use Import::Into;
*OpenGL::import = sub {
   my %known = map { $_ => 1 } qw (OpenGL::Shader::Objects OpenGL::Shader::GLSL OpenGL::Shader::CG OpenGL::Shader::ARB OpenGL::Image::Magick OpenGL::Image::Targa);
   shift;
   my $target = caller;
   die "use Acme::MITHALDU::BleedingOpenGL" if !$known{$target};
   __PACKAGE__->import::into($target, @_);
};
$INC{"OpenGL.pm"} = 1;