Add arrange-text procedure.

1 files changed, 24 insertions, 0 deletions

diff --git a/scenes/game.scm b/scenes/game.scm
index f6fb5f6..783a6aa 100644
--- a/scenes/game.scm
+++ b/scenes/game.scm
@@ -41,6 +41,8 @@
 
 (define %width 320)
 (define %height 240)
+(define %line-height 10.0)
+(define %message-margin 3.0)
 
 
 (define-class <character> (<node-2d>)
@@ -280,6 +282,28 @@ you.  I'm sure we will meet again sooner than you expect."
             #:name 'stats #:object player
             #:position (vec2 10.0 (- %height 10.0))))))
 
+(define* (arrange-text text #:key
+                       (character-width 8.0)
+                       (margin 0.0)
+                       (max-width %width))
+  "Take the string TEXT and split it at spaces so that it fits in the
+given MAX-WIDTH.  Return a list of lines."
+  (match (fold (lambda (chunk acc)
+                 (match acc
+                   ((#:width width #:result (and (current-line . tail) lines))
+                    (let* ((len (+ 1 (string-length chunk)))
+                           (chunk-width (* len character-width))
+                           (new-width (+ chunk-width width)))
+                      (if (< (+ new-width margin) max-width)
+                          `(#:width ,new-width
+                            #:result ,(cons (string-append current-line " " chunk) tail))
+                          `(#:width ,chunk-width
+                            #:result ,(cons chunk lines)))))))
+               '(#:width 0 #:result (""))
+               (string-tokenize text))
+    ((#:width _ #:result lines)
+     (reverse lines))))
+
 (define* (collides? player game #:key (layer "collision"))
   (let* ((pos (position player))
          (offset (origin game))