#!/usr/bin/perl -w use strict; my $stat = `perl -v`; our $IS_ACTIVEPERL = ($stat =~ m|ActiveState|s); our $PERL_VERSION = $^V; $PERL_VERSION =~ s|^v||; use OpenGL qw/ :all /; use OpenGL::Config; # for build information eval 'use OpenGL::Image 1.03'; # Need to use OpenGL::Image 1.03 or higher! my $hasImage = !$@; my $hasIM_635 = $hasImage && OpenGL::Image::HasEngine('Magick','6.3.5'); eval 'use OpenGL::Shader'; my $hasShader = !$@; eval 'use Image::Magick'; my $hasIM = !$@; # This does not seem to be needed and it adds an extra, unneeded # dependency to the build process. Leaving this in as a comment # just in case it is being used somewhere here # # use Math::Trig; eval 'use Time::HiRes qw( gettimeofday )'; my $hasHires = !$@; $|++; # ---------------------- # Based on a cube demo by # Chris Halsall ([email protected]) for the # O'Reilly Network on Linux.com (oreilly.linux.com). # May 2000. # # Translated from C to Perl by J-L Morel# ( http://www.bribes.org/perl/wopengl.html ) # # Updated for FBO, VBO, Vertex/Fragment Program extensions # and ImageMagick support # by Bob "grafman" Free # ( http://graphcomp.com/opengl ) # # Requires GLUT/FreeGLUT if (!glpHasGLUT()) { print qq { This test requires GLUT: If you have X installed, you can try the scripts in ./examples/ Most of them do not use GLUT. It is recommended that you install FreeGLUT for improved Makefile.PL configuration, installation and debugging. }; print "Attempting to run examples/texhack instead...\n"; `perl examples/texhack`; exit 0; } use constant PROGRAM_TITLE => "OpenGL Test App"; use constant DO_TESTS => 0; # Run in Game Mode my $gameMode; if (scalar(@ARGV) and lc($ARGV[0]) eq 'gamemode') { $gameMode = $ARGV[1] || ''; } # Keyboard modifiers my $key_mods = { eval(GLUT_ACTIVE_SHIFT) => "SHIFT", eval(GLUT_ACTIVE_CTRL) => "CTRL", eval(GLUT_ACTIVE_ALT) => "ALT" }; # Some global variables. my $useMipMap = 1; my $hasFBO = 0; my $hasVBO = 0; my $hasFragProg = 0; my $hasImagePointer = 0; my $idleTime = time(); my $idleSecsMax = 30; my $er; # Window and texture IDs, window width and height. my $Window_ID; my $Window_Width = 300; my $Window_Height = 300; my $Inset_Width = 90; my $Inset_Height = 90; my $Window_State; # Texture dimanesions #my $Tex_File = 'test.jpg'; my $Tex_File = 'test.tga'; my $Tex_Width = 128; my $Tex_Height = 128; my $Tex_Format; my $Tex_Type; my $Tex_Size; my $Tex_Image; my $Tex_Pixels; # Our display mode settings. my $Light_On = 0; my $Blend_On = 0; my $Texture_On = 1; my $Alpha_Add = 1; my $FBO_On = 0; my $Inset_On = 1; my $Fullscreen_On = 0; my $Curr_TexMode = 0; my @TexModesStr = qw/ GL_DECAL GL_MODULATE GL_BLEND GL_REPLACE /; my @TexModes = ( GL_DECAL, GL_MODULATE, GL_BLEND, GL_REPLACE ); my($TextureID_image,$TextureID_FBO); my $FrameBufferID; my $RenderBufferID; my $VertexProgID; my $FragProgID; my $FBO_rendered = 0; my $Shader; # Object and scene global variables. my $Teapot_Rot = 0.0; # Cube position and rotation speed variables. my $X_Rot = 0.9; my $Y_Rot = 0.0; my $X_Speed = 0.0; my $Y_Speed = 0.5; my $Z_Off =-5.0; # Settings for our light. Try playing with these (or add more lights). my @Light_Ambient = ( 0.1, 0.1, 0.1, 1.0 ); my @Light_Diffuse = ( 1.2, 1.2, 1.2, 1.0 ); my @Light_Position = ( 2.0, 2.0, 0.0, 1.0 ); # Model/Projection/Viewport Matrices my $mm = OpenGL::Array->new(16,GL_DOUBLE); my $pm = OpenGL::Array->new(16,GL_DOUBLE); my $vp = OpenGL::Array->new(4,GL_INT); # Vertex Buffer Object data my($VertexObjID,$NormalObjID,$ColorObjID,$TexCoordObjID,$IndexObjID); my @verts = ( -1.0, -1.3, -1.0, 1.0, -1.3, -1.0, 1.0, -1.3, 1.0, -1.0, -1.3, 1.0, -1.0, 1.3, -1.0, -1.0, 1.3, 1.0, 1.0, 1.3, 1.0, 1.0, 1.3, -1.0, -1.0, -1.0, -1.3, -1.0, 1.0, -1.3, 1.0, 1.0, -1.3, 1.0, -1.0, -1.3, 1.3, -1.0, -1.0, 1.3, 1.0, -1.0, 1.3, 1.0, 1.0, 1.3, -1.0, 1.0, -1.0, -1.0, 1.3, 1.0, -1.0, 1.3, 1.0, 1.0, 1.3, -1.0, 1.0, 1.3, -1.3, -1.0, -1.0, -1.3, -1.0, 1.0, -1.3, 1.0, 1.0, -1.3, 1.0, -1.0 ); my $verts = OpenGL::Array->new_list(GL_FLOAT,@verts); # Could calc norms on the fly my @norms = ( 0.0, -1.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.0,-1.0, 1.0, 0.0, 0.0, 0.0, 0.0, 1.0, -1.0, 0.0, 0.0 ); my $norms = OpenGL::Array->new_list(GL_FLOAT,@norms); my @colors = ( 0.9,0.2,0.2,.75, 0.9,0.2,0.2,.75, 0.9,0.2,0.2,.75, 0.9,0.2,0.2,.75, 0.5,0.5,0.5,.5, 0.5,0.5,0.5,.5, 0.5,0.5,0.5,.5, 0.5,0.5,0.5,.5, 0.2,0.9,0.2,.5, 0.2,0.9,0.2,.5, 0.2,0.9,0.2,.5, 0.2,0.9,0.2,.5, 0.2,0.2,0.9,.25, 0.2,0.2,0.9,.25, 0.2,0.2,0.9,.25, 0.2,0.2,0.9,.25, 0.9, 0.2, 0.2, 0.5, 0.2, 0.9, 0.2, 0.5, 0.2, 0.2, 0.9, 0.5, 0.1, 0.1, 0.1, 0.5, 0.9,0.9,0.2,0.0, 0.9,0.9,0.2,0.66, 0.9,0.9,0.2,1.0, 0.9,0.9,0.2,0.33 ); my $colors = OpenGL::Array->new_list(GL_FLOAT,@colors); my @rainbow = ( 0.9, 0.2, 0.2, 0.5, 0.2, 0.9, 0.2, 0.5, 0.2, 0.2, 0.9, 0.5, 0.1, 0.1, 0.1, 0.5 ); my $rainbow = OpenGL::Array->new_list(GL_FLOAT,@rainbow); my $rainbow_offset = 64; my @rainbow_inc; my @texcoords = ( 0.800, 0.800, 0.200, 0.800, 0.200, 0.200, 0.800, 0.200, 0.005, 1.995, 0.005, 0.005, 1.995, 0.005, 1.995, 1.995, 0.995, 0.005, 2.995, 2.995, 0.005, 0.995, -1.995, -1.995, 0.995, 0.005, 0.995, 0.995, 0.005, 0.995, 0.005, 0.005, -0.5, -0.5, 1.5, -0.5, 1.5, 1.5, -0.5, 1.5, 0.005, 0.005, 0.995, 0.005, 0.995, 0.995, 0.005, 0.995 ); my $texcoords = OpenGL::Array->new_list(GL_FLOAT,@texcoords); my @indices = (0..23); my $indices = OpenGL::Array->new_list(GL_UNSIGNED_INT,@indices); my @xform = ( 1.0, 0.0, 0.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 0.0, 1.0 ); my $xform = OpenGL::Array->new_list(GL_FLOAT,@xform); # ------ # Frames per second (FPS) statistic variables and routine. use constant CLOCKS_PER_SEC => $hasHires ? 1000 : 1; use constant FRAME_RATE_SAMPLES => 50; my $FrameCount = 0; my $FrameRate = 0; my $last=0; sub ourDoFPS { if (++$FrameCount >= FRAME_RATE_SAMPLES) { my $now = $hasHires ? gettimeofday() : time(); # clock(); my $delta= ($now - $last); $last = $now; $FrameRate = FRAME_RATE_SAMPLES / ($delta || 1); $FrameCount = 0; } } # ------ # String rendering routine; leverages on GLUT routine. sub ourPrintString { my ($font, $str) = @_; my @c = split '', $str; for(@c) { glutBitmapCharacter($font, ord $_); } } # ------ # Does everything needed before losing control to the main # OpenGL event loop. sub ourInit { my ($Width, $Height) = @_; # Set initial colors for rainbow face for (my $i=0; $i<16; $i++) { $rainbow[$i] = rand(1.0); $rainbow_inc[$i] = 0.01 - rand(0.02); } # Initialize VBOs if supported if ($hasVBO) { ($VertexObjID,$NormalObjID,$ColorObjID,$TexCoordObjID,$IndexObjID) = glGenBuffersARB_p(5); #glBindBufferARB(GL_ARRAY_BUFFER_ARB, $VertexObjID); $verts->bind($VertexObjID); glBufferDataARB_p(GL_ARRAY_BUFFER_ARB, $verts, GL_STATIC_DRAW_ARB); glVertexPointer_c(3, GL_FLOAT, 0, 0); if (DO_TESTS) { print "\nTests:\n"; my $size = glGetBufferParameterivARB_p(GL_ARRAY_BUFFER_ARB, GL_BUFFER_SIZE_ARB); print " Vertex Buffer Size (bytes): $size\n"; my $count = $verts->elements(); print " Vertex Buffer Size (elements): $count\n"; my $test = glGetBufferSubDataARB_p(GL_ARRAY_BUFFER_ARB,12,3,GL_FLOAT); my @test = $test->retrieve(0,3); my $ords = join('/',@test); print " glGetBufferSubDataARB_p: $ords\n"; } #glBindBufferARB(GL_ARRAY_BUFFER_ARB, $NormalObjID); $norms->bind($NormalObjID); glBufferDataARB_p(GL_ARRAY_BUFFER_ARB, $norms, GL_STATIC_DRAW_ARB); glNormalPointer_c(GL_FLOAT, 0, 0); #glBindBufferARB(GL_ARRAY_BUFFER_ARB, $ColorObjID); $colors->bind($ColorObjID); glBufferDataARB_p(GL_ARRAY_BUFFER_ARB, $colors, GL_DYNAMIC_DRAW_ARB); $rainbow->assign(0,@rainbow); glBufferSubDataARB_p(GL_ARRAY_BUFFER_ARB, $rainbow_offset, $rainbow); glColorPointer_c(4, GL_FLOAT, 0, 0); #glBindBufferARB(GL_ARRAY_BUFFER_ARB, $TexCoordObjID); $texcoords->bind($TexCoordObjID); glBufferDataARB_p(GL_ARRAY_BUFFER_ARB, $texcoords, GL_STATIC_DRAW_ARB); glTexCoordPointer_c(2, GL_FLOAT, 0, 0); #glBindBufferARB(GL_ELEMENT_ARRAY_BUFFER_ARB, $IndexObjID); $indices->bind($IndexObjID); glBufferDataARB_p(GL_ELEMENT_ARRAY_BUFFER_ARB, $indices, GL_STATIC_DRAW_ARB); } else { glVertexPointer_p(3, $verts); glNormalPointer_p($norms); $colors->assign($rainbow_offset,@rainbow); glColorPointer_p(4, $colors); glTexCoordPointer_p(2, $texcoords); } # Build texture. ($TextureID_image,$TextureID_FBO) = glGenTextures_p(2); ourBuildTextures(); glTexEnvf(GL_TEXTURE_ENV,GL_TEXTURE_ENV_MODE,GL_DECAL); # Initialize shaders. ourInitShaders(); # Initialize rendering parameters glEnable(GL_TEXTURE_2D); glDisable(GL_LIGHTING); glBlendFunc(GL_SRC_ALPHA,GL_ONE); #glEnable(GL_BLEND); # Color to clear color buffer to. glClearColor(0.1, 0.1, 0.1, 0.0); # Depth to clear depth buffer to; type of test. glClearDepth(1.0); glDepthFunc(GL_LESS); # Enables Smooth Color Shading; try GL_FLAT for (lack of) fun. glShadeModel(GL_SMOOTH); # Load up the correct perspective matrix; using a callback directly. cbResizeScene($Width, $Height); # Set up a light, turn it on. glLightfv_p(GL_LIGHT1, GL_POSITION, @Light_Position); glLightfv_p(GL_LIGHT1, GL_AMBIENT, @Light_Ambient); glLightfv_p(GL_LIGHT1, GL_DIFFUSE, @Light_Diffuse); glEnable(GL_LIGHT1); # A handy trick -- have surface material mirror the color. glColorMaterial(GL_FRONT_AND_BACK,GL_AMBIENT_AND_DIFFUSE); glEnable(GL_COLOR_MATERIAL); } # ------ # Function to build a simple full-color texture with alpha channel, # and then create mipmaps. # Also sets up FBO texture and Vertex/Fragment programs. sub ourBuildTextures { my $gluerr; my $tex; # Build Image Texture ($TextureID_image,$TextureID_FBO) = glGenTextures_p(2); print "\n"; # Use OpenGL::Image to load texture if ($hasImage && -e $Tex_File) { my $img = new OpenGL::Image(source=>$Tex_File); my($eng,$ver) = $img->Get('engine','version'); print "Using OpenGL::Image - $eng v$ver\n"; ($Tex_Width,$Tex_Height) = $img->Get('width','height'); my $alpha = $img->Get('alpha') ? 'has' : 'no'; print "Loading texture: $Tex_File, $Tex_Width x $Tex_Height, $alpha alpha\n"; ($Tex_Type,$Tex_Format,$Tex_Size) = $img->Get('gl_internalformat','gl_format','gl_type'); # Use OGA for testing $Tex_Image = $img; $Tex_Pixels = $img->GetArray(); print "Using ImageMagick's gaussian blur on inset\n" if ($hasIM_635); } # Build texture from scratch if OpenGL::Image not available else { my $hole_size = 3300; # ~ == 57.45 ^ 2. # Iterate across the texture array. for(my $y=0; $y<$Tex_Height; $y++) { for(my $x=0; $x<$Tex_Width; $x++) { # A simple repeating squares pattern. # Dark blue on white. if ( ( ($x+4)%32 < 8 ) && ( ($y+4)%32 < 8)) { $tex .= pack "C3", 0,0,120; # Dark blue } else { $tex .= pack "C3", 240, 240, 240; # White } # Make a round dot in the texture's alpha-channel. # Calculate distance to center (squared). my $t = ($x-64)*($x-64) + ($y-64)*($y-64); if ( $t < $hole_size) { $tex .= pack "C", 255; # The dot itself is opaque. } elsif ($t < $hole_size + 100) { $tex .= pack "C", 128; # Give our dot an anti-aliased edge. } else { $tex .= pack "C", 0; # Outside of the dot, it's transparent. } } } $Tex_Pixels = OpenGL::Array->new_scalar(GL_UNSIGNED_BYTE,$tex,length($tex)); $Tex_Type = GL_RGBA8; $Tex_Format = GL_RGBA; $Tex_Size = GL_UNSIGNED_BYTE; } glBindTexture(GL_TEXTURE_2D, $TextureID_image); # Use MipMap if ($useMipMap) { print "Using Mipmap\n"; glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_NEAREST_MIPMAP_LINEAR); glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_NEAREST_MIPMAP_LINEAR); # The GLU library helps us build MipMaps for our texture. if (($gluerr = gluBuild2DMipmaps_c(GL_TEXTURE_2D, $Tex_Type, $Tex_Width, $Tex_Height, $Tex_Format, $Tex_Size, $Tex_Pixels->ptr()))) { printf STDERR "GLULib%s\n", gluErrorString($gluerr); exit(-1); } } # Use normal texture - Note: dimensions must be power of 2 else { glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR); glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); glTexImage2D_c(GL_TEXTURE_2D, 0, $Tex_Type, $Tex_Width, $Tex_Height, 0, $Tex_Format, $Tex_Size, $Tex_Pixels->ptr()); } # Benchmarks for Image Loading if (DO_TESTS && $hasIM) { my $loops = 1000; my $im = new Image::Magick(); $im->Read($Tex_File); $im->Set(magick=>'RGBA',depth=>8); $im->Negate(channel=>'alpha'); # Bench ImageToBlob 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) { ($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, $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 # Use OpenGL::Shader if ($hasShader && ($Shader = new OpenGL::Shader())) { 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 if ($hasFragProg) { ($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 if ($idleSecsMax < (time()-$idleTime)) { print "Idle timeout; completing test\n"; ourCleanup(); exit(0); } 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); } # Otherwise, do it manually elsif ($hasFragProg) { glEnable(GL_VERTEX_PROGRAM_ARB); glEnable(GL_FRAGMENT_PROGRAM_ARB); glProgramLocalParameter4fARB(GL_VERTEX_PROGRAM_ARB, 0, 0.0,0.0,2.0,0.0); glProgramLocalParameter4fvARB_c(GL_VERTEX_PROGRAM_ARB, 1, $xform->offset(0)); glProgramLocalParameter4fvARB_c(GL_VERTEX_PROGRAM_ARB, 2, $xform->offset(4)); glProgramLocalParameter4fvARB_c(GL_VERTEX_PROGRAM_ARB, 3, $xform->offset(8)); glProgramLocalParameter4fvARB_c(GL_VERTEX_PROGRAM_ARB, 4, $xform->offset(12)); glProgramLocalParameter4fARB(GL_FRAGMENT_PROGRAM_ARB, 5, 1.0,0.5,0.0,1.0); } glColor3f(1.0, 1.0, 1.0); #glutSolidTeapot(0.125); glutWireTeapot(0.125); glBindFramebufferEXT(GL_FRAMEBUFFER_EXT, 0); if ($Shader) { $Shader->Disable(); } elsif ($hasFragProg) { glDisable(GL_FRAGMENT_PROGRAM_ARB); glDisable(GL_VERTEX_PROGRAM_ARB); } glPopAttrib(); glPopMatrix(); } ourSelectTexture(); # Enables, disables or otherwise adjusts as # appropriate for our current settings. if ($Texture_On) { glEnable(GL_TEXTURE_2D); } else { glDisable(GL_TEXTURE_2D); } if ($Light_On) { glEnable(GL_LIGHTING); } else { glDisable(GL_LIGHTING); } if ($Alpha_Add) { glBlendFunc(GL_SRC_ALPHA,GL_ONE); } else { glBlendFunc(GL_SRC_ALPHA,GL_ONE_MINUS_SRC_ALPHA); } # If we're blending, we don'$t want z-buffering. if ($Blend_On) { glDisable(GL_DEPTH_TEST); } else { glEnable(GL_DEPTH_TEST); } # Need to manipulate the ModelView matrix to move our model around. glMatrixMode(GL_MODELVIEW); # Reset to 0,0,0; no rotation, no scaling. glLoadIdentity(); # Move the object back from the screen. glTranslatef(0.0,0.0,$Z_Off); # Rotate the calculated amount. glRotatef($X_Rot,1.0,0.0,0.0); glRotatef($Y_Rot,0.0,1.0,0.0); # Clear the color and depth buffers. glClear(GL_COLOR_BUFFER_BIT | GL_DEPTH_BUFFER_BIT); # Update Rainbow Cube Face for (my $i=0; $i 1) { $rainbow[$i] = 1.0; } else { next; } $rainbow_inc[$i] = -$rainbow_inc[$i]; } if ($hasVBO) { glBindBufferARB(GL_ARRAY_BUFFER_ARB, $ColorObjID); my $color_map = glMapBufferARB_p(GL_ARRAY_BUFFER_ARB, GL_WRITE_ONLY_ARB,GL_FLOAT); my $buffer = glGetBufferPointervARB_p(GL_ARRAY_BUFFER_ARB, GL_BUFFER_MAP_POINTER_ARB,GL_FLOAT); $color_map->assign($rainbow_offset,@rainbow); glUnmapBufferARB(GL_ARRAY_BUFFER_ARB); } else { $colors->assign($rainbow_offset,@rainbow); glColorPointer_p(4, $colors); } # Render cube glEnableClientState(GL_VERTEX_ARRAY); glEnableClientState(GL_NORMAL_ARRAY); glEnableClientState(GL_COLOR_ARRAY); glEnableClientState(GL_TEXTURE_COORD_ARRAY); for (my $i=0; $i 1) if ($Inset_On); # All done drawing. Let's show it. glutSwapBuffers(); # Now let's do the motion calculations. $X_Rot+=$X_Speed; $Y_Rot+=$Y_Speed; # And collect our statistics. ourDoFPS(); } # 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); 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 { # Disable app glutHideWindow(); glutKeyboardUpFunc(); glutKeyboardFunc(); glutSpecialUpFunc(); glutSpecialFunc(); glutIdleFunc(); glutReshapeFunc(); ReleaseResources(); # Now you can destroy window if (defined($gameMode)) { glutLeaveGameMode(); } else { glutDestroyWindow($Window_ID); } undef($Window_ID); } 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); glBindProgramARB(GL_FRAGMENT_PROGRAM_ARB, 0); glDeleteProgramsARB_p( $FragProgID ) if ($FragProgID); } if ($hasVBO) { glBindBufferARB(GL_ARRAY_BUFFER_ARB, 0); glDeleteBuffersARB_p($VertexObjID) if ($VertexObjID); glDeleteBuffersARB_p($NormalObjID) if ($NormalObjID); glDeleteBuffersARB_p($ColorObjID) if ($ColorObjID); glDeleteBuffersARB_p($TexCoordObjID) if ($TexCoordObjID); glBindBufferARB(GL_ELEMENT_ARRAY_BUFFER_ARB, 0); glDeleteBuffersARB_p($IndexObjID) if ($IndexObjID); } glDeleteTextures_p($TextureID_image,$TextureID_FBO); } # ------ # Callback function called when a normal $key is pressed. sub cbKeyPressed { my $key = shift; my $c = uc chr $key; if ($key == 27 or $c eq 'Q') { ourCleanup(); exit(0); } elsif ($c eq 'B') { $Blend_On = !$Blend_On; if (!$Blend_On) { glDisable(GL_BLEND); } else { glEnable(GL_BLEND); } } elsif ($c eq 'K') { # ignore keypress if not FreeGLUT glutLeaveMainLoop() if OpenGL::_have_freeglut(); } elsif ($c eq 'L') { $Light_On = !$Light_On; } elsif ($c eq 'M') { if ( ++ $Curr_TexMode > 3 ) { $Curr_TexMode=0; } glTexEnvi(GL_TEXTURE_ENV,GL_TEXTURE_ENV_MODE,$TexModes[$Curr_TexMode]); } elsif ($c eq 'T') { $Texture_On = !$Texture_On; } elsif ($c eq 'A') { $Alpha_Add = !$Alpha_Add; } elsif ($c eq 'F' && $hasFBO) { $FBO_On = ($FBO_On+1) % 3; ourSelectTexture(); } elsif ($c eq 'I') { $Inset_On = !$Inset_On; } elsif ($c eq 'S' or $key == 32) { $X_Speed=$Y_Speed=0; } elsif ($c eq 'R') { $X_Speed = -$X_Speed; $Y_Speed = -$Y_Speed; } elsif ($c eq 'G') { $Fullscreen_On = !$Fullscreen_On; if ($Fullscreen_On) { $Window_State = glpFullScreen(); $Window_Width = $Window_State->{w}; $Window_Height = $Window_State->{h}; } else { glpRestoreScreen($Window_State); } } elsif ($c eq 'C' && $hasImage) { Capture(Save=>'capture.tga'); } else { printf "KP: No action for %d.\n", $key; } $idleTime = time(); } # ------ # Callback Function called when a special $key is pressed. sub cbSpecialKeyPressed { my $key = shift; if ($key == GLUT_KEY_PAGE_UP) { $Z_Off -= 0.05; } elsif ($key == GLUT_KEY_PAGE_DOWN) { $Z_Off += 0.05; } elsif ($key == GLUT_KEY_UP) { $X_Speed -= 0.01; } elsif ($key == GLUT_KEY_DOWN) { $X_Speed += 0.01; } elsif ($key == GLUT_KEY_LEFT) { $Y_Speed -= 0.01; } elsif ($key == GLUT_KEY_RIGHT) { $Y_Speed += 0.01; } else { printf "SKP: No action for %d.\n", $key; } $idleTime = time(); } # ------ # Callback function called for key-up events. sub cbKeyUp { my($key) = @_; my $mod = GetKeyModifier(); print "Key up: $key w/ $mod\n" if ($mod); } # ------ # Callback function called for special key-up events. sub cbSpecialKeyUp { my($key) = @_; my $mod = GetKeyModifier(); print "Special Key up: $key w/ $mod\n" if ($mod); } # ------ # Callback function called for handling mouse clicks. sub cbMouseClick { my($button,$state,$x,$y) = @_; if ($button == GLUT_LEFT_BUTTON) { print "Left"; } elsif ($button == GLUT_MIDDLE_BUTTON) { print "Middle"; } elsif ($button == GLUT_RIGHT_BUTTON) { print "Right"; } else { print "Unknown"; } print " mouse button, "; if ($state == GLUT_DOWN) { print "DOWN"; } elsif ($state == GLUT_UP) { print "UP"; } else { print "State UNKNOWN"; } my $mod = GetKeyModifier(); print " w/ $mod" if ($mod); print ": $x, $y\n"; # Example of using GLU to determine 3D click points if ($state == GLUT_UP) { print "\n"; glGetDoublev_c(GL_MODELVIEW_MATRIX,$mm->ptr()); my @model = $mm->retrieve(0,16); glGetDoublev_c(GL_PROJECTION_MATRIX,$pm->ptr()); my @projection = $pm->retrieve(0,16); glGetIntegerv_c(GL_VIEWPORT,$vp->ptr()); my @viewport = $vp->retrieve(0,4); print "Model Matrix: $model[0], $model[1], $model[2], $model[3]\n"; print " $model[4], $model[5], $model[6], $model[7]\n"; print " $model[8], $model[9], $model[10], $model[11]\n"; print " $model[12], $model[13], $model[14], $model[15]\n"; print "Projection Matrix: $projection[0], $projection[1], $projection[2], $projection[3]\n"; print " $projection[4], $projection[5], $projection[6], $projection[7]\n"; print " $projection[8], $projection[9], $projection[10], $projection[11]\n"; print " $projection[12], $projection[13], $projection[14], $projection[15]\n"; print "Viewport: $viewport[0], $viewport[1], $viewport[2], $viewport[3]\n"; print "\n"; my @point = gluUnProject_p($x,$y,0, # Cursor point @model, # Model Matrix @projection, # Projection Matrix @viewport); # Viewport print "Model point: $point[0], $point[1], $point[2]\n"; # @point = gluProject_p(@point, # Model point # @model, # Model Matrix # @projection, # Projection Matrix # @viewport); # Viewport # print "Window point: $point[0], $point[1], $point[2]\n"; print "\n"; } $idleTime = time(); } sub GetKeyModifier { return $key_mods->{glutGetModifiers()}; } # ------ # Callback routine executed whenever our window is resized. Lets us # request the newly appropriate perspective projection matrix for # our needs. Try removing the gluPerspective() call to see what happens. sub cbResizeScene { my($Width, $Height) = @_; # Let's not core dump, no matter what. $Height = 1 if ($Height == 0); glViewport(0, 0, $Width, $Height); glMatrixMode(GL_PROJECTION); glLoadIdentity(); gluPerspective(45.0,$Width/$Height,0.1,100.0); glMatrixMode(GL_MODELVIEW); $Window_Width = $Width; $Window_Height = $Height; $idleTime = time(); } sub cbWindowStat { my($stat) = @_; print "Window status: $stat\n"; } sub cbClose { my($wid) = @_; print "User has closed window: \#$wid\n"; ReleaseResources(); } # ------ # The main() function. Inits OpenGL. Calls our own init function, # then passes control onto OpenGL. # Initialize GLUT/FreeGLUT glutInit(); # To see OpenGL drawing, take out the GLUT_DOUBLE request. glutInitDisplayMode(GLUT_RGBA | GLUT_DOUBLE | GLUT_DEPTH | GLUT_ALPHA); if ($^O ne 'MSWin32' and $OpenGL::Config->{DEFINE} !~ /-DHAVE_W32API/) { # skip these MODE checks on win32, they don't work 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$OpenGL::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 (!OpenGL::glpCheckExtension('GL_ARB_vertex_buffer_object')) { #$hasVBO = 1; # Perl 5.10 crashes on VBOs! $hasVBO = ($PERL_VERSION !~ m|^5\.10\.|); } if (!OpenGL::glpCheckExtension('GL_EXT_framebuffer_object')) { $hasFBO = 1; $FBO_On = 1; if (!OpenGL::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 OpenGL::_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 (OpenGL::_have_freeglut()) { glutSetOption(GLUT_ACTION_ON_WINDOW_CLOSE,GLUT_ACTION_GLUTMAINLOOP_RETURNS) } glutMainLoop(); print "FreeGLUT returned from MainLoop\n"; __END__