From 6270996dc6c6432e2440915e92b0c2ef3d6a3aaa Mon Sep 17 00:00:00 2001
From: Dmitry Karasik <dmka@novozymes.com>
Date: Thu, 22 Jun 2017 13:32:09 +0200
Subject: [PATCH 1/2] don't pad iv_ptr buffer if no length given

---
 lib/OpenGL/Modern/Helpers.pm | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/lib/OpenGL/Modern/Helpers.pm b/lib/OpenGL/Modern/Helpers.pm
index 8d3cd49..e3474c8 100644
--- a/lib/OpenGL/Modern/Helpers.pm
+++ b/lib/OpenGL/Modern/Helpers.pm
@@ -221,7 +221,7 @@ sub pack_ptr {
 }
 
 sub iv_ptr {
-    $_[0] = "\0" x $_[1];
+    $_[0] = "\0" x $_[1] if $_[1];
     return unpack( $PACK_TYPE, pack('P', $_[0]));
 }
 

From 851e4dc2c26b1d255a49fa9e3bb54516057b9285 Mon Sep 17 00:00:00 2001
From: Dmitry Karasik <dmka@novozymes.com>
Date: Mon, 26 Jun 2017 15:55:17 +0200
Subject: [PATCH 2/2] first shot at some helpers

---
 lib/OpenGL/Modern/Helpers.pm | 64 +++++++++++++++++++++++++++++++-----
 1 file changed, 55 insertions(+), 9 deletions(-)

diff --git a/lib/OpenGL/Modern/Helpers.pm b/lib/OpenGL/Modern/Helpers.pm
index e3474c8..0de524f 100644
--- a/lib/OpenGL/Modern/Helpers.pm
+++ b/lib/OpenGL/Modern/Helpers.pm
@@ -31,6 +31,9 @@ use OpenGL::Modern qw(
   glBufferData_c
   glUniform2f
   glUniform4f
+  glGetActiveUniform_c
+  glShaderSource_p
+  glGetUniformLocation_c
 );
 
 =head1 NAME
@@ -160,7 +163,6 @@ $VERSION = '0.01_02';
   glGenTextures_p
   glGetProgramiv_p
   glGetShaderiv_p
-  glShaderSource_p
   glGenFramebuffers_p
   glGenVertexArrays_p
   glGenBuffers_p
@@ -168,6 +170,17 @@ $VERSION = '0.01_02';
   glBufferData_p
   glUniform2f_p
   glUniform4f_p
+ 
+  glGetShaderInfoLog
+  glGetProgramInfoLog
+  glShaderSource
+  glGetShaderiv
+  glGetProgramiv
+  glGetActiveUniform
+  glGetUniformLocation
+  glProgramUniform4fv
+  glProgramUniform
+  croak_on_gl_error
 );
 
 %glErrorStrings = (
@@ -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 = @_;
@@ -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;
@@ -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;