blob: d79f7bff71a6f14cd8e2d6867bb072f43931d100 (
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
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
|
;;;; units/text.lisp
(in-package #:wheelwork)
(defclass/std text (unit interactive)
((font :with :ri :std (error "A font is required") :type font)
(content :with :ri :std "")
(color :with :std #(1.0 1.0 1.0 1.0))
(vao elem-count newlines :r)
(shader :with :static :r)))
(defmethod model-matrix ((text text))
(let ((m (mat:meye 4)))
(with-slots (font newlines x y base-width base-height scale-x scale-y rotation) text
(let* ((text-height
(cl-fond:text-height (font-object font)))
(baseline-offset
(* newlines text-height))
(rotation-baseline-offset
(* 2 newlines text-height )))
(mat:nmtranslate m (vec:vec x
(+ y
(*
scale-y
baseline-offset))
0.0))
(mat:nmtranslate m (vec:v* 0.5 (vec:vec (* scale-x base-width)
(* scale-y (- base-height rotation-baseline-offset) )
0.0)))
(mat:nmrotate m vec:+vz+ rotation)
(mat:nmtranslate m (vec:v* -0.5 (vec:vec (* scale-x base-width )
(* scale-y (- base-height rotation-baseline-offset))
0.0))))
(mat:nmscale m (vec:vec scale-x scale-y 1.0))
m)))
(defvar *text-shader-program* nil)
(defun make-shared-text-gpu-objects ()
(unless *text-shader-program*
(setf *text-shader-program*
(create-shader
'(:vertex
((vert :vec2) (col :vec2))
((transform :mat4))
((values
(* transform (vari:vec4 vert 0.0 1.0))
col)))
'(:fragment
((tc :vec2))
((tex :sampler-2d)
(color :vec4))
((* color (aref (vari:texture tex tc) 0)))))))
(unless (pre-exit-hook-exists-p :text-gpu-resources)
(pre-exit-hook
:text-gpu-resources
(lambda ()
(when *text-shader-program*
(gl:delete-program *text-shader-program*)
(setf *text-shader-program* nil))))))
(defmethod initialize-instance :after ((text text) &key)
(with-slots (content newlines font vao elem-count base-width base-height scale-x scale-y) text
(make-shared-text-gpu-objects)
(multiple-value-bind (vao% count%) (cl-fond:compute-text (font-object font) content)
(setf vao vao%
elem-count count%))
(setf newlines (count #\newline content))
(let* ((extent
(cl-fond:compute-extent (font-object font) content))
(l
(getf extent :l))
(r
(getf extent :r)))
(setf base-width (- r l)
base-height (* (cl-fond:text-height (font-object font))
(1+ newlines))))))
(defmethod cleanup ((text text))
(with-slots (vao) text
(when vao
(gl:delete-vertex-arrays (list vao)))
(setf vao nil)))
(defmethod render ((text text))
(with-slots (font vao elem-count color) text
(gl:use-program *text-shader-program*)
(gl:active-texture 0)
(gl:bind-texture :texture-2d (cl-fond:texture (font-object font)))
(gl:program-uniform-matrix-4fv
*text-shader-program*
(gl:get-uniform-location *text-shader-program* "TRANSFORM")
(projected-matrix text))
(gl:program-uniformi
*text-shader-program*
(gl:get-uniform-location *text-shader-program* "TEX")
0)
(gl:program-uniformfv
*text-shader-program*
(gl:get-uniform-location *text-shader-program* "COLOR")
color)
(gl:bind-vertex-array vao)
(%gl:draw-elements :triangles elem-count :unsigned-int 0)
(gl:bind-vertex-array 0)))
|
