Add a facility to create shaders from lisp code

For now, only the global variables are generated by lisp code. The code
of the main function is specified as is in a string.

src/render/shader/glsl-compiler.lisp

@@ -0,0 +1,92 @@
+#|
+  This file is a part of stoe project.
+  Copyright (c) 2014 Renaud Casenave-Péré (renaud@casenave-pere.fr)
+|#
+
+(in-package :cl-user)
+(defpackage stoe.shader.glsl-compiler
+  (:nicknames :glsl-compiler)
+  (:use :cl :utils)
+  (:export :make-shader))
+(in-package :stoe.shader.glsl-compiler)
+
+(defvar +default-version+ '(330 :core))
+(defvar +profile-names+ '(:core :compatibility))
+(defvar +interpolation-qualifiers+ '(:flat :noperspective :smooth))
+
+(defstruct sh-version
+  (number 0 :read-only t)
+  (profile nil :read-only t))
+
+(defstruct sh-variable
+  (name "" :read-only t)
+  (type :int :read-only t)
+  (qualifier :in :read-only t)
+  (array 1 :read-only t)
+  (location nil :read-only t)
+  (interp nil :read-only t))
+
+(defstruct (shader (:constructor %make-shader))
+  (name "" :read-only t)
+  (version nil :read-only t)
+  (inputs nil :read-only t)
+  (outputs nil :read-only t)
+  (uniforms nil :read-only t)
+  (code "" :read-only t))
+
+(defun compile-shader-version (version)
+  (format nil "#version ~a~@[ ~(~a~)~]~%" (sh-version-number version) (sh-version-profile version)))
+
+(defun fix-name-convention (cl-name)
+  "Convert a variable name in common-lisp convention to a glsl compliant name."
+  (substitute #\_ #\- cl-name))
+
+(defun compile-shader-variables (vars)
+  (apply #'concatenate 'string
+         (loop for var in vars
+            collect (format nil "~@[layout (location = ~a) ~]~@[~(~a~) ~]~(~a~) ~(~a~) ~(~a~)~[~;~:;[~:*~a]~];~%"
+                            (sh-variable-location var)
+                            (sh-variable-interp var)
+                            (sh-variable-qualifier var)
+                            (sh-variable-type var)
+                            (fix-name-convention (sh-variable-name var))
+                            (sh-variable-array var)))))
+
+(defun compile-shader-main (body)
+  (format nil "void main ()~%{~%~a~%}~%" body))
+
+(defun process-version (spec)
+  (make-sh-version :number (if (numberp (car spec)) (car spec) (car +default-version+))
+                   :profile (if (and (cdr spec) (member (cadr spec) +profile-names+))
+                                (cadr spec)
+                                (car +profile-names+))))
+
+(defun process-variable-1 (qualifier spec)
+  (make-sh-variable :name (symbol-name (car spec))
+                    :type (cadr spec)
+                    :qualifier qualifier
+                    :array (getf (cddr spec) :array 1)
+                    :location (getf (cddr spec) :location nil)
+                    :interp (safe-first (member (getf (cddr spec) :interp) +interpolation-qualifiers+))))
+
+(defun process-variables (qualifier specs)
+  (loop for spec in specs
+     collect (process-variable-1 qualifier spec)))
+
+(defun compile-shader (version inputs outputs uniforms body)
+  "Compile a shader's data into a string containing the shader in glsl."
+  (concatenate 'string
+               (compile-shader-version version)
+               (compile-shader-variables inputs)
+               (compile-shader-variables outputs)
+               (compile-shader-variables uniforms)
+               (compile-shader-main body)))
+
+(defun make-shader (name args body)
+  (let* ((version (process-version (safe-list (getf args :version))))
+         (inputs (process-variables :in (getf args :in)))
+         (outputs (process-variables :out (getf args :out)))
+         (uniforms (process-variables :uniform (getf args :uniform)))
+         (code (compile-shader version inputs outputs uniforms (safe-first body))))
+    (%make-shader :name (symbol-name name) :version version :inputs inputs
+                  :outputs outputs :uniforms uniforms :code code)))

src/render/shader/shader.lisp

@@ -0,0 +1,22 @@
+#|
+  This file is a part of stoe project.
+  Copyright (c) 2014 Renaud Casenave-Péré (renaud@casenave-pere.fr)
+|#
+
+(in-package :cl-user)
+(defpackage stoe.shader
+  (:nicknames :shader)
+  (:use :cl :utils)
+  (:export :defshader))
+(in-package :stoe.shader)
+
+(defvar *shader-db* (make-hash-table :test 'eq)
+  "The database containing all the shaders defined with `defshader'.")
+
+(defun %defshader (name args body)
+  (setf (gethash name *shader-db*) (glsl-compiler:make-shader name args body)))
+
+(defmacro defshader (name args &body body)
+  "Define a new shader in common-lisp style.
+The shader will be compiled in shader language and added to the pool."
+  `(%defshader ',name ',args ',body))

stoe.asd

@@ -50,6 +50,10 @@
                  (:module "render"
                           :components
                           ((:file "gl-utils")
+                           (:module "shader"
+                                    :components
+                                    ((:file "glsl-compiler")
+                                     (:file "shader")))
                            (:file "render"))
                           :depends-on ("modules" "utils"))
                  (:file "stoe"