view release on metacpan or  search on metacpan

BleedingOpenGL.pm  view on Meta::CPAN

);


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?'