The Perl Toolchain Summit 2025 Needs You: You can help 🙏 Learn more

ETJ / OpenGL-0.7004 / lib / OpenGL / Shader / Objects.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
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174

              
############################################################
#
# OpenGL::Shader::Objects - 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 Common.pm
package OpenGL::Shader::Objects;
use strict;
use warnings;
use Carp;
our $VERSION = '1.01';
use OpenGL::Shader::Common;
our @ISA = qw(OpenGL::Shader::Common);
use OpenGL(':all');
=head1 NAME
OpenGL::Shader::Objects - plug-in module for use with OpenGL::Shader
=head1 SYNOPSIS
  # See docs in OpenGL/Shader/Common.pm
=head1 DESCRIPTION
This module provides a base class for high-level OpenGL shaders.
This subclasses of the OpenGL::Shader::Common module.
=head1 AUTHOR
Bob "grafman" Free - grafman@graphcomp.com.
Copyright 2007 Graphcomp - ALL RIGHTS RESERVED
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
=cut
# Shader constructor
sub new {
  my $this = shift;
  my $class = ref($this) || $this;
  my $self = OpenGL::Shader::Common->new(@_);
  return undef if (!$self);
  bless($self,$class);
  # Check for required OpenGL extensions
  return undef if (OpenGL::glpCheckExtension('GL_ARB_shader_objects'));
  return undef if (OpenGL::glpCheckExtension('GL_ARB_fragment_shader'));
  return undef if (OpenGL::glpCheckExtension('GL_ARB_vertex_shader'));
  $self->{type} = '';
  $self->{version} = '';
  $self->{description} = '';
  $self->{fragment_const} = '';
  $self->{vertex_const} = '';
  return $self;
}
# Shader destructor
# Must be disabled first
sub DESTROY {
  my($self) = @_;
  if ($self->{program}) {
    glDetachObjectARB($self->{program},$self->{fragment_id}) if ($self->{fragment_id});
    glDetachObjectARB($self->{program},$self->{vertex_id}) if ($self->{vertex_id});
    glDeleteProgramsARB_p($self->{program});
  }
  glDeleteProgramsARB_p($self->{fragment_id}) if ($self->{fragment_id});
  glDeleteProgramsARB_p($self->{vertex_id}) if ($self->{vertex_id});
}
# Load shader strings
sub Load {
  my($self,$fragment,$vertex) = @_;
  # Load fragment code
  if ($fragment) {
    $self->{fragment_id} = glCreateShaderObjectARB($self->{fragment_const});
    return undef if (!$self->{fragment_id});
    glShaderSourceARB_p($self->{fragment_id}, $fragment);
    #my $frag = glGetShaderSourceARB_p($self->{fragment_id});
    #print STDERR "Loaded fragment:\n$frag\n";
    glCompileShaderARB($self->{fragment_id});
    my $stat = glGetInfoLogARB_p($self->{fragment_id});
    return "Fragment shader: $stat" if ($stat);
  }
  # Load vertex code
  if ($vertex) {
    $self->{vertex_id} = glCreateShaderObjectARB($self->{vertex_const});
    return undef if (!$self->{vertex_id});
    glShaderSourceARB_p($self->{vertex_id}, $vertex);
    #my $vert = glGetShaderSourceARB_p($self->{vertex_id});
    #print STDERR "Loaded vertex:\n$vert\n";
    glCompileShaderARB($self->{vertex_id});
    my $stat = glGetInfoLogARB_p($self->{vertex_id});
    return "Vertex shader: $stat" if ($stat);
  }
  # Link shaders
  my $sp = glCreateProgramObjectARB();
  glAttachObjectARB($sp, $self->{fragment_id}) if ($fragment);
  glAttachObjectARB($sp, $self->{vertex_id}) if ($vertex);
  glLinkProgramARB($sp);
  my $linked = glGetObjectParameterivARB_p($sp, GL_OBJECT_LINK_STATUS_ARB);
  if (!$linked) {
    my $stat = glGetInfoLogARB_p($sp);
    #print STDERR "Load shader: $stat\n";
    return "Link shader: $stat" if ($stat);
    return 'Unable to link shader';
  }
  $self->{program} = $sp;
  return '';
}
# Enable shader
sub Enable {
  my($self) = @_;
  glUseProgramObjectARB($self->{program}) if ($self->{program});
}
# Disable shader
sub Disable {
  my($self) = @_;
  glUseProgramObjectARB(0) if ($self->{program});
}
# Return shader vertex attribute ID
sub MapAttr {
  my($self,$attr) = @_;
  return undef if (!$self->{program});
  my $id = glGetAttribLocationARB_p($self->{program},$attr);
  return undef if ($id < 0);
  return $id;
}
# Return shader uniform variable ID
sub Map {
  my($self,$var) = @_;
  return undef if (!$self->{program});
  my $id = glGetUniformLocationARB_p($self->{program},$var);
  return undef if ($id < 0);
  return $id;
}
# Set shader vector
sub SetVector {
  my($self,$var,@values) = @_;
  my $id = $self->Map($var);
  return 'Unable to map $var' if (!defined($id));
  my $count = scalar(@values);
  eval('glUniform'.$count.'fARB($id,@values)');
  return '';
}
# Set shader 4x4 matrix
sub SetMatrix {
  my($self,$var,$oga) = @_;
  my $id = $self->Map($var);
  return 'Unable to map $var' if (!defined($id));
  glUniformMatrix4fvARB_c($id,1,0,$oga->ptr());
  return '';
}
1;