############################################################ # # OpenGL::Shader - Copyright 2007 Graphcomp - ALL RIGHTS RESERVED # Author: Bob "grafman" Free - grafman@graphcomp.com # # This program is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. # ############################################################ ### SEE DOCS IN Shader.pod package OpenGL::Shader; require Exporter; use strict; use warnings; use Carp; use vars qw($VERSION $SHADER_TYPES @ISA); $VERSION = '1.01'; @ISA = qw(Exporter); use OpenGL(':all'); # Return hashref of supported shader types # Must be able to open a hidden GL context. sub GetTypes { return ReturnTypes() if (ref($SHADER_TYPES)); my $dir = __FILE__; return if ($dir !~ s|\.pm$||); my @types; # Grab OpenGL/Shader modules if (opendir(DIR,$dir)) { foreach my $type (readdir(DIR)) { next if ($type !~ s|\.pm$||); next if ($type eq 'Common'); next if ($type eq 'Objects'); push(@types,$type); } closedir(DIR); } return if (!@types); $SHADER_TYPES = {}; foreach my $type (@types) { my $info = HasType($type); next if (!$info); $SHADER_TYPES->{$type} = $info; } return ReturnTypes(); } sub ReturnTypes { return wantarray ? values(%$SHADER_TYPES) : $SHADER_TYPES; } # Get shader's version # Must be able to open a hidden GL context. sub GetTypeVersion { my($type) = @_; return if (!$type); my $info = HasType($type); return if (!$info); return $info->{version}; } # Check for engine availability; returns module version sub HasType { my($type,$min_ver,$max_ver) = @_; return if (!$type); my $module = GetTypeModule($type); my($version,$desc); my $exec = qq { use $module; \$version = $module\::TypeVersion(); \$desc = $module\::TypeDescription(); }; eval($exec); return if (!$version); return if ($min_ver && $version lt $min_ver); return if ($max_ver && $version gt $max_ver); my $info = {}; $info->{name} = $type; $info->{module} = $module; $info->{version} = $version; $info->{description} = $desc; return $info; } # Constructor wrapper for shader type sub new { my $this = shift; my $class = ref($this) || $this; my $self = {}; bless($self,$class); my @types = @_ ? @_ : ('GLSL','CG','ARB'); foreach my $type (@types) { my $obj; my $module = GetTypeModule($type); my $exec = qq { use $module; \$obj = new $module\(); }; eval($exec); return $obj if ($obj && !$@); } return undef; } # Get shader module name sub GetTypeModule { my($type) = @_; return __PACKAGE__.'::'.uc($type); } 1; __END__