summaryrefslogtreecommitdiff
path: root/2d
diff options
context:
space:
mode:
authorDavid Thompson <dthompson@member.fsf.org>2013-08-18 09:23:17 -0400
committerDavid Thompson <dthompson@member.fsf.org>2013-08-18 09:23:17 -0400
commit65424054b62c9a0bcf01a1ac2217d27365f9fd67 (patch)
treec93d2847d2bacc989452fd43a2339ab4fc21a987 /2d
parent6e8aced1af1fe2d4c0c9ea71314bcf6586316df9 (diff)
Create textbox type.
Diffstat (limited to '2d')
-rw-r--r--2d/font.scm55
1 files 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)