blob: 4bba7b845d8862f7c70a2be84b747a9cf5f62177 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
|
;;;; shader.lisp
(in-package #:wheelwork)
(defun shader-by-type (type)
(case type
(:vertex :vertex-shader)
(:geometry :geometry-shader)
(:fragment :fragment-shader)))
(defun gl-shader (type stage)
(let ((shader (gl:create-shader type)))
(gl:shader-source shader (varjo:glsl-code stage))
(gl:compile-shader shader)
(unless (gl:get-shader shader :compile-status)
(error "failed to compile ~a shader:~%~a~%"
type (gl:get-shader-info-log shader)))
shader))
(defun create-shader (&rest sources)
(let* ((stages
(varjo:rolling-translate
(mapcar (lambda (source)
(destructuring-bind (type inputs uniforms code) source
(varjo:make-stage type inputs uniforms '(:330) code)))
sources)))
(shaders
(loop
:for stage :in stages
:for source :in sources
:collect (gl-shader (shader-by-type (car source))
stage)))
(program (gl:create-program)))
(dolist (shader shaders) (gl:attach-shader program shader))
(gl:link-program program)
(unless (gl:get-program program :link-status)
(error "failed to link program: ~%~a~%"
(gl:get-program-info-log program)))
(dolist (shader shaders)
(gl:detach-shader program shader)
(gl:delete-shader shader))
program))
|
