-
Notifications
You must be signed in to change notification settings - Fork 24
/
Copy pathshaders.lisp
124 lines (94 loc) · 3.23 KB
/
shaders.lisp
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
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
;;;; shaders.lisp
;;;; Please see the licence.txt for the CLinch
(in-package #:clinch)
(defclass shader ()
((name :reader name
:initform nil)
(id :initform nil
:initarg :id
:reader id)
(shader-type :initform nil
:initarg :shader-type
:reader shader-type)
(attributes :reader shader-attributes
:initform nil)
(uniforms :reader shader-uniforms
:initform nil)
(key :initform (gensym "shader")
:reader key))
(:documentation "Base class for all individual shaders."))
(defclass vertex-shader (shader)
((shader-type :initform :vertex-shader))
(:documentation "Vertex Shader Class."))
(defclass fragment-shader (shader)
((shader-type :initform :fragment-shader))
(:documentation "Fragment Shader Class."))
(defclass geometry-shader (shader)
((shader-type :initform :geometry-shader))
(:documentation "Geometry Shader Class."))
(defmethod initialize-instance :after ((this shader) &key code defs undefs)
"Creates a shader."
(when code
(!
(with-slots ((id id) (key key)) this
(shader-compile this :code code :defs defs :undefs undefs)))))
(defmethod add-finalizer ((this shader))
(trivial-garbage:cancel-finalization this)
(add-uncollected this)
(trivial-garbage:finalize
this
(let ((val (id this))
(key (key this)))
(lambda ()
(remhash key *uncollected*)
(sdl2:in-main-thread (:background t)
(gl:delete-shader val))))))
(defmethod shader-compile ((this shader) &key code defs undefs)
(when (null code) (error "No code to build shader!"))
(!
(let ((old-id (id this)))
(setf (slot-value this 'id) (make-shader this))
(when old-id
(gl:delete-shader old-id)))
(gl:shader-source (id this) (concatenate 'string
(format nil "~{#define ~A~%~}" defs)
(format nil "~{#undef ~A~%~}" undefs)
code))
(gl:compile-shader (id this)))
(unless (> (id this) 0)
(error "Could not create a shader object!"))
(let ((err (gl:get-shader (id this) :compile-status)))
(unless err
(error (format nil "Could not compile shader: ~A" (gl:get-shader-info-log (id this))))))
(add-finalizer this))
(defmethod make-shader ((this vertex-shader))
"Creates a vertex shader."
(setf (slot-value this 'id)
(gl:create-shader :vertex-shader)))
(defmethod make-shader ((this fragment-shader))
"Creates a fragment shader."
(setf (slot-value this 'id)
(gl:create-shader :fragment-shader)))
(defmethod make-shader ((this geometry-shader))
"Creates a geometry shader."
(setf (slot-value this 'id)
(gl:create-shader :geometry-shader)))
(defmethod shader-source ((this shader))
(with-slots ((id id)) this
(!
(list (cffi:foreign-enum-keyword '%gl::enum
(gl:get-shader id :shader-type))
(! (gl:get-shader-source id))))))
(defmethod (setf shader-source) ((code string) (this shader))
(shader-compile this :code code))
(defmethod unload ((this shader) &key)
"Unloads and releases the shader."
(with-slots ((id id))
(trivial-garbage:cancel-finalization this)
(remove-uncollected this)
(when id
(gl:delete-shader id))
(setf id nil
(slot-value this 'uniforms) nil
(slot-value this 'attributes) nil
(slot-value this 'name) nil)))