add some glsl related stuff

gl/opengl.lisp

@@ -554,6 +554,7 @@ another buffer is bound within FORMS."
 (import-export %gl:create-shader)
 
 (defun shader-source (shader string-list)
+  (when (stringp string-list) (setf string-list (list string-list)))
   (let ((num-lines (length string-list)))
     (with-foreign-object (string-array :pointer num-lines)
       ;; copy the list of Lisp strings into an array of C strings

gl/package.lisp

@@ -193,6 +193,12 @@
    #:tex-env
    ;; 3.10 Fog
    #:fog
+   ;; 3.12.2 Shader Execution
+   #:get-frag-data-location
+   #:get-frag-data-location-ext
+   #:bind-frag-data-location
+   #:bind-frag-data-location-ext
+
    ;; 5.4 Display Lists
    #:new-list
    #:end-list
@@ -300,8 +306,12 @@
    #:get-string
    #:gl3-major-version
    #:gl3-minor-version
+   #:gl-version
    #:major-version
    #:minor-version
+   #:glsl-version
+   #:glsl-major-version
+   #:glsl-minor-version
    #:gl3-extension-present-p
    #:extension-present-p
    ;; 6.1.14 Shader and Program Queries

gl/rasterization.lisp

@@ -391,3 +391,24 @@
      (%gl:fog-i pname (foreign-enum-value '%gl:enum param)))
     ((:fog-density :fog-start :fog-end)
      (%gl:fog-f pname param))))
+
+
+;;; 3.12.2 Shader Execution
+
+;;; TODO: make these use :STRING
+(defun get-frag-data-location (program name)
+  (with-foreign-string (s name)
+    (%gl:get-frag-data-location program s)))
+
+(defun bind-frag-data-location (program color name)
+  (with-foreign-string (s name)
+    (%gl:bind-frag-data-location program color s)))
+
+
+(defun get-frag-data-location-ext (program name)
+  (with-foreign-string (s name)
+    (%gl:get-frag-data-location-ext program s)))
+
+(defun bind-frag-data-location-ext (program color name)
+  (with-foreign-string (s name)
+    (%gl:bind-frag-data-location-ext program color s)))

gl/state.lisp

@@ -584,23 +584,54 @@
 (defun gl3-minor-version ()
   (get-integer :GL_MINOR_VERSION))
 
+(defun parse-gl-version-string-values (string)
+  ;; major version is integer value up to first #\.
+  ;; minor version is integer from first #\. to a #\. or #\space
+  (let ((dot (position #\. string)))
+    (values
+     (values (parse-integer string :end dot :junk-allowed t)) ; major
+     (if dot ; minor
+         (values (parse-integer string :start dot :junk-allowed t))
+         0))))
+
+(defun parse-gl-version-string-float (string)
+  (let* ((dot nil)
+         (end (position-if-not (lambda (c) (or (digit-char-p c)
+                                               (and (char= c #\.)
+                                                    (not dot)
+                                                    (setf dot t))))
+                               string)))
+    (read-from-string string nil 0.0 :end end)))
+
+;; external
+(defun gl-version ()
+  (parse-gl-version-string-float (get-string :version)))
+
+
 
 ;; external
 (defun major-version ()
-  ;; major version is integer value up to first #\.
-  (let* ((version (get-string :version))
-         (dot (position #\. version)))
-    (values (parse-integer version :end dot :junk-allowed t))))
+  (values (parse-gl-version-string-values (get-string :version))))
 
 
 ;; external
 (defun minor-version ()
-  ;; minor version is integer from first #\. to a #\. or #\space
-  (let* ((version (get-string :version))
-         (dot (position #\. version)))
-    (if dot
-        (values (parse-integer version :start dot))
-        0)))
+  (nth-value 1 (parse-gl-version-string-values (get-string :version))))
+
+;; external
+(defun glsl-version ()
+  (parse-gl-version-string-float (get-string :shading-language-version)))
+
+;; external
+(defun glsl-major-version ()
+  (values (parse-gl-version-string-values (get-string :shading-language-version))))
+
+;; external
+(defun glsl-minor-version ()
+  (nth-value 1 (parse-gl-version-string-values (get-string :shading-language-version))))
+
+
+
 
 ;; external
 (defun gl3-extension-present-p (name)
@@ -737,3 +768,30 @@ currently implemented for speed, so avoid in inner loops"
      (push-client-attrib ,attributes)
      (multiple-value-prog1 (progn ,@body)
        (pop-client-attrib))))
+
+;;; not sure these are actually useful, so not exported for now...
+
+(defmacro features-present-p (&body options)
+  "Returns true if any of the forms in body are true after substitution for
+:major :minor as major and minor version, and \"ARB_foo\" for presence of
+named GL extension
+ ex: (features-present-p (> :major 3) (and (> :major 2) \"ARB_texture_rg\"))"
+  (labels ((build-tests (list)
+             (mapcar (lambda (x)
+                       (cond
+                         ((stringp x) `(extension-present-p ,x))
+                         ((eq x :major-version) `(major-version))
+                         ((eq x :minor-version) `(minor-version))
+                         ((listp x) (build-tests x))
+                         (t x)))
+                     list)))
+    `(or ,@(build-tests options))))
+
+;;; throw an error if gl version isn't high enough, or required
+;;; extensions are missing
+;;; fixme: need better error msg, either as argument, or from parsing options?
+(defmacro ensure-features (&body options)
+  `(unless (features-present-p ,@options)
+     (error "GL implementation doesn't meet minimum requirements, need~% ~s" '(or ,@options))))
+
+;;(features-present-p (> :major-version 3) (and (> :major-version 2) "ARB_texture_rg"))