blob: 1b3a81735808e282a608eed07e018bd6f94300bc (
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
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
|
;;;; image.lisp
(in-package #:wheelwork)
(defvar *image-shader-program* nil
"Cached for later cleanup.")
(defvar *image-vao* nil)
(defvar *image-count* 0
"Used by finalizers to determin if the shader should be destroyed.")
(defun image-finalizer ()
"executed after a image has been reclaimed by gc. decrements image
count and destroys shader-program if necessary."
(decf *image-count*)
(unless (plusp *image-count*)
))
(defclass/std image (unit interactive)
((texture :ri :std (error "A image requires a texture."))))
(defun make-shared-image-gpu-objects ()
(unless *image-shader-program*
(setf *image-shader-program*
(create-shader
'(:vertex
((vert :vec2))
((transform :mat4))
((values
(* transform (vari:vec4 vert 0.0 1.0))
vert))) ;color
'(:fragment
((tc :vec2))
((tex :sampler-2d))
((let ((frag (vari:texture tex tc)))
(if (< (aref frag 3) 0.01)
(vari:discard)
frag))))))
(gl:program-uniformi
*image-shader-program*
(gl:get-uniform-location *image-shader-program* "TEX")
0))
(unless *image-vao*
(setf *image-vao* (gl:gen-vertex-array))
(gl:bind-vertex-array *image-vao*)
(let ((vbo (gl:gen-buffer)))
(with-gl-array (verts :float
0.0 1.0
1.0 0.0
0.0 0.0
0.0 1.0
1.0 1.0
1.0 0.0 )
(gl:bind-buffer :array-buffer vbo)
(gl:buffer-data :array-buffer :static-draw verts)))
(gl:enable-vertex-attrib-array 0)
(gl:vertex-attrib-pointer 0 2 :float 0 (* +float-size+ 2) 0)
(gl:bind-buffer :array-buffer 0)
(gl:bind-vertex-array 0))
(unless (pre-exit-hook-exists-p :image-gpu-resources)
(pre-exit-hook :image-gpu-resources
(lambda ()
(when *image-vao*
(gl:delete-vertex-arrays (list *image-vao*))
(setf *image-vao* nil))
(when *image-shader-program*
(gl:delete-program *image-shader-program*)
(setf *image-shader-program* nil))))))
(defmethod initialize-instance :after ((image image) &key)
(with-slots (base-width base-height texture) image
(setf base-height (texture-height texture)
base-width (texture-width texture))
(make-shared-image-gpu-objects)))
(defmethod render ((image image))
(with-slots (texture) image
(gl:active-texture 0)
(gl:bind-texture :texture-2d (texture-id texture))
(gl:use-program *image-shader-program*)
(gl:program-uniform-matrix-4fv
*image-shader-program*
(gl:get-uniform-location *image-shader-program* "TRANSFORM")
(projected-matrix image))
(gl:bind-vertex-array *image-vao*)
(gl:draw-arrays :triangles 0 6)
(gl:bind-vertex-array 0)))
|
