diff --git a/src/render/render.lisp b/src/render/render.lisp index f52d71a..97881b6 100644 --- a/src/render/render.lisp +++ b/src/render/render.lisp @@ -14,7 +14,7 @@ (defun initialize (&optional argv) "Initialize the render module. -Create an opengl context attach to a window." +Create an opengl context attached to a window and initialize the shader system." (format t "Initialize Render module~%") (let ((title (get-command-line-option argv "--title" "Stoe")) (width (get-command-line-option-int argv "--width" 800)) @@ -28,12 +28,14 @@ Create an opengl context attach to a window." :minor gl-utils:*minor-version*))) (progn (setf *window* (glop:create-window title width height)) - (gl-utils:initialize 0))))) + (gl-utils:initialize 0))) + (shader:compile-all-shaders))) (defun finalize () "Finalize the render module. Destroy the opengl context and the related resources." (format t "Finalize Render module~%") + (shader:destroy-all-shaders) (glop:destroy-window *window*) (setf *window* nil)) diff --git a/src/render/shader/glsl-compiler.lisp b/src/render/shader/glsl-compiler.lisp index 3734510..75dd4d8 100644 --- a/src/render/shader/glsl-compiler.lisp +++ b/src/render/shader/glsl-compiler.lisp @@ -39,7 +39,7 @@ (defun fix-name-convention (cl-name) "Convert a variable name in common-lisp convention to a glsl compliant name." - (substitute #\_ #\- cl-name)) + (string-downcase (substitute #\_ #\- cl-name))) (defun compile-shader-variables (vars) (apply #'concatenate 'string diff --git a/src/render/shader/shader.lisp b/src/render/shader/shader.lisp index 9138e7a..254cf94 100644 --- a/src/render/shader/shader.lisp +++ b/src/render/shader/shader.lisp @@ -7,9 +7,22 @@ (defpackage stoe.shader (:nicknames :shader) (:use :cl :utils) - (:export :defshader)) + (:export :defshader + :defprogram + :compile-all-shaders + :destroy-all-shaders)) (in-package :stoe.shader) +(defpackage %stoe.shaders + (:documentation "Package used to hold the symbols for the shader programs defined by defprogram.")) + +(defstruct program + (name "" :read-only t) + (stages nil :read-only t) + attribs + uniforms + gl-program) + (defvar *shader-db* (make-hash-table :test 'eq) "The database containing all the shaders defined with `defshader'.") @@ -19,4 +32,114 @@ (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.shader::%defshader ',name ',args ',body)) + +(defun %defprogram (name args body) + (declare (ignore args)) + (let ((components (mapcar #'(lambda (comp) + (cons (first comp) (gethash (second comp) *shader-db*))) + (group body 2)))) + (make-program :name (symbol-name name) :stages components))) + +(defmacro defprogram (name args &body body) + "Define a new program comprised of all the specified shaders." + (let ((symbol (intern (symbol-name name) :%stoe.shaders))) + `(progn + (set ',symbol (stoe.shader::%defprogram ',symbol ',args ',body)) + ',symbol))) + +(defun compile-shader (type shader) + "Compile the shader into opengl." + (let ((shader-obj (gl-utils:gl-assert (gl:create-shader type)))) + (when (= shader-obj 0) + (error "Couldn't create shader object.")) + (handler-case + (progn + (gl-utils:gl-assert (gl:shader-source shader-obj (glsl-compiler::shader-code shader))) ; Not great… + (gl-utils:gl-assert (gl:compile-shader shader-obj)) + (unless (gl:get-shader shader-obj :compile-status) + (error "Compile failure in ~(~s~) shader:~%~2i~a~%" type (gl:get-shader-info-log shader-obj))) + shader-obj) + (error (condition) + (gl:delete-shader shader-obj) + (error condition))))) + +(defun initialize-program (program) + "Initialize the program. +Retrieve the attributes and uniform locations." + (let* ((shader (cdr (first (program-stages program)))) + (inputs (glsl-compiler::shader-inputs shader)) + (uniforms (glsl-compiler::shader-uniforms shader))) + (labels ((get-var-with-location (var fun) + (list (glsl-compiler::sh-variable-name var) + (glsl-compiler::sh-variable-type var) + (glsl-compiler::sh-variable-array var) + (aif (glsl-compiler::sh-variable-location var) + it + (apply fun (program-gl-program program) (list (glsl-compiler::fix-name-convention + (glsl-compiler::sh-variable-name var))))))) + (get-attrib (var) + (get-var-with-location var #'gl:get-attrib-location)) + (get-uniforms (var) + (get-var-with-location var #'gl:get-uniform-location))) + (setf (program-attribs program) (mapcar #'get-attrib inputs)) + (setf (program-uniforms program) (mapcar #'get-uniforms uniforms))))) + +(defun compile-program (program-symbol) + "Compile and link the program." + (loop + (restart-case + (return + (let ((program (symbol-value program-symbol))) + (unless program + (error "The program ~s is undefined." program-symbol)) + (let (compiled-shaders) + (unwind-protect + (progn + (loop for shader in (program-stages program) + do (push (compile-shader (car shader) (cdr shader)) compiled-shaders)) + (let ((program-obj (gl-utils:gl-assert (gl:create-program)))) + (when (= program-obj 0) + (error "Couldn't create program object.")) + (unwind-protect + (progn + (mapc (lambda (shader) (gl-utils:gl-assert (gl:attach-shader program-obj shader))) + compiled-shaders) + (gl-utils:gl-assert (gl:link-program program-obj)) + (unless (gl:get-program program-obj :link-status) + (error "Link failure in shader program ~s:~%~2i~a~%" program-symbol + (gl:get-program-info-log program-obj))) + (setf (program-gl-program program) program-obj) + (initialize-program program)) + (mapc (lambda (shader) (gl:detach-shader program-obj shader)) + (gl:get-attached-shaders program-obj))))) + (mapc (lambda (shader) (gl:delete-shader shader)) compiled-shaders))))) + (retry () :report (lambda (stream) (format stream "Retry compiling the shader program ~S." program-symbol)))))) + +(defun delete-program (program-symbol) + "Delete the program bound to PROGRAM-SYMBOL." + (let ((program (symbol-value program-symbol))) + (when (program-gl-program program) + (gl:delete-program (program-gl-program program))))) + +(defun compile-all-shaders () + "Compile and link all the shaders into opengl." + (let ((cmp-message "Compiling shaders") + ;; Count the columns used by the progress message + ;; if it goes on for more than max-columns, continue on the next line + (max-columns 80)) + (format t cmp-message) + (loop for i upfrom (length cmp-message) + for program-symbol being the symbol in :%stoe.shaders + do (progn + (when (> i max-columns) + (format t "~%") + (setf i 0)) + (format t ".") + (compile-program program-symbol))))) + +(defun destroy-all-shaders () + "Destroy the programs registered in opengl." + (format t "Deleting shaders") + (loop for program-symbol being the symbol in :%stoe.shaders + do (delete-program program-symbol)))