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

Already on GitHub? Sign in to your account

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

Open
wants to merge 4 commits into
from
View
@@ -99,8 +99,21 @@
;;; wglGetProcAddress(), etc.
(defparameter *gl-get-proc-address* nil)
+;;; Fallback get-proc-address bindings which should work for common
+;;; configurations
+;;; TODO: Darwin
+#+linux
+(defcfun ("glXGetProcAddress" glx-get-proc-address) :pointer
+ (proc-name :string))
+#+win32
+(defcfun ("wglGetProcAddress" wgl-get-proc-address) :pointer
+ (proc-name :string))
+
(defun gl-get-proc-address (name)
- (funcall *gl-get-proc-address* name))
+ (funcall (or *gl-get-proc-address*
+ #+linux #'glx-get-proc-address
+ #+win32 #'wgl-get-proc-address)
+ name))
(eval-when (:load-toplevel :execute)
#+clisp (pushnew 'reset-gl-pointers custom:*fini-hooks*)
View
@@ -35,6 +35,6 @@
(define-foreign-library opengl
(:darwin (:framework "OpenGL"))
(:windows "opengl32.dll" :convention :stdcall)
- (:unix (:or "libGL.so" "libGL.so.2" "libGL.so.1")))
+ (:unix (:or "libGL.so.4" "libGL.so.3" "libGL.so.2" "libGL.so.1" "libGL.so")))
(use-foreign-library opengl)
View
@@ -403,10 +403,13 @@ another buffer is bound within FORMS."
(import-export %gl:matrix-mode)
(defmacro with-foreign-matrix ((sym matrix) &body body)
- `(with-foreign-object (,sym '%gl:float 16)
- (dotimes (i 16)
- (setf (mem-aref ,sym '%gl:float i) (row-major-aref ,matrix i)))
- ,@body))
+ `(typecase ,matrix
+ #-clisp
@3b

3b Dec 13, 2011

Owner

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

+ ((simple-array single-float (*))
+ (with-pointer-to-vector-data (,sym ,matrix)
+ ,@body))
+ (t (dotimes (i 16)
@3b

3b Dec 13, 2011

Owner

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

+ (setf (mem-aref ,sym '%gl:float i) (row-major-aref ,matrix i))))))
(defun load-matrix (matrix)
(with-foreign-matrix (foreign-matrix matrix)
@@ -682,21 +685,33 @@ program PROGRAM as multiple values. 1: Size of attribute. 2: Type of attribute.
(defun uniform-matrix (location dim matrices &optional (transpose t))
(check-type dim (integer 2 4))
- (let ((matrix-count (length matrices))
- (matrix-size (* dim dim)))
- (with-foreign-object (array '%gl:float (* matrix-count matrix-size))
- (dotimes (i matrix-count)
- (let ((matrix (aref matrices i)))
- (dotimes (j matrix-size)
- (setf (mem-aref array '%gl:float (+ j (* i matrix-size)))
- (row-major-aref matrix j)))))
- (case dim
- (2 (%gl:uniform-matrix-2fv
- location matrix-count transpose array))
- (3 (%gl:uniform-matrix-3fv
- location matrix-count transpose array))
- (4 (%gl:uniform-matrix-4fv
- location matrix-count transpose array))))))
+ (typecase matrices
+ #-clisp
+ ((simple-array single-float (*)) ; Flattened arrays can be passed directly
+ (with-pointer-to-vector-data (ptr matrices)
+ (let ((matrix-count (/ (length matrices) (* dim dim))))
@3b

3b Dec 13, 2011

Owner

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.

+ (case dim
+ (2 (%gl:uniform-matrix-2fv
+ location matrix-count transpose ptr))
+ (3 (%gl:uniform-matrix-3fv
+ location matrix-count transpose ptr))
+ (4 (%gl:uniform-matrix-4fv
+ location matrix-count transpose ptr))))))
+ (t (let ((matrix-count (length matrices))
+ (matrix-size (* dim dim)))
+ (with-foreign-object (array '%gl:float (* matrix-count matrix-size))
+ (dotimes (i matrix-count)
+ (let ((matrix (aref matrices i)))
+ (dotimes (j matrix-size)
+ (setf (mem-aref array '%gl:float (+ j (* i matrix-size)))
+ (row-major-aref matrix j)))))
+ (case dim
+ (2 (%gl:uniform-matrix-2fv
+ location matrix-count transpose array))
+ (3 (%gl:uniform-matrix-3fv
+ location matrix-count transpose array))
+ (4 (%gl:uniform-matrix-4fv
+ location matrix-count transpose array))))))))
;;; 2.15.4 Shader Execution