view release on metacpan or  search on metacpan

test.pl  view on Meta::CPAN

    glBindFramebufferEXT(GL_FRAMEBUFFER_EXT, $FrameBufferID);
    glBindTexture(GL_TEXTURE_2D, $TextureID_FBO);

    # Initiate texture
    glTexImage2D_c(GL_TEXTURE_2D, 0, $Tex_Type, $Tex_Width, $Tex_Height,
      0, $Tex_Format, $Tex_Size, 0);
    glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);
    glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);

    # Bind texture/frame/render buffers
    glFramebufferTexture2DEXT(GL_FRAMEBUFFER_EXT, GL_COLOR_ATTACHMENT0_EXT,
      GL_TEXTURE_2D, $TextureID_FBO, 0);
    glBindRenderbufferEXT(GL_RENDERBUFFER_EXT, $RenderBufferID);
    glRenderbufferStorageEXT(GL_RENDERBUFFER_EXT, GL_DEPTH_COMPONENT24_ARB,
      $Tex_Width, $Tex_Height);
    glFramebufferRenderbufferEXT(GL_FRAMEBUFFER_EXT, GL_DEPTH_ATTACHMENT_EXT,
      GL_RENDERBUFFER_EXT, $RenderBufferID);

    # Test status
    if (DO_TESTS)
    {
      my $stat = glCheckFramebufferStatusEXT(GL_RENDERBUFFER_EXT);
      printf("FBO Status: %04X\n",$stat);
    }
  }

  # Select active texture
  ourSelectTexture();

  glTexEnvf(GL_TEXTURE_ENV,GL_TEXTURE_ENV_MODE,GL_DECAL);
}

sub ourSelectTexture
{
    glBindTexture(GL_TEXTURE_2D, $FBO_On ? $TextureID_FBO : $TextureID_image);
}

sub ourInitShaders
{
  # Setup Vertex/Fragment Programs to render FBO texture

  if ($hasShader)
  {
    my $version = $OpenGL::Shader::VERSION;
    printf("Using OpenGL::Shader v$version\n");
    my $types = OpenGL::Shader->GetTypes();
    my @types = keys(%$types);
    printf("This installation supports the following shader types: %s\n", join(',', @types));

    # Use OpenGL::Shader
    $Shader = new OpenGL::Shader();
    if (!$Shader)
    {
      printf("Unable to instantiate OpenGL::Shader\n");
      return;
    }

    my $type = $Shader->GetType();
    my $ext = lc($type);

    my $stat = $Shader->LoadFiles("fragment.$ext","vertex.$ext");
    if (!$stat)
    {
      my $ver = $Shader->GetVersion();
      print "Using OpenGL::Shader('$type') v$ver\n";
      return;
    }
    else
    {
      print "$stat\n";
    }
  }
  # Fall back to doing it manually
  elsif ($hasFragProg)
  {
    printf("Using native OpenGL ARB Shader functions\n");
    ($VertexProgID,$FragProgID) = glGenProgramsARB_p(2);

    # NOP Vertex shader
    my $VertexProg = qq
    {!!ARBvp1.0
      PARAM center = program.local[0];
      PARAM xform[4] = {program.local[1..4]};
      TEMP vertexClip;

      # ModelView projection
      DP4 vertexClip.x, state.matrix.mvp.row[0], vertex.position;
      DP4 vertexClip.y, state.matrix.mvp.row[1], vertex.position;
      DP4 vertexClip.z, state.matrix.mvp.row[2], vertex.position;
      DP4 vertexClip.w, state.matrix.mvp.row[3], vertex.position;

      # Additional transform, via matrix variable
      DP4 vertexClip.x, vertexClip, xform[0];
      DP4 vertexClip.y, vertexClip, xform[1];
      DP4 vertexClip.z, vertexClip, xform[2];
      DP4 vertexClip.w, vertexClip, xform[3];

      #SUB result.position, vertexClip, center;
      MOV result.position, vertexClip;

      # Pass through color
      MOV result.color, vertex.color;

      # Pass through texcoords
      SUB result.texcoord[0], vertex.texcoord, center;
      END
    };

    glBindProgramARB(GL_VERTEX_PROGRAM_ARB, $VertexProgID);
    glProgramStringARB_p(GL_VERTEX_PROGRAM_ARB, $VertexProg);

    if (DO_TESTS)
    {
      my $format = glGetProgramivARB_p(GL_VERTEX_PROGRAM_ARB,
        GL_PROGRAM_FORMAT_ARB);
      printf("glGetProgramivARB_p format: '#%04X'\n",$format);

      my @params = glGetProgramEnvParameterdvARB_p(GL_VERTEX_PROGRAM_ARB,0);
      my $params = join(', ',@params);
      print "glGetProgramEnvParameterdvARB_p: $params\n";

      @params = glGetProgramEnvParameterfvARB_p(GL_VERTEX_PROGRAM_ARB,0);
      $params = join(', ',@params);
      print "glGetProgramEnvParameterfvARB_p: $params\n";

      my $vprog = glGetProgramStringARB_p(GL_VERTEX_PROGRAM_ARB);
      print "Vertex Prog: $vprog\n";
    }

    # Lazy Metalic Fragment shader
    my $FragProg = qq
    {!!ARBfp1.0
      PARAM surfacecolor = program.local[5];
      TEMP color;
      MUL color, fragment.texcoord[0].y, 2.0;
      ADD color, 1.0, -color;
      ABS color, color;
      ADD color, 1.01, -color;  #Some cards have a rounding error
      MOV color.a, 1.0;
      MUL color, color, surfacecolor;
      MOV result.color, color;
      END
    };

    glBindProgramARB(GL_FRAGMENT_PROGRAM_ARB, $FragProgID);
    glProgramStringARB_p(GL_FRAGMENT_PROGRAM_ARB, $FragProg);

    if (DO_TESTS)
    {
      my $fprog = glGetProgramStringARB_p(GL_FRAGMENT_PROGRAM_ARB);
      print "Fragment Prog: $fprog\n";
    }
  }
}


