Renaud Casenave-Péré
a79a06ef00
For now, only the global variables are generated by lisp code. The code of the main function is specified as is in a string.
92 lines
3.5 KiB
Common Lisp
92 lines
3.5 KiB
Common Lisp
#|
|
|
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)))
|