Fix uniform setting.

Shirakumo · Aug 22, 2023 · 299f3f2 · 299f3f2
1 parent 2a33150
commit 299f3f2
Showing 1 changed file with 27 additions and 27 deletions.
diff --git 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))