Hi Paul,
I am the current maintainer for SDL Perl. I noticed you module on
CPAN. I have attached the test scripts updated to the current API of
SDL Perl.
You can get the new Code here:
http://github.com/kthakore/SDL_perl/tree/redesign
This tar-ball is the code that works with you module:
http://github.com/kthakore/SDL_perl/tarball/7801b0fef3cd030246aef98ad894f1af95a8f6e7
We have also improved the documentation here:
http://sdl.perl.org/documentation.html
Please consider joining us on #sdl irc.perl.org or this mailing list.
Kartik Thakore
#!/usr/bin/perl
use strict;
use warnings;
use SDL;
use SDL::OpenGL;
use SDL::Video;
use SDL::OpenGL::Cg qw/:all/;
# Initialise everything.
$|++;
print "A shader will be run which will set the colour of all OpenGL graphics\n";
print "The shader will simply be controlled to change the colour of shapes\n";
print " and then the demonstration will terminate\n";
init_sdl();
open_screen();
init_gl();
init_cg();
# Now keep redrawing the screen.
for (my $scale = 0.0; $scale<1.5; $scale +=0.005) {
draw_scene($scale);
swap_buffers();
SDL::delay(20);
}
# Tidy up after ourselves.
tidy_cg();
print "Shutting down\n";
sub init_sdl {
# Initialise the video part of SDL
if (SDL::init(SDL_INIT_VIDEO())) {
die ("Error: ".SDL::get_error());
}
}
sub open_screen {
# Create a window.
my $depth = 32;
unless (SDL::Video::set_video_mode(800, 600, $depth, SDL_OPENGL)) {
die ("Error: ".SDL::get_error());
}
}
sub init_gl {
# Set up an OpenGL context for us.
SDL::Video::GL_set_attribute (SDL_GL_DOUBLEBUFFER, 1);
SDL::Video::GL_set_attribute (SDL_GL_RED_SIZE, 6);
SDL::Video::GL_set_attribute (SDL_GL_GREEN_SIZE, 6);
SDL::Video::GL_set_attribute(SDL_GL_BLUE_SIZE, 6);
glClearColor (0,0,0,0);
glViewport(0,0,800,600);
glMatrixMode(GL_PROJECTION);
glFrustum(-0.1,0.1,-0.075,0.075,0.175,100.0);
glMatrixMode(GL_MODELVIEW);
glLoadIdentity();
# Swap buffers so we have a clear screen.
swap_buffers();
}
{
my $context;
my $vertex_program;
my $profile;
my $color_param;
my $modelview_param;
sub init_cg {
# Since this is being developed partly on Radeon9000 the
# ARBVP1 profile is the only one supported. Use it for
# this demo.
$profile = CG_PROFILE_ARBVP1();
unless (cgIsProfileSupported($profile)) {
die ("ARBVP1 is not available");
}
unless (cgEnableProfile($profile)) {
die ("Cannot enable ARBVP1: ".SDL::OpenGL::GetErrorString());
}
# Create the CG Context object we'll be attaching programs
# to.
$context = cgCreateContext();
# Compile the vertex shader program from a file.
my $file = '../shaders/vertex/anycolor.cg';
$vertex_program = cgCreateProgramFromFile(
$context,CG_SOURCE(),$file,CG_PROFILE_ARBVP1,'main',undef);
unless ($vertex_program) {
die ("Error: ".cgGetErrorString());
}
# Now load the program onto the GPU, and make it the active
# shader.
unless (cgLoadProgram($vertex_program)) {
die ("Error: ".cgGetErrorString());
}
unless (cgBindProgram($vertex_program)) {
die ("Error: ".cgGetErrorString());
}
# The shader has a parameter, 'constantColor' which is a
# float4 which indicates which colour to shade everything.
$color_param = cgGetNamedParameter($vertex_program,'constantColor');
unless ($color_param) {
die ("Error: ".cgGetErrorString());
}
# The shader has a parameter 'modelViewProj' which is a float4x4
# indicating the current modelview.
$modelview_param = cgGetNamedParameter($vertex_program, 'modelViewProj');
unless ($modelview_param) {
die ("Error: ".cgGetErrorString());
}
}
sub set_color {
my ($r,$g,$b,$a) = @_;
cgSetParameter($color_param,$r,$g,$b,$a);
}
sub update_modelview {
cgSetStateMatrixParameter($modelview_param,
CG_MODELVIEW_PROJECTION_MATRIX(),
CG_MATRIX_IDENTITY()) or die ("Error: ",cgGetErrorString(),"\n");
}
sub tidy_cg {
cgDestroyContext($context);
cgDisableProfile($profile);
}
}
sub draw_scene {
my $scale = shift || 1.0;
set_color($scale,1-$scale,($scale*2)%1,1);
glLoadIdentity();
glTranslate(-1.5,0,-6);
update_modelview();
glBegin(GL_TRIANGLES());
glVertex(0,1,0);
glVertex(-1,-1,0);
glVertex(1,-1,0);
glEnd();
glTranslate(3,0,0);
update_modelview();
glBegin(GL_QUADS());
glVertex(-1,1,0);
glVertex(1,1,0);
glVertex(1,-1,0);
glVertex(-1,-1,0);
glEnd();
glFlush();
}
sub swap_buffers {
SDL::Video::GL_swap_buffers();
glClear(GL_COLOR_BUFFER_BIT | GL_DEPTH_BUFFER_BIT);
}
#!/usr/bin/perl
use strict;
use warnings;
use SDL::OpenGL::Cg qw/:all/;
use SDL::OpenGL;
use SDL;
use SDL::Events;
use SDL::Event;
use SDL::OpenGL;
use SDL::App;
# mydump();
my $app = new SDL::App ( -w => 800, -h => 600, -d => 16, -gl => 1 );
# Init SDL
SDL::init (SDL_INIT_VIDEO())==0 or die "Cannot init SDL";
$app->sync();
glViewport(0,0,800,600);
glMatrixMode(GL_PROJECTION());
glLoadIdentity();
glFrustum(-0.1, 0.1, -0.075, 0.075, 0.175, 100.0);
glShadeModel(GL_SMOOTH());
glClearDepth(1);
glEnable(GL_DEPTH_TEST);
glDepthFunc(GL_LEQUAL);
glClear(GL_COLOR_BUFFER_BIT() | GL_DEPTH_BUFFER_BIT());
glMatrixMode(GL_MODELVIEW());
glLoadIdentity();
# Activate the shader.
my $cg = SDL::OpenGL::Cg->new();
list_supported_profiles();
my $vertex_profile = activate_vertex_profile();
my $cg_context = cgCreateContext();
$cg_context or die "Cannot create context\n";
my $file = '../shaders/vertex/xyplot.cg';
my $vertex_program =
cgCreateProgramFromFile($cg_context, CG_SOURCE(),
$file, $vertex_profile, 'main', undef);
$vertex_program or die "Cannot load program from file ".cgGetError()."\n";
cgLoadProgram($vertex_program) or die "Cannot load program onto GPU\n";
cgBindProgram($vertex_program);
# Grab the modelview parameter so the shader can be controlled.
my $modelview_param = cgGetNamedParameter($vertex_program, 'modelViewProj');
$modelview_param or die "Cannot get modelViewProj param\n";
my $event = new SDL::Event;
my $rotx = 0;
my $roty = 0;
redraw($rotx, $roty);
$app->sync();
print "Controls\n";
print " Arrow keys rotate cube\n";
print " Escape quits\n";
$app->loop({
SDL_QUIT() => sub {
cgDestroyContext($cg_context);
cgDisableProfile($vertex_profile);
exit (0)
},
SDL_KEYDOWN() => sub {
my ($event) = @_;
my $keysym = $event->key_sym();
if ($keysym == SDLK_ESCAPE) {
cgDestroyContext($cg_context);
cgDisableProfile($vertex_profile);
exit(0);
} elsif ($keysym == SDLK_UP) {
redraw($rotx-=5,$roty);
$app->sync();
} elsif ($keysym == SDLK_DOWN) {
redraw($rotx+=5,$roty);
$app->sync();
} elsif ($keysym == SDLK_RIGHT) {
redraw($rotx, $roty+=5);
$app->sync();
} elsif ($keysym == SDLK_LEFT) {
redraw($rotx, $roty-=5);
$app->sync();
}
},
});
sub redraw {
my ($rotx,$roty) = @_;
glClear (GL_DEPTH_BUFFER_BIT() | GL_COLOR_BUFFER_BIT());
glLoadIdentity();
glTranslate(0,0,-6);
glRotate($rotx, 1,0,0);
glRotate($roty, 0,1,0);
glColor (1,1,1);
my @verts = (
[ -1,1,1], [1,1,1], [-1,-1,1], [1,-1,1],
[ -1,1,-1], [1,1,-1], [-1,-1,-1], [1,-1,-1],
);
# Update the shader's modelview to the current OpenGL view.
cgSetStateMatrixParameter($modelview_param,
CG_MODELVIEW_PROJECTION_MATRIX(), CG_MATRIX_IDENTITY())
or die "Cannot set modelViewProj parameter to OpenGL's\n";
glBegin (GL_QUADS);
glNormal(0,0,1);
glVertex(@{$verts[0]});
glVertex(@{$verts[1]});
glVertex(@{$verts[3]});
glVertex(@{$verts[2]});
glNormal(1,0,0);
glVertex(@{$verts[3]});
glVertex(@{$verts[1]});
glVertex(@{$verts[5]});
glVertex(@{$verts[7]});
glNormal(0,1,0);
glVertex(@{$verts[0]});
glVertex(@{$verts[1]});
glVertex(@{$verts[5]});
glVertex(@{$verts[4]});
glNormal(-1,0,0);
glVertex(@{$verts[2]});
glVertex(@{$verts[0]});
glVertex(@{$verts[4]});
glVertex(@{$verts[6]});
glNormal(0,-1,0);
glVertex(@{$verts[2]});
glVertex(@{$verts[3]});
glVertex(@{$verts[7]});
glVertex(@{$verts[6]});
glNormal(0,0,-1);
glVertex(@{$verts[4]});
glVertex(@{$verts[5]});
glVertex(@{$verts[7]});
glVertex(@{$verts[6]});
glEnd();
}
sub list_supported_profiles {
print "Fragment profiles\n";
print " ARBFP1 : ",
cgIsProfileSupported(CG_PROFILE_ARBFP1()) ? "Yes\n" : "No\n";
print " FP20 : ",
cgIsProfileSupported(CG_PROFILE_FP20()) ? "Yes\n" : "No\n";
print " FP20 : ",
cgIsProfileSupported(CG_PROFILE_FP30()) ? "Yes\n" : "No\n";
print "Vertex profiles\n";
print " ARBVP1 : ",
cgIsProfileSupported(CG_PROFILE_ARBVP1()) ? "Yes\n" : "No\n";
print " VP20 : ",
cgIsProfileSupported(CG_PROFILE_VP20()) ? "Yes\n" : "No\n";
print " VP30 : ",
cgIsProfileSupported(CG_PROFILE_VP30()) ? "Yes\n" : "No\n";
}
sub activate_vertex_profile {
my @profiles = (CG_PROFILE_ARBVP1(), CG_PROFILE_VP20(), CG_PROFILE_VP30());
foreach my $profile (@profiles) {
if (cgIsProfileSupported($profile)) {
print "Activating ",cgGetProfileString($profile),"\n";
unless (cgEnableProfile($profile)) {
die "Error activating profile ",cgGetError(),"\n";
}
return $profile;
} else {
print cgGetProfileString($profile), " not supported, skipping\n";
}
}
die "No vertex profiles supported\n";
}
