Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

more of the perlish syntax #60

Open
wants to merge 2 commits into
base: master
Choose a base branch
from
Open
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
66 changes: 56 additions & 10 deletions lib/OpenGL/Modern/Helpers.pm
Original file line number Diff line number Diff line change
Expand Up @@ -31,6 +31,9 @@ use OpenGL::Modern qw(
glBufferData_c
glUniform2f
glUniform4f
glGetActiveUniform_c
glShaderSource_p
glGetUniformLocation_c
);

=head1 NAME
Expand Down Expand Up @@ -160,14 +163,24 @@ $VERSION = '0.01_02';
glGenTextures_p
glGetProgramiv_p
glGetShaderiv_p
glShaderSource_p
glGenFramebuffers_p
glGenVertexArrays_p
glGenBuffers_p
glGetIntegerv_p
glBufferData_p
glUniform2f_p
glUniform4f_p

glGetShaderInfoLog
glGetProgramInfoLog
glShaderSource
glGetShaderiv
glGetProgramiv
glGetActiveUniform
glGetUniformLocation
glProgramUniform4fv
glProgramUniform
croak_on_gl_error
);

%glErrorStrings = (
Expand All @@ -182,6 +195,7 @@ $VERSION = '0.01_02';
);

our $PACK_TYPE = $Config{ptrsize} == 4 ? 'L' : 'Q';
our $LONG_SIZE = $Config{longsize};

sub pack_GLuint {
my @gluints = @_;
Expand Down Expand Up @@ -221,7 +235,7 @@ sub pack_ptr {
}

sub iv_ptr {
$_[0] = "\0" x $_[1];
$_[0] = "\0" x $_[1] if $_[1];
return unpack( $PACK_TYPE, pack('P', $_[0]));
}

Expand Down Expand Up @@ -296,14 +310,6 @@ sub glGetProgramiv_p { get_iv_p \&glGetProgramiv_c, @_ }

sub glGetShaderiv_p { get_iv_p \&glGetShaderiv_c, @_ }

sub glShaderSource_p {
my ( $shader, @sources ) = @_;
my $count = @sources;
my @lengths = map length, @sources;
glShaderSource_c( $shader, $count, pack( 'P*', @sources ), pack( 'I*', @lengths ) );
return;
}

sub glGetIntegerv_p {
my ( $pname, $count ) = @_;
$count ||= 1;
Expand All @@ -328,4 +334,44 @@ sub glUniform4f_p {
glUniform4f $uniform, $v0, $v1, $v2, $v3;
}

*glGetShaderInfoLog = \&glGetShaderInfoLog_p;
*glGetProgramInfoLog = \&glGetProgramInfoLog_p;
*glGetShaderiv = \&glGetShaderiv_p;
*glGetProgramiv = \&glGetProgramiv_p;

sub glShaderSource { goto &glShaderSource_p }
sub glGetUniformLocation { goto &glGetUniformLocation_c }

sub glGetActiveUniform
{
my ( $program, $index, $bufsize) = @_;
$bufsize ||= 256;

xs_buffer( my $length, $LONG_SIZE );
xs_buffer( my $size, $LONG_SIZE );
xs_buffer( my $type, $LONG_SIZE );
xs_buffer( my $name, $bufsize);

glGetActiveUniform_c( $program, $index, $bufsize, iv_ptr($length), iv_ptr($size), iv_ptr($type), $name);
$_ = unpack 'I', $_ for $length, $size, $type;
$name = substr $name, 0, $length;
return wantarray ? ($length, $size, $type, $name) : $name;
}

sub glProgramUniform
{
my ( $signature, $program, $index, @v ) = @_;

my $buf;
if ( $signature =~ /^(\d+)fv/) {
my $n = $1;
$buf = pack_GLfloat(@v);
@v = ( scalar(@v) / $n, iv_ptr($buf) );
$signature .= '_c';
}
no strict 'refs';
my $method = 'OpenGL::Modern::glProgramUniform' . $signature;
$method->($program, $index, @v);
}

1;