Acme-MITHALDU-BleedingOpenGL
view release on metacpan or search on metacpan
my $start = gettimeofday();
for (my $i=0;$i<$loops;$i++)
{
my($blob) = $im->ImageToBlob();
glTexImage2D_s(GL_TEXTURE_2D, 0, GL_RGBA8, $Tex_Width, $Tex_Height,
0, GL_RGBA, GL_UNSIGNED_BYTE, $blob);
}
my $now = gettimeofday();
my $fps = $loops / ($now - $start);
print "ImageToBlob + glTexImage2D_s: $fps\n";
# Bench GetPixels
$start = gettimeofday();
for (my $i=0;$i<$loops;$i++)
{
my @pixels = $im->GetPixels(map=>'BGRA',
width=>$Tex_Width, height=>$Tex_Height, normalize=>'false');
glTexImage2D_p(GL_TEXTURE_2D, 0, $Tex_Type, $Tex_Width, $Tex_Height,
0, $Tex_Format, $Tex_Size, @pixels);
}
$now = gettimeofday();
$fps = $loops / ($now - $start);
print "GetPixels + glTexImage2D_p: $fps\n";
# Bench OpenGL::Image
if ($hasIM_635)
{
my $start = gettimeofday();
for (my $i=0;$i<$loops;$i++)
{
glTexImage2D_c(GL_TEXTURE_2D, 0, $Tex_Type, $Tex_Width, $Tex_Height,
0, $Tex_Format, $Tex_Size, $Tex_Pixels->ptr());
}
my $now = gettimeofday();
my $fps = $loops / ($now - $start);
print "OpenGL::Image + glTexImage2D_c: $fps\n";
}
}
# Build FBO texture
if ($hasFBO)
{
printf("Using FBOs\n");
($FrameBufferID) = glGenFramebuffersEXT_p(1);
($RenderBufferID) = glGenRenderbuffersEXT_p(1);
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";
# Capture window
sub Capture
{
my(%params) = @_;
my($w) = glutGet( GLUT_WINDOW_WIDTH );
my($h) = glutGet( GLUT_WINDOW_HEIGHT );
glPushAttrib( GL_ENABLE_BIT | GL_VIEWPORT_BIT |
GL_TRANSFORM_BIT | GL_COLOR_BUFFER_BIT);
glDisable( GL_LIGHTING );
glDisable( GL_FOG );
glDisable( GL_TEXTURE_2D );
glDisable( GL_DEPTH_TEST );
glDisable( GL_CULL_FACE );
glDisable( GL_STENCIL_TEST );
glViewport( 0, 0, $w, $h );
glMatrixMode( GL_PROJECTION );
glPushMatrix();
glLoadIdentity();
eval { gluOrtho2D( 0, $w, 0, $h ); 1 } or $er++ or warn "Catched: $@";
glMatrixMode( GL_MODELVIEW );
glPushMatrix();
glLoadIdentity();
glPixelZoom( 1, 1 );
# Save
if ($params{Save})
{
Save($w,$h,$params{Save});
}
# Inset
elsif ($params{Inset})
{
Inset($w,$h);
}
glMatrixMode( GL_PROJECTION );
glPopMatrix();
glMatrixMode( GL_MODELVIEW );
glPopMatrix();
glPopAttrib();
}
# Display inset
sub Inset
{
my($w,$h) = @_;
my $Capture_X = int(($w - $Inset_Width) / 2);
my $Capture_Y = int(($h - $Inset_Height) / 2);
my $Inset_X = $w - ($Inset_Width + 2);
my $Inset_Y = $h - ($Inset_Height + 2);
# Using OpenGL::Image and ImageMagick to read/modify/draw pixels
if ($hasIM_635)
{
my $frame = new OpenGL::Image(engine=>'Magick',
width=>$Inset_Width, height=>$Inset_Height);
die $@ if $@;
my($fmt,$size) = $frame->Get('gl_format','gl_type');
glReadPixels_c( $Capture_X, $Capture_Y, $Inset_Width, $Inset_Height,
$fmt, $size, $frame->Ptr() );
# Do this before making native calls
$frame->Sync();
# For grins, use ImageMagick to modify the inset
$frame->Native->Blur(radius=>2,sigma=>2);
# Do this when done making native calls
$frame->SyncOGA();
glRasterPos2f( $Inset_X, $Inset_Y );
glDrawPixels_c( $Inset_Width, $Inset_Height, $fmt, $size, $frame->Ptr() );
}
# Fastest approach
else
{
my $len = $Inset_Width * $Inset_Height * 4;
my $oga = new OpenGL::Array($len,GL_UNSIGNED_BYTE);
glReadPixels_c( $Capture_X, $Capture_Y, $Inset_Width, $Inset_Height,
GL_RGBA, GL_UNSIGNED_BYTE, $oga->ptr() );
glRasterPos2f( $Inset_X, $Inset_Y );
glDrawPixels_c( $Inset_Width, $Inset_Height, GL_RGBA, GL_UNSIGNED_BYTE, $oga->ptr() );
}
}
# Capture/save window
sub Save
{
my($w,$h,$file) = @_;
if ($hasImage)
{
my $frame = new OpenGL::Image(width=>$w, height=>$h);
my($fmt,$size) = $frame->Get('gl_format','gl_type');
glReadPixels_c( 0, 0, $w, $h, $fmt, $size, $frame->Ptr() );
$frame->Save($file);
}
else
{
print "Need OpenGL::Image and ImageMagick 6.3.5 or newer for file capture!\n";
}
}
# Cleanup routine
sub ourCleanup
{
print "Starting cleanup ...\n";
# Disable app
glutHideWindow();
glutKeyboardUpFunc();
glutKeyboardFunc();
glutSpecialUpFunc();
glutSpecialFunc();
glutIdleFunc();
glutReshapeFunc();
ReleaseResources();
# Now you can destroy window
if (defined($gameMode))
{
print "Leaving game mode.\n";
glutLeaveGameMode();
}
else
{
print "Destroying window.\n";
glutDestroyWindow($Window_ID);
}
undef($Window_ID);
print "Cleanup completed.\n";
}
sub ReleaseResources
{
return if (!defined($Window_ID));
if ($hasFBO)
{
# Release resources
glBindRenderbufferEXT( GL_RENDERBUFFER_EXT, 0 );
glBindFramebufferEXT( GL_FRAMEBUFFER_EXT, 0 );
glDeleteRenderbuffersEXT_p( $RenderBufferID ) if ($RenderBufferID);
glDeleteFramebuffersEXT_p( $FrameBufferID ) if ($FrameBufferID);
}
if ($Shader)
{
undef($Shader);
}
elsif ($hasFragProg)
{
glBindProgramARB(GL_VERTEX_PROGRAM_ARB, 0);
glDeleteProgramsARB_p( $VertexProgID ) if ($VertexProgID);
if (not glutGet(GLUT_DISPLAY_MODE_POSSIBLE))
{
warn "glutInitDisplayMode(GLUT_RGBA | GLUT_DOUBLE | GLUT_DEPTH | GLUT_ALPHA) not possible";
warn "...trying without GLUT_ALPHA";
# try without GLUT_ALPHA
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";
( run in 0.610 second using v1.01-cache-2.11-cpan-df04353d9ac )