aboutsummaryrefslogtreecommitdiffhomepage
path: root/wheelwork.lisp
diff options
context:
space:
mode:
Diffstat (limited to 'wheelwork.lisp')
-rw-r--r--wheelwork.lisp45
1 files changed, 29 insertions, 16 deletions
diff --git a/wheelwork.lisp b/wheelwork.lisp
index 2ce7179..fe6914e 100644
--- a/wheelwork.lisp
+++ b/wheelwork.lisp
@@ -704,27 +704,38 @@ ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz01234567890\".,!?-'" )
((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 :r)
+ (vao elem-count newlines :r)
(shader :with :static :r)))
(defmethod model-matrix ((text text))
(let ((m (mat:meye 4)))
- (with-slots (x y base-width base-height scale-x scale-y rotation) text
- (mat:nmtranslate m (vec:vec x y 0.0))
-
- (mat:nmtranslate m (vec:v* 0.5 (vec:vec (* scale-x base-width)
- (* scale-y base-height)
- 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)
- 0.0)))
+ (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))
+ (mat:nmscale m (vec:vec scale-x scale-y 1.0))
+ m)))
(defmethod initialize-instance :after ((text text) &key)
- (with-slots (content font vao elem-count shader base-width base-height scale-x scale-y) text
+ (with-slots (content newlines font vao elem-count shader base-width base-height scale-x scale-y) text
(unless shader
(setf shader
(create-shader
@@ -742,9 +753,11 @@ ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz01234567890\".,!?-'" )
(multiple-value-bind (vao% count%) (cl-fond:compute-text (font-object font) content)
(setf vao vao%
elem-count count%))
- (hq:with-plist (l r (top t) b) (cl-fond:compute-extent (font-object font) content)
+ (setf newlines (count #\newline content))
+ (hq:with-plist (l r) (cl-fond:compute-extent (font-object font) content)
(setf base-width (- r l)
- base-height (+ top b)))))
+ base-height (* (cl-fond:text-height (font-object font))
+ (1+ newlines))))))
(defmethod cleanup ((text text))
(with-slots (vao shader) text