From 32b46e127696aff405584e9b29f43c07feb0088d Mon Sep 17 00:00:00 2001
From: Colin Okay <colin@cicadas.surf>
Date: Tue, 28 Jun 2022 09:04:48 -0500
Subject: [modify] text init and model matrix to support multiline

---
 examples/03-font-render.lisp | 26 ++++++++++++++++++-------
 wheelwork.lisp               | 45 ++++++++++++++++++++++++++++----------------
 2 files changed, 48 insertions(+), 23 deletions(-)

diff --git a/examples/03-font-render.lisp b/examples/03-font-render.lisp
index 551d4ba..0f5207c 100644
--- a/examples/03-font-render.lisp
+++ b/examples/03-font-render.lisp
@@ -32,11 +32,12 @@
     (ww::on-perframe ()
       (let ((rot 
               (gethash target *spin-table* 0.0)))
-        (if (< rot (* 8 pi)) 
+        (if (< rot (* 7.5 pi)) 
             (setf
              (gethash target *spin-table*) (+ rot 0.2)
              (ww::unit-rotation target) rot)
             (progn
+              (setf (ww::unit-rotation target) 0.0)
               (ww::remove-handler target #'spin)
               (remhash target *spin-table*))))))
 
@@ -48,18 +49,29 @@
   (let ((hello
           (make-instance
            'ww::text
+           ;:content "Hell! Oh World ..."
            :content (format nil "Hell!~%Oh World...")
-           :font (ww::get-asset "Ticketing.ttf" :asset-args '(:oversample 2)))))
-
-    (ww::set-height-preserve-aspect hello 100)
+           :font (ww::get-asset "Ticketing.ttf" :asset-args '(:oversample 2))))
+        (instructions
+          (make-instance
+           'ww::text
+           :content "Click to spin. Press a key to change color."
+           :font (ww::get-asset "Ticketing.ttf"))))
+ 
+    (ww::scale-by  hello 3.0)
     (setf
-     (ww::unit-x hello) 100
-     (ww::unit-y hello) 300)
+     (ww::unit-x hello) (* 0.5 (- 800 (ww::unit-width hello))) 
+     (ww::unit-y hello) (* 0.5 (- 600 (ww::unit-height hello))))
     (ww::add-handler hello #'marquee)
     (ww::add-handler hello #'change-text-color)
     (ww::add-handler hello #'twirl-on-click)
     (ww::refocus-on hello)
-    (ww::add-unit app hello)))
+    (ww::add-unit app hello)
+
+    (ww::scale-by instructions 2.0)
+    (setf
+     (ww::unit-x instructions) (* 0.5 (- 800 (ww::unit-width instructions))))
+    (ww::add-unit app instructions)))
 
 
 (defun start ()
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
-- 
cgit v1.2.3