Skip to content
This repository

Better libGL loading, fallback GetProcAddress binds, and improved matrix support. #31

Open
wants to merge 4 commits into from

2 participants

Benjamin Saunders 3b
Benjamin Saunders

No description provided.

3b 3b commented on the diff December 13, 2011
gl/opengl.lisp
((8 lines not shown))
689  
-        (let ((matrix (aref matrices i)))
690  
-          (dotimes (j matrix-size)
691  
-            (setf (mem-aref array '%gl:float (+ j (* i matrix-size)))
692  
-                  (row-major-aref matrix j)))))
693  
-      (case dim
694  
-        (2 (%gl:uniform-matrix-2fv
695  
-            location matrix-count transpose array))
696  
-        (3 (%gl:uniform-matrix-3fv
697  
-            location matrix-count transpose array))
698  
-        (4 (%gl:uniform-matrix-4fv
699  
-            location matrix-count transpose array))))))
  688
+  (typecase matrices
  689
+    #-clisp
  690
+    ((simple-array single-float (*))    ; Flattened arrays can be passed directly
  691
+     (with-pointer-to-vector-data (ptr matrices)
  692
+       (let ((matrix-count (/ (length matrices) (* dim dim))))
1
3b Owner
3b added a note December 13, 2011

I'd probably use FLOOR rather than / there, so it doesn't error if the array is a bit too long, not sure if ignoring the extra data is actually better than erroring though.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
3b 3b commented on the diff December 13, 2011
gl/opengl.lisp
@@ -403,10 +403,13 @@ another buffer is bound within FORMS."
403 403
 (import-export %gl:matrix-mode)
404 404
 
405 405
 (defmacro with-foreign-matrix ((sym matrix) &body body)
406  
-  `(with-foreign-object (,sym '%gl:float 16)
407  
-     (dotimes (i 16)
408  
-       (setf (mem-aref ,sym '%gl:float i) (row-major-aref ,matrix i)))
409  
-     ,@body))
  406
+  `(typecase ,matrix
  407
+     #-clisp
  408
+     ((simple-array single-float (*))
  409
+      (with-pointer-to-vector-data (,sym ,matrix)
  410
+        ,@body))
  411
+     (t (dotimes (i 16)
1
3b Owner
3b added a note December 13, 2011

looks like WITH-FOREIGN-OBJECT got lost in the fallback case there?

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
3b 3b commented on the diff December 13, 2011
gl/opengl.lisp
@@ -403,10 +403,13 @@ another buffer is bound within FORMS."
403 403
 (import-export %gl:matrix-mode)
404 404
 
405 405
 (defmacro with-foreign-matrix ((sym matrix) &body body)
406  
-  `(with-foreign-object (,sym '%gl:float 16)
407  
-     (dotimes (i 16)
408  
-       (setf (mem-aref ,sym '%gl:float i) (row-major-aref ,matrix i)))
409  
-     ,@body))
  406
+  `(typecase ,matrix
  407
+     #-clisp
1
3b Owner
3b added a note December 13, 2011

I'd probably enable the optimization on implementations where we know it works and helps rather than just disabling it on clisp...

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
3b
Owner
3b commented December 13, 2011

merged the lib and GetProdAddress stuff, not sure about the others though, see patch comments...

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
This page is out of date. Refresh to see the latest.
15  gl/bindings.lisp
@@ -99,8 +99,21 @@
99 99
 ;;; wglGetProcAddress(), etc.
100 100
 (defparameter *gl-get-proc-address* nil)
101 101
 
  102
+;;; Fallback get-proc-address bindings which should work for common
  103
+;;; configurations
  104
+;;; TODO: Darwin
  105
+#+linux
  106
+(defcfun ("glXGetProcAddress" glx-get-proc-address) :pointer
  107
+  (proc-name :string))
  108
+#+win32
  109
+(defcfun ("wglGetProcAddress" wgl-get-proc-address) :pointer
  110
+  (proc-name :string))
  111
+
102 112
 (defun gl-get-proc-address (name)
103  
-  (funcall *gl-get-proc-address* name))
  113
+  (funcall (or *gl-get-proc-address*
  114
+               #+linux #'glx-get-proc-address
  115
+               #+win32 #'wgl-get-proc-address)
  116
+           name))
104 117
 
105 118
 (eval-when (:load-toplevel :execute)
106 119
   #+clisp (pushnew 'reset-gl-pointers custom:*fini-hooks*)
2  gl/library.lisp
@@ -35,6 +35,6 @@
35 35
 (define-foreign-library opengl
36 36
   (:darwin (:framework "OpenGL"))
37 37
   (:windows "opengl32.dll" :convention :stdcall)
38  
-  (:unix (:or "libGL.so" "libGL.so.2" "libGL.so.1")))
  38
+  (:unix (:or "libGL.so.4" "libGL.so.3" "libGL.so.2" "libGL.so.1" "libGL.so")))
39 39
 
40 40
 (use-foreign-library opengl)
53  gl/opengl.lisp
@@ -403,10 +403,13 @@ another buffer is bound within FORMS."
403 403
 (import-export %gl:matrix-mode)
404 404
 
405 405
 (defmacro with-foreign-matrix ((sym matrix) &body body)
406  
-  `(with-foreign-object (,sym '%gl:float 16)
407  
-     (dotimes (i 16)
408  
-       (setf (mem-aref ,sym '%gl:float i) (row-major-aref ,matrix i)))
409  
-     ,@body))
  406
+  `(typecase ,matrix
  407
+     #-clisp
  408
+     ((simple-array single-float (*))
  409
+      (with-pointer-to-vector-data (,sym ,matrix)
  410
+        ,@body))
  411
+     (t (dotimes (i 16)
  412
+          (setf (mem-aref ,sym '%gl:float i) (row-major-aref ,matrix i))))))
410 413
 
411 414
 (defun load-matrix (matrix)
412 415
   (with-foreign-matrix (foreign-matrix matrix)
@@ -682,21 +685,33 @@ program PROGRAM as multiple values. 1: Size of attribute. 2: Type of attribute.
682 685
 
683 686
 (defun uniform-matrix (location dim matrices &optional (transpose t))
684 687
   (check-type dim (integer 2 4))
685  
-  (let ((matrix-count (length matrices))
686  
-        (matrix-size (* dim dim)))
687  
-    (with-foreign-object (array '%gl:float (* matrix-count matrix-size))
688  
-      (dotimes (i matrix-count)
689  
-        (let ((matrix (aref matrices i)))
690  
-          (dotimes (j matrix-size)
691  
-            (setf (mem-aref array '%gl:float (+ j (* i matrix-size)))
692  
-                  (row-major-aref matrix j)))))
693  
-      (case dim
694  
-        (2 (%gl:uniform-matrix-2fv
695  
-            location matrix-count transpose array))
696  
-        (3 (%gl:uniform-matrix-3fv
697  
-            location matrix-count transpose array))
698  
-        (4 (%gl:uniform-matrix-4fv
699  
-            location matrix-count transpose array))))))
  688
+  (typecase matrices
  689
+    #-clisp
  690
+    ((simple-array single-float (*))    ; Flattened arrays can be passed directly
  691
+     (with-pointer-to-vector-data (ptr matrices)
  692
+       (let ((matrix-count (/ (length matrices) (* dim dim))))
  693
+         (case dim
  694
+           (2 (%gl:uniform-matrix-2fv
  695
+               location matrix-count transpose ptr))
  696
+           (3 (%gl:uniform-matrix-3fv
  697
+               location matrix-count transpose ptr))
  698
+           (4 (%gl:uniform-matrix-4fv
  699
+               location matrix-count transpose ptr))))))
  700
+    (t (let ((matrix-count (length matrices))
  701
+             (matrix-size (* dim dim)))
  702
+         (with-foreign-object (array '%gl:float (* matrix-count matrix-size))
  703
+           (dotimes (i matrix-count)
  704
+             (let ((matrix (aref matrices i)))
  705
+               (dotimes (j matrix-size)
  706
+                 (setf (mem-aref array '%gl:float (+ j (* i matrix-size)))
  707
+                       (row-major-aref matrix j)))))
  708
+           (case dim
  709
+             (2 (%gl:uniform-matrix-2fv
  710
+                 location matrix-count transpose array))
  711
+             (3 (%gl:uniform-matrix-3fv
  712
+                 location matrix-count transpose array))
  713
+             (4 (%gl:uniform-matrix-4fv
  714
+                 location matrix-count transpose array))))))))
700 715
 
701 716
 ;;; 2.15.4 Shader Execution
702 717
 
Commit_comment_tip

Tip: You can add notes to lines in a file. Hover to the left of a line to make a note

Something went wrong with that request. Please try again.