From 4f69495fadead5def345533693207ce40817e550 Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Fri, 15 Aug 2014 22:54:07 -0400
Subject: Convert text label to mesh.

* sly/font.scm (make-label): Return mesh.
  (label?, label-font, label-text, label-position, label-color,
  draw-label): Delete.
---
 sly/font.scm | 85 +++++++++++++++++++-----------------------------------------
 1 file changed, 27 insertions(+), 58 deletions(-)

diff --git a/sly/font.scm b/sly/font.scm
index c2e57b6..fd0a304 100644
--- a/sly/font.scm
+++ b/sly/font.scm
@@ -28,27 +28,19 @@
   #:use-module ((sdl sdl) #:prefix SDL:)
   #:use-module ((sdl ttf) #:prefix SDL:)
   #:use-module (gl)
-  #:use-module (gl contrib packed-struct)
+  #:use-module (sly wrappers gl)
   #:use-module (sly color)
   #:use-module (sly config)
+  #:use-module (sly mesh)
   #:use-module (sly shader)
-  #:use-module (sly signal)
   #:use-module (sly texture)
   #:use-module (sly vector)
-  #:use-module (sly window)
-  #:use-module (sly wrappers gl)
   #:export (enable-fonts
             load-font
             load-default-font
             font?
             font-point-size
-            make-label
-            label?
-            label-font
-            label-text
-            label-position
-            label-color
-            draw-label))
+            make-label))
 
 ;;;
 ;;; Font
@@ -111,50 +103,27 @@ argument with a default value of 12."
                   (SDL:surface:h surface)
                   0 0 1 1)))
 
-(define-record-type <label>
-  (%make-label font text position anchor color texture vertices)
-  label?
-  (font label-font)
-  (text %label-text)
-  (position %label-position)
-  (anchor label-anchor)
-  (color %label-color)
-  (texture label-texture)
-  (vertices label-vertices))
-
-(define label-text (compose signal-ref-maybe %label-text))
-(define label-position (compose signal-ref-maybe %label-position))
-(define label-color (compose signal-ref-maybe %label-color))
-
-(define (make-label-vertices texture)
-  "Return a packed array of vertices for TEXTURE."
-  (let ((vertices (make-packed-array texture-vertex 4)))
-    (pack-texture-vertices vertices 0
-                           (texture-width texture)
-                           (texture-height texture)
-                           (texture-s1 texture)
-                           (texture-t1 texture)
-                           (texture-s2 texture)
-                           (texture-t2 texture))
-    vertices))
-
-(define* (make-label font text position #:optional #:key
-                     (color white) (anchor 'top-left))
-  "Return a new label containing the string TEXT rendered with FONT at
-the given position.  Optional arguments are COLOR with a default of
-white and ANCHOR with a default of 'top-left."
-  (let* ((texture (render-text font text))
-         (vertices (and texture (make-label-vertices texture)))
-         (anchor (if texture (anchor-texture texture anchor) #(0 0))))
-    (%make-label font text position anchor color texture vertices)))
-
-(define (draw-label label)
-  "Draw LABEL on the screen."
-  (when (label-texture label)
-    (with-shader-program font-shader
-      (uniforms ((projection (signal-ref window-projection))
-                 (position (label-position label))
-                 (anchor (label-anchor label))
-                 (color (label-color label)))
-        (draw-texture-vertices (label-texture label) (label-vertices label) 1))))
-  *unspecified*)
+(define* (make-label font text #:optional #:key
+                     (anchor 'top-left) (color white)
+                     (shader font-shader))
+  (let ((texture (render-text font text)))
+    (let ((w (texture-width texture))
+          (h (texture-height texture))
+          (s1 (texture-s1 texture))
+          (t1 (texture-t1 texture))
+          (s2 (texture-s2 texture))
+          (t2 (texture-t2 texture)))
+      (make-mesh
+       #:shader shader
+       #:texture texture
+       #:indices #(0 3 2 0 2 1)
+       #:data `(("position" ,(vector
+                              (vector 0 0 0)
+                              (vector w 0 0)
+                              (vector w h 0)
+                              (vector 0 h 0)))
+                ("tex" ,(vector
+                         (vector s1 t1)
+                         (vector s2 t1)
+                         (vector s2 t2)
+                         (vector s1 t2))))))))
-- 
cgit v1.2.3