floss/stoe
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Transform common-lisp symbols into glsl compliant variable names

Browse source
This commit is contained in:
Renaud Casenave-Péré 2015-04-04 23:38:01 +02:00
parent 5cc428df88
commit c66e3c62e8
1 changed files with 16 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

20
src/render/shader/glsl.lisp
View file

@ -28,6 +28,14 @@
"Configure the verbosity of the compiler. "Configure the verbosity of the compiler.
if non-nil, the dsl will be printed in comments together with the glsl code.") if non-nil, the dsl will be printed in comments together with the glsl code.")
(defvar *glsl-symbols* '(gl-position "gl_Position")
"Keep a table of reserved glsl symbols.")
(defun glsl-name (cl-name)
"Convert a variable name in common-lisp convention to a glsl compliant name."
(or (getf *glsl-symbols* cl-name)
(string-downcase (substitute #\_ #\- (symbol-name cl-name)))))
(defmacro noop-handler (body) (defmacro noop-handler (body)
`(format nil "/* ~((~{~a~^ ~})~) */~%" ,body)) `(format nil "/* ~((~{~a~^ ~})~) */~%" ,body))
@ -69,7 +77,7 @@ the forms comprised of these keywords will be printed in comments."
(let ((vars (loop for s in pairs by #'cddr collect s))) (let ((vars (loop for s in pairs by #'cddr collect s)))
(let ((expanded (loop for n in vars (let ((expanded (loop for n in vars
for r in (rest pairs) by #'cddr for r in (rest pairs) by #'cddr
collect n collect (walk-1 r)))) collect (glsl-name n) collect (walk-1 r))))
(format nil "~@[~vt~]~{~(~a~) = ~(~a~)~^;~%~}" (format nil "~@[~vt~]~{~(~a~) = ~(~a~)~^;~%~}"
(when (> *current-indent* 0) (when (> *current-indent* 0)
*current-indent*) *current-indent*)
@ -77,10 +85,14 @@ the forms comprised of these keywords will be printed in comments."
(defhandler (+ - * / %) (op &rest body) (defhandler (+ - * / %) (op &rest body)
"Handle the standard infix operations." "Handle the standard infix operations."
(flet ((oper (a b) (labels ((expand (a)
(cond
((listp a) (format nil "(~a)" (walk-1 a)))
((symbolp a) (glsl-name a))
(t a)))
(oper (a b)
(format nil "~a ~(~a~) ~a" (format nil "~a ~(~a~) ~a"
(if (listp a) (format t "(~a)" (walk-1 a)) a) op (expand a) op (expand b))))
(if (listp b) (format nil "(~a)" (walk-1 b)) b))))
(reduce #'oper body))) (reduce #'oper body)))
(defun default-handler (first &rest rest) (defun default-handler (first &rest rest)