-
Notifications
You must be signed in to change notification settings - Fork 24
/
Copy pathtexture.lisp
244 lines (209 loc) · 7.56 KB
/
texture.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
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
;;;; texture.lisp
;;;; Please see the licence.txt for the CLinch
(in-package #:clinch)
(defparameter *default-texture* nil)
(defparameter *identity-texture* nil)
(defclass texture ()
((tex-id
:accessor tex-id
:initform nil
:initarg :tex-id)
(width
:reader width
:initform nil
:initarg :width)
(height
:reader height
:initform nil
:initarg :height)
(type
:accessor qtype
:initarg :qtype
:initform :unsigned-char)
(internal-format
:accessor internal-format
:initform :rgba
:initarg :internal-format)
(data-format
:accessor data-format
:initform :bgra
:initarg :format)
(stride
:reader Stride
:initform 4
:initarg :stride)
(key :initform (gensym "texture")
:reader key))
(:documentation "Creates and keeps track of a texture object. Can be used with a pixelbuffer to speed things up."))
(defmethod initialize-instance :after ((this texture)
&key
(PBO nil)
(wrap-s :repeat)
(wrap-t :repeat)
(mag-filter :linear)
(min-filter :linear)
depth-texture-mode
texture-compare-mode
texture-compare-function
data)
"Sets up a texture instance with gc finalizer. Do not depend on finalizers, release resources manually if you can.
type: cffi type NOTE: use :unsigned-int if you are creating an index buffer.
id: OpenGL buffer id
stride: The number of values in each pixel.
usage: Tells OpenGL how often you wish to access the buffer.
loaded: Has data been put into the buffer. Buffers without data is just future storage, just be sure to set it before you use it.
format: The OpenGL Format of the Color Data. blue-green-red-alpha is default and prefered for simplicity.
wrap-s & wrap-t: Wrap texture vertical or horizontal.
mag-filter & min-filter: Magnification an minimization method."
(with-slots ((tex-id tex-id)
(w width)
(h height)
(dtype type)
(eformat data-format)
(iformat internal-format)) this
(sdl2:in-main-thread ()
(unless tex-id (setf tex-id (car (gl:gen-textures 1))))
(trivial-garbage:cancel-finalization this)
(add-uncollected this)
(trivial-garbage:finalize this
(let ((tex-id-value tex-id)
(key (key this)))
(lambda () (sdl2:in-main-thread (:background t)
(gl:delete-textures (list tex-id-value))))))
(gl:bind-texture :texture-2d (tex-id this))
(gl:tex-parameter :texture-2d :texture-wrap-s wrap-s)
(gl:tex-parameter :texture-2d :texture-wrap-t wrap-t)
(gl:tex-parameter :texture-2d :texture-mag-filter mag-filter)
(gl:tex-parameter :texture-2d :texture-min-filter min-filter)
(when depth-texture-mode (gl:Tex-Parameter :TEXTURE-2D :DEPTH-TEXTURE-MODE depth-texture-mode))
(when texture-compare-mode (gl:Tex-Parameter :TEXTURE-2D :TEXTURE-COMPARE-MODE texture-compare-mode))
(when texture-compare-function (gl:Tex-Parameter :TEXTURE-2D :TEXTURE-COMPARE-func texture-compare-function))
(cond (pbo (pushg this pbo))
((cffi:pointerp data) (data-from-pointer this data))
((listp data) (data-from-list this data))
(t (data-from-pointer this data)))
tex-id)))
(defmethod data-from-pointer ((this texture) pointer)
(bind this)
(gl:tex-image-2d :texture-2d 0
(internal-format this)
(width this)
(height this)
0
(data-format this)
(cffi-type->gl-type (qtype this))
pointer))
(defmethod data-from-list ((this texture) lst)
(data-from-pointer this nil)
(let ((data (pullg this)))
(loop for x from 0 below (length lst)
for i in lst
do (setf (elt data x) i))
(pushg this data)))
(defmethod get-size ((this texture) &key)
"Calculates the number of VALUES (stride * vcount) or (stride * width * height) this buffer contains."
(* (stride this)
(* (width this) (height this))))
(defmethod size-in-bytes ((this texture))
"Calculates how many bytes this buffer consists of."
(*
(get-size this)
(cffi:foreign-type-size (slot-value this 'type))))
(defmethod bind ((this texture) &key )
"Wrapper around glBindBuffer. Puts the texture into play."
(gl:bind-texture :texture-2d (tex-id this)))
(defmethod unbind ((this texture) &key )
"Unbinds the texture."
(gl:bind-texture :texture-2d 0))
(defmethod pushg ((this texture) (pbo pixel-buffer) &key)
"Sets the texture data from a pixel buffer."
(!
(bind pbo)
(bind this)
(gl:Tex-Image-2D :texture-2d 0 (internal-format this) (width this) (height this) 0 :bgra (cffi-type->gl-type (qtype this)) (cffi:null-pointer))
(unbind this)
(unbind pbo)))
(defmethod make-pbo-for-texture ((this texture) &key (usage :static-draw) (target :pixel-unpack-buffer))
"Returns a compatible pixel buffer for a texture."
(!
(make-instance 'pixel-buffer
:count (get-size this)
:qtype (qtype this)
:stride (stride this)
:usage usage
:target target)))
(defmethod pullg ((tex texture) &key data-format)
"Gets the texture data as a vector array."
(let ((arr (cffi:make-shareable-byte-vector (size-in-bytes tex))))
(cffi:with-pointer-to-vector-data (p arr)
(!
(bind tex)
(%gl:get-tex-image :texture-2d
0
(or data-format (data-format tex))
(clinch::cffi-type->gl-type (qtype tex))
p))
arr)))
(defmethod pushg ((tex texture) (data array) &key)
"Sets the texture data from a vector array."
(cffi:with-pointer-to-vector-data (p data)
(!
(gl:bind-buffer :pixel-unpack-buffer 0)
(bind tex)
(gl:tex-image-2d :texture-2d
0
(clinch::internal-format tex)
(width tex)
(height tex)
0
(data-format tex)
(clinch::cffi-type->gl-type (qtype tex))
p)))
data)
(defmethod bind-sampler ((this texture) shader-program name tex-unit)
"Shader-Programs pass information by using named values called Uniforms. Textures are passed using Samplers. This sets a texture-unit to a sampler uniform"
(gl:active-texture (+ (cffi:foreign-enum-value '%gl:enum :texture0) tex-unit))
(attach-uniform shader-program name tex-unit)
(gl:bind-texture :texture-2d (tex-id this)))
(defmethod unload ((this texture) &key)
"Unloads the texture. Also cancels gc finalization."
(trivial-garbage:cancel-finalization this)
(remove-uncollected this)
(!
(when (tex-id this)
(gl:delete-textures (list (tex-id this))))))
(defmacro with-texture ((tex) &body body)
`(let ((*texture* ,tex))
,@body))
(defmacro with-temporary-pbo ((var texture &key (usage :static-draw) (target :pixel-unpack-buffer)) &body body)
"Creates a temporary pixel buffer for a texture."
(let ((tex (gensym)))
`(let* ((,tex ,texture)
(,var (make-pbo-for-texture ,tex :usage ,usage :target ,target)))
(unwind-protect
(progn ,@body)
(progn
(unload ,var))))))
(defmethod set-texture-color ((this texture) r g b &optional (a 1.0))
(let ((data (pullg this)))
(dotimes (i (length data))
(setf (aref data i)
(case (mod i 4)
(0 (ceiling (* b 255)))
(1 (ceiling (* g 255)))
(2 (ceiling (* r 255)))
(3 (ceiling (* a 255))))))
(pushg this data)
this))
(defun get-identity-texture ()
"Creates/returns a 1x1 texture with the values (1.0, 1.0, 1.0, 1.0).
This is a nice placeholder when you don't want a custom shader."
(if *identity-texture*
*identity-texture*
(setf *identity-texture*
(make-instance 'clinch:texture
:data '(255 255 255 255)
:width 1
:height 1
:stride 4
:qtype :unsigned-char))))