blob: caba48e25e4c0ca75eecd8a4cee32c1ff046197e (
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
|
;;;; units/text.lisp
(in-package #:wheelwork)
(defclass/std text (affine 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)))
(defmethod initialize-instance :after ((text text) &key)
(with-slots (content newlines font vao elem-count shader base-width base-height scale-x scale-y) text
(unless shader
(setf shader
(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)))))))
(multiple-value-bind (vao% count%) (cl-fond:compute-text (font-object font) content)
(setf vao vao%
elem-count count%))
(setf newlines (count #\newline content))
(hq:with-plist ((l :l) (r :r)) (cl-fond:compute-extent (font-object font) content)
(setf base-width (- r l)
base-height (* (cl-fond:text-height (font-object font))
(1+ newlines))))))
(defmethod cleanup ((text text))
(with-slots (vao shader) text
(gl:delete-vertex-arrays (list vao))
(when shader
(gl:delete-program shader))
(setf vao nil
shader nil)))
(defmethod render ((text text))
(with-slots (shader font vao elem-count color) text
(gl:use-program shader)
(gl:active-texture 0)
(gl:bind-texture :texture-2d (cl-fond:texture (font-object font)))
(gl:program-uniform-matrix-4fv
shader
(gl:get-uniform-location shader "TRANSFORM")
(projected-matrix text))
(gl:program-uniformi
shader
(gl:get-uniform-location shader "TEX")
0)
(gl:program-uniformfv
shader
(gl:get-uniform-location shader "COLOR")
color)
(gl:bind-vertex-array vao)
(%gl:draw-elements :triangles elem-count :unsigned-int 0)
(gl:bind-vertex-array 0)))
|
