From Code to Community: Sponsoring The Perl and Raku Conference 2025 Learn more

ETJ / OpenGL-0.7004 / lib / OpenGL / Shader.pm 

            

              
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106

              
############################################################
#
# 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;
use strict;
use warnings;
use Carp;
use OpenGL(':all');
our $VERSION = '1.02';
our @ISA = qw(Exporter);
our $SHADER_TYPES;
# 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 {
  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 $file = $module) =~ s{::}{/}g;
  require "$file.pm";
  my $version = $module->can('TypeVersion')->();
  my $desc = $module->can('TypeDescription')->();
  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 @types = @_ ? @_ : ('GLSL','CG','ARB');
  foreach my $type (@types) {
    my $module = GetTypeModule($type);
    (my $file = $module) =~ s{::}{/}g;
    require "$file.pm";
    my $obj = $module->new;
    return $obj if $obj;
  }
  return undef;
}
# Get shader module name
sub GetTypeModule
{
  my($type) = @_;
  return __PACKAGE__.'::'.uc($type);
}
1;