# ------
# Routine which actually does the drawing

sub cbRenderScene
{
  # Quit if inactive
  my $time = $hasHires ? gettimeofday() : time();
  my $time_to_exit = $idleSecsMax - ($time-$idleTime);
  if ($time_to_exit <= 0 )
  {
    print "Idle timeout; completing test\n";
    ourCleanup();
    return quit("render callback");
  }

  my $buf; # For our strings.

  # Animated Texture Rendering
  if ($FBO_On && ($FBO_On == 2 || !$FBO_rendered))
  {
    $FBO_rendered = 1;
    glBindFramebufferEXT(GL_FRAMEBUFFER_EXT, $FrameBufferID);
    glPushMatrix();
    glTranslatef(-0.35, -0.48, -1.5);
    glRotatef($Teapot_Rot--, 0.0, 1.0, 0.0);
    glClearColor(0, 0, 0, 0);
    glClear(GL_COLOR_BUFFER_BIT | GL_DEPTH_BUFFER_BIT);

    glPushAttrib(GL_ENABLE_BIT);
    glEnable(GL_DEPTH_TEST);

    # Run shader programs for texture.
    # If installed, use OpenGL::Shader
    if ($Shader)
    {
      $Shader->Enable();
      $Shader->SetVector('center',0.0,0.0,2.0,0.0);
      $Shader->SetMatrix('xform',$xform);
      $Shader->SetVector('surfacecolor',1.0,0.5,0.0,1.0);

test.pl  view on Meta::CPAN

      glutInitDisplayMode(GLUT_RGBA | GLUT_DOUBLE | GLUT_DEPTH);
      if (not glutGet(GLUT_DISPLAY_MODE_POSSIBLE))
      {
         warn "glutInitDisplayMode(GLUT_RGBA | GLUT_DOUBLE | GLUT_DEPTH) not possible, exiting quietly";
         exit 0;
      }
   }

}

#glutInitDisplayString("rgb alpha>=0 double depth");

# Open Window
if (defined($gameMode) && glutGameModeString($gameMode))
{
  print "Running in Game Mode $gameMode\n";
  glutGameModeString($gameMode);
  $Window_ID = glutEnterGameMode();
  $Window_Width = glutGameModeGet( GLUT_GAME_MODE_WIDTH );
  $Window_Height = glutGameModeGet( GLUT_GAME_MODE_HEIGHT );
}
else
{
  glutInitWindowSize($Window_Width, $Window_Height);
  $Window_ID = glutCreateWindow( PROGRAM_TITLE );
}

# Get OpenGL Info
print "\n";
print PROGRAM_TITLE;
print ' (using hires timer)' if ($hasHires);
print "\n\n";
my $version = glGetString(GL_VERSION);
my $vendor = glGetString(GL_VENDOR);
my $renderer = glGetString(GL_RENDERER);
print "Using POGL v$Acme::MITHALDU::BleedingOpenGL::BUILD_VERSION\n";
print "OpenGL installation: $version\n$vendor\n$renderer\n\n";

print "Installed extensions (* implemented in the module):\n";
my $extensions = glGetString(GL_EXTENSIONS);
my @extensions = split(' ',$extensions);
foreach my $ext (sort @extensions)
{
  my $stat = glpCheckExtension($ext);
  printf("%s $ext\n",$stat?' ':'*');
  print("    $stat\n") if ($stat && $stat !~ m|^$ext |);
}

if (!Acme::MITHALDU::BleedingOpenGL::glpCheckExtension('GL_ARB_vertex_buffer_object'))
{
  #$hasVBO = 1;
  # Perl 5.10 crashes on VBOs!
  $hasVBO = ($PERL_VERSION !~ m|^5\.10\.|);
}

if (!Acme::MITHALDU::BleedingOpenGL::glpCheckExtension('GL_EXT_framebuffer_object'))
{
  $hasFBO = 1;
  $FBO_On = 1;

  if (!Acme::MITHALDU::BleedingOpenGL::glpCheckExtension('GL_ARB_fragment_program'))
  {
    $hasFragProg = 1;
    $FBO_On++;
  }
}


# Register the callback function to do the drawing.
glutDisplayFunc(\&cbRenderScene);

# If there's nothing to do, draw.
glutIdleFunc(\&cbRenderScene);

# It's a good idea to know when our window's resized.
glutReshapeFunc(\&cbResizeScene);
#glutWindowStatusFunc(\&cbWindowStat);

# And let's get some keyboard input.
glutKeyboardFunc(\&cbKeyPressed);
glutSpecialFunc(\&cbSpecialKeyPressed);
glutKeyboardUpFunc(\&cbKeyUp);
glutSpecialUpFunc(\&cbSpecialKeyUp);

# Mouse handlers.
glutMouseFunc(\&cbMouseClick);
#glutMotionFunc(\&cbMouseDrag);
#glutPassiveMotionFunc(\&cbMouseTrack);

# Handle window close events.
glutCloseFunc(\&cbClose) if Acme::MITHALDU::BleedingOpenGL::_have_freeglut();

# OK, OpenGL's ready to go.  Let's call our own init function.
ourInit($Window_Width, $Window_Height);


# Print out a bit of help dialog.
print qq
{
Hold down arrow keys to rotate, 'r' to reverse, 's' to stop.
Page up/down will move cube away from/towards camera.
Use first letter of shown display mode settings to alter.
Press 'g' to toggle fullscreen mode (not supported on all platforms).
Press 'c' to capture/save a RGBA targa file.
'q' or [Esc] to quit; OpenGL window must have focus for input.

};

# Pass off control to OpenGL.
# Above functions are called as appropriate.
if (Acme::MITHALDU::BleedingOpenGL::_have_freeglut()) {
   print "Setting window close to trigger return from mainloop (freeglut).\n";
   glutSetOption(GLUT_ACTION_ON_WINDOW_CLOSE,GLUT_ACTION_GLUTMAINLOOP_RETURNS)
}

print "Entering glutMainLoop\n";
glutMainLoop();
print "Returned from glutMainLoop\n";

print "Exiting in main thread\n";