Better error checking for labels and text rendering

diff --git a/basis/core-text/core-text.factor b/basis/core-text/core-text.factor
index 0aa3bce2828d5037b0c84c0c99a8893d55c9d286..86cdf90145a108f4e1ba794e05b73dbab34ed386 100644 (file)
--- a/basis/core-text/core-text.factor
+++ b/basis/core-text/core-text.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays alien alien.c-types alien.syntax kernel
-destructors accessors fry words hashtables
+destructors accessors fry words hashtables strings
 sequences memoize assocs math math.functions locals init
 namespaces combinators fonts colors core-foundation
 core-foundation.strings core-foundation.attributed-strings
@@ -32,9 +32,14 @@ FUNCTION: double CTLineGetTypographicBounds ( CTLineRef line, CGFloat* ascent, C
 
 FUNCTION: CGRect CTLineGetImageBounds ( CTLineRef line, CGContextRef context ) ;
 
+ERROR: not-a-string object ;
+
 : <CTLine> ( string open-font color -- line )
     [
-        [ dup selection? [ string>> ] when ] 2dip
+        [
+            dup selection? [ string>> ] when
+            dup string? [ not-a-string ] unless
+        ] 2dip
         [
             kCTForegroundColorAttributeName set
             kCTFontAttributeName set

diff --git a/basis/ui/gadgets/labels/labels.factor b/basis/ui/gadgets/labels/labels.factor
index e71f29de46fd37fde5d895e7e38cc37ac375da44..89548538ee69c4068e9aaa6db6e8e5ca5cc1f6e7 100644 (file)
--- a/basis/ui/gadgets/labels/labels.factor
+++ b/basis/ui/gadgets/labels/labels.factor
@@ -3,7 +3,7 @@
 USING: accessors arrays hashtables io kernel math math.functions
 namespaces make opengl sequences strings splitting ui.gadgets
 ui.gadgets.tracks ui.gadgets.packs fonts ui.render ui.text
-colors colors.constants models ;
+colors colors.constants models combinators ;
 IN: ui.gadgets.labels
 
 ! A label gadget draws a string.
@@ -14,8 +14,25 @@ SLOT: string
 M: label string>> ( label -- string )
     text>> dup string? [ "\n" join ] unless ; inline
 
+<PRIVATE
+
+PREDICATE: string-array < array [ string? ] all? ;
+
+PRIVATE>
+
+: ?string-lines ( string -- string/array )
+    CHAR: \n over memq? [ string-lines ] when ;
+
+ERROR: not-a-string object ;
+
 M: label (>>string) ( string label -- )
-    [ CHAR: \n over memq? [ string-lines ] when ] dip (>>text) ; inline
+    [
+        {
+            { [ dup string-array? ] [ ] }
+            { [ dup string? ] [ ?string-lines ] }
+            [ not-a-string ]
+        } cond
+    ] dip (>>text) ; inline
 
 : label-theme ( gadget -- gadget )
     sans-serif-font >>font ; inline

diff --git a/basis/ui/text/text.factor b/basis/ui/text/text.factor
index 87e6dc0862bde30e36c2608be30a6c348ef566f3..a901b321a77326a8dce2b4281b85b99ac77cb4eb 100644 (file)
--- a/basis/ui/text/text.factor
+++ b/basis/ui/text/text.factor
@@ -43,7 +43,7 @@ GENERIC: text-dim ( font text -- dim )
 
 M: string text-dim string-dim ;
 
-M: sequence text-dim
+M: array text-dim
     [ { 0 0 } ] 2dip [ string-dim combine-text-dim ] with each ;
 
 : text-width ( font text -- w ) text-dim first ;
@@ -58,7 +58,7 @@ M: string draw-text draw-string ;
 
 M: selection draw-text draw-string ;
 
-M: sequence draw-text
+M: array draw-text
     [
         [
             2dup { 0 0 } draw-string