From 299f3f28c8059dae897cc6408fb3b95dc9d40470 Mon Sep 17 00:00:00 2001 From: Shinmera Date: Tue, 22 Aug 2023 12:03:23 +0200 Subject: [PATCH] Fix uniform setting. --- resources/shader-program.lisp | 54 +++++++++++++++++------------------ 1 file changed, 27 insertions(+), 27 deletions(-) diff --git a/resources/shader-program.lisp b/resources/shader-program.lisp index 0ff5267f0..51ac295af 100644 --- a/resources/shader-program.lisp +++ b/resources/shader-program.lisp @@ -96,7 +96,7 @@ (%gl-uniform-matrix-4fv loc arr)) (declaim (inline %set-dquat)) -(defun %set-dquat (dquat dat i) +(defun %set-quat2 (dquat dat i) (let ((qreal (q2real dquat)) (qdual (q2dual dquat))) (setf (cffi:mem-aref dat :float (+ i 0)) (qx qreal)) @@ -114,47 +114,47 @@ (declare (type (signed-byte 32) location)) #+sbcl (declare (sb-ext:muffle-conditions sb-ext:compiler-note)) ;; FIXME: this kinda blows, man. - (macrolet ((mat (set marr) + (macrolet ((call-array (set marr &rest args) #+sbcl `(let ((data (,marr data))) (sb-sys:with-pinned-objects (data) - (,(find-symbol (string set) '#:%GL) location 1 T (sb-sys:vector-sap data)))) + (,(find-symbol (string set) '#:%GL) location 1 ,@args (sb-sys:vector-sap data)))) #-sbcl `(,(find-symbol (string set) '#:GL) location (,marr data)))) (etypecase data - (vec4 (%gl:uniform-4fv location 1 (varr4 data))) - (vec3 (%gl:uniform-3fv location 1 (varr3 data))) - (vec2 (%gl:uniform-2fv location 1 (varr2 data))) - (dvec4 (%gl:uniform-4dv location 1 (dvarr4 data))) - (dvec3 (%gl:uniform-3dv location 1 (dvarr3 data))) - (dvec2 (%gl:uniform-2dv location 1 (dvarr2 data))) - (ivec4 (%gl:uniform-4iv location 1 (ivarr4 data))) - (ivec3 (%gl:uniform-3iv location 1 (ivarr3 data))) - (ivec2 (%gl:uniform-2iv location 1 (ivarr2 data))) - (mat4 (mat %gl:uniform-matrix-4fv marr4)) - (mat3 (mat %gl:uniform-matrix-3fv marr3)) - (mat2 (mat %gl:uniform-matrix-2fv marr2)) - (dmat4 (mat %gl:uniform-matrix-4dv dmarr4)) - (dmat3 (mat %gl:uniform-matrix-3dv dmarr3)) - (dmat2 (mat %gl:uniform-matrix-2dv dmarr2)) + (vec4 (call-array %gl:uniform-4fv varr4)) + (vec3 (call-array %gl:uniform-3fv varr3)) + (vec2 (call-array %gl:uniform-2fv varr2)) + (dvec4 (call-array %gl:uniform-4dv dvarr4)) + (dvec3 (call-array %gl:uniform-3dv dvarr3)) + (dvec2 (call-array %gl:uniform-2dv dvarr2)) + (ivec4 (call-array %gl:uniform-4iv ivarr4)) + (ivec3 (call-array %gl:uniform-3iv ivarr3)) + (ivec2 (call-array %gl:uniform-2iv ivarr2)) + (mat4 (call-array %gl:uniform-matrix-4fv marr4 T)) + (mat3 (call-array %gl:uniform-matrix-3fv marr3 T)) + (mat2 (call-array %gl:uniform-matrix-2fv marr2 T)) + (dmat4 (call-array %gl:uniform-matrix-4dv dmarr4 T)) + (dmat3 (call-array %gl:uniform-matrix-3dv dmarr3 T)) + (dmat2 (call-array %gl:uniform-matrix-2dv dmarr2 T)) (quat (%gl:uniform-4f location (qx data) (qy data) (qz data) (qw data))) (dquat (%gl:uniform-4d location (qx data) (qy data) (qz data) (qw data))) (quat2 (cffi:with-foreign-object (dat :float 8) - (%set-dquat data dat 0) + (%set-quat2 data dat 0) (%gl:uniform-matrix-2x4-fv location 1 NIL dat))) (single-float (%gl:uniform-1f location data)) (double-float (%gl:uniform-1d location data)) (fixnum (%gl:uniform-1i location data)) (matn (ecase (mrows data) (2 (ecase (mcols data) - (3 (%gl:uniform-matrix-2x3-fv location 1 T (marrn data))) - (4 (%gl:uniform-matrix-2x4-fv location 1 T (marrn data))))) + (3 (call-array %gl:uniform-matrix-2x3-fv marrn T)) + (4 (call-array %gl:uniform-matrix-2x4-fv marrn T)))) (3 (ecase (mcols data) - (2 (%gl:uniform-matrix-3x2-fv location 1 T (marrn data))) - (4 (%gl:uniform-matrix-3x4-fv location 1 T (marrn data))))) + (2 (call-array %gl:uniform-matrix-3x2-fv marrn T)) + (4 (call-array %gl:uniform-matrix-3x4-fv marrn T)))) (4 (ecase (mcols data) - (2 (%gl:uniform-matrix-4x2-fv location 1 T (marrn data))) - (3 (%gl:uniform-matrix-4x3-fv location 1 T (marrn data))))))) + (2 (call-array %gl:uniform-matrix-4x2-fv marrn T)) + (3 (call-array %gl:uniform-matrix-4x3-fv marrn T)))))) (simple-vector (etypecase (svref data 0) (mat4 (cffi:with-foreign-object (dat :float (* 16 (length data))) @@ -171,9 +171,9 @@ (sb-sys:vector-sap (marr3 (svref data i))) (* 9 4))) (%gl:uniform-matrix-4fv location (length data) T dat))) - (dquat (cffi:with-foreign-object (dat :float (* 8 (length data))) + (quat2 (cffi:with-foreign-object (dat :float (* 8 (length data))) (loop for i from 0 below (length data) - do (%set-dquat (aref data i) dat (* 8 i))) + do (%set-quat2 (aref data i) dat (* 8 i))) (%gl:uniform-matrix-2x4-fv location (length data) NIL dat)))))))) (declaim (inline uniform-location))