116 lines
4.4 KiB
Common Lisp
116 lines
4.4 KiB
Common Lisp
#|
|
|
This file is a part of stoe project.
|
|
Copyright (c) 2015 Renaud Casenave-Péré (renaud@casenave-pere.fr)
|
|
|#
|
|
|
|
(uiop:define-package :stoe/shader/shader
|
|
(:use :cl :stoe/core/utils :stoe/engine/gl-utils)
|
|
(:export #:make-shader
|
|
#:make-var
|
|
#:make-exp
|
|
#:merge-shaders
|
|
#:shader-version
|
|
#:shader-vars
|
|
#:shader-exp
|
|
#:var-symb
|
|
#:var-name
|
|
#:var-qualifiers
|
|
#:var-target
|
|
#:var-exp
|
|
#:make-program
|
|
#:program-stages
|
|
#:program-vars
|
|
#:program-id
|
|
#:get-location
|
|
#:using-program
|
|
#:with-locations))
|
|
(in-package :stoe/shader/shader)
|
|
|
|
(defstruct shader
|
|
"Structure containing the shader in glsl format together with metadata used to
|
|
properly handle the shader."
|
|
(version nil)
|
|
(vars nil)
|
|
(exp ""))
|
|
|
|
(defstruct (var (:constructor %make-var))
|
|
"Structure containing the shader variable in glsl format together with its
|
|
attributes to properly handle the variable."
|
|
(symb nil)
|
|
(name "")
|
|
(type :none)
|
|
(qualifiers nil)
|
|
(exp ""))
|
|
|
|
(defun make-var (symb name type qualifiers exp)
|
|
"Creates and returns a new shader container to keep track of the variable
|
|
defined by the arguments."
|
|
(make-shader :vars (list (%make-var :symb symb
|
|
:name name
|
|
:type type
|
|
:qualifiers qualifiers
|
|
:exp exp))))
|
|
|
|
(defun var-target (var)
|
|
"Returns the target type of the variable. Either :in, :out or :uniform."
|
|
(first (member-if (lambda (x) (or (eq x :in)
|
|
(eq x :out)
|
|
(eq x :uniform)))
|
|
(var-qualifiers var))))
|
|
|
|
(defun make-exp (exp)
|
|
"Creates and returns a new shader container to keep track of the glsl
|
|
expression."
|
|
(make-shader :exp exp))
|
|
|
|
(defun merge-shaders (&rest shaders)
|
|
"Merges two or more shader containers and returns the result."
|
|
(labels ((sh-merge (sh1 sh2)
|
|
(make-shader :version (or (shader-version sh1) (shader-version sh2))
|
|
:vars (append (shader-vars sh1) (shader-vars sh2))
|
|
:exp (concatenate 'string (shader-exp sh1) (shader-exp sh2)))))
|
|
(reduce #'sh-merge shaders)))
|
|
|
|
(defstruct (program (:constructor %make-program))
|
|
"Structure containing the symbols of the different stages' shaders and the
|
|
associated in/out/uniform variables.
|
|
If the program is compiled into glsl, it keeps track of the object id."
|
|
(stages nil :read-only t)
|
|
vars
|
|
id)
|
|
|
|
(defun make-program (lambda-list stages)
|
|
"Creates a new program by using and analyzing the specified shaders."
|
|
(declare (ignore lambda-list))
|
|
(%make-program :stages stages
|
|
:vars (remove-duplicates
|
|
(reduce #'append
|
|
(loop for shader in (cdr stages) by #'cddr
|
|
collect (remove-if-not
|
|
(lambda (var)
|
|
(member-if (lambda (x) (or (eq x :in) (eq x :uniform)))
|
|
(var-qualifiers var)))
|
|
(shader-vars (symbol-value shader))))))))
|
|
|
|
(defun get-location (program var)
|
|
"Retrieve the location value of the variable in program."
|
|
(second (member :location (var-qualifiers (first (member (intern (symbol-name var) :keyword)
|
|
(program-vars program)
|
|
:key #'var-symb))))))
|
|
|
|
(defmacro using-program ((var program) &body body)
|
|
"Use the specified program and bind all its attributes and uniforms for use in BODY."
|
|
`(let ((,var (symbol-value (find-symbol (symbol-name ,program) :stoe/engine/shaders))))
|
|
(gl-assert (gl:use-program (program-id ,var)))
|
|
,@body
|
|
(gl-assert (gl:use-program 0))))
|
|
|
|
(defmacro with-locations (vars program &body body)
|
|
"Binds the programs uniforms into the corresponding symbols of vars, using the
|
|
same syntax as `with-accessors'."
|
|
`(let ,(mapcar (lambda (var)
|
|
(cond
|
|
((listp var) (list (first var) `(get-location ,program ',(second var))))
|
|
((symbolp var) (list var `(get-location ,program ',var)))))
|
|
vars)
|
|
,@body))
|