SDL-OpenGL-Cg-0.01 test scripts update to new API

#!/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";
}