From 65424054b62c9a0bcf01a1ac2217d27365f9fd67 Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson@member.fsf.org>
Date: Sun, 18 Aug 2013 09:23:17 -0400
Subject: Create textbox type.

---
 2d/font.scm | 55 +++++++++++++++++++++++++++++++++++++++++++------------
 1 file changed, 43 insertions(+), 12 deletions(-)

diff --git a/2d/font.scm b/2d/font.scm
index 404272b..70b0904 100644
--- a/2d/font.scm
+++ b/2d/font.scm
@@ -26,7 +26,8 @@
   #:use-module (srfi srfi-9)
   #:use-module (system foreign)
   #:use-module (2d wrappers ftgl)
-  #:use-module (2d color))
+  #:use-module (2d color)
+  #:use-module (2d vector))
 
 ;;;
 ;;; Font
@@ -64,15 +65,45 @@
 ;;; Textbox
 ;;;
 
-;; A textbox is a string of text wrapped within certain dimensions.
-;; (define-record-type <textbox>
-;;   (%make-textbox text layout)
-;;   textbox?
-;;   (text textbox-text)
-;;   (layout textbox-layout))
+;; A textbox is a string of word-wrapped text
+(define-record-type <textbox>
+  (%make-textbox font text position color alignment line-length layout)
+  textbox?
+  (font textbox-font)
+  (text textbox-text set-textbox-text!)
+  (position textbox-position set-textbox-position!)
+  (color textbox-color set-textbox-color!)
+  (alignment textbox-alignment)
+  (line-length textbox-line-length)
+  (layout textbox-layout))
 
-;; (define (make-textbox font text rect)
-;;   (let ((layout (ftgl-create-simple-layout)))
-;;     (ftgl-set-layout-font font)
-;;     (ftgl-set-layout-alignment (ftgl-text-alignment left))
-;;     (ftgl-set-layout-line-length (rect-width rect))))
+(define (make-textbox font text position color alignment line-length)
+  (let ((layout (ftgl-create-layout)))
+    (ftgl-set-layout-font layout (font-ftgl-font font))
+    ;; (ftgl-set-layout-alignment layout (ftgl-text-alignment alignment))
+    (ftgl-set-layout-line-length layout line-length)
+    (%make-textbox font text position color alignment line-length layout)))
+
+(define (draw-textbox textbox)
+  (let ((pos (textbox-position textbox)))
+    (with-gl-push-matrix
+      (gl-translate (vx pos) (vy pos) 0)
+      (apply-color (textbox-color textbox))
+      (ftgl-render-layout (textbox-layout textbox)
+                          (textbox-text textbox)
+                          (ftgl-render-mode all)))))
+
+(export <textbox>
+        make-textbox
+        textbox?
+        textbox-font
+        textbox-text
+        set-textbox-text!
+        textbox-position
+        set-textbox-position!
+        textbox-color
+        set-textbox-color!
+        textbox-alignment
+        textbox-line-length
+        textbox-layout
+        draw-textbox)
-- 
cgit v1.2.3