ui.text: add a string>image hook and clean up a bit of code duplication

basis/ui/text/core-text/core-text.factor

@@ -1,11 +1,10 @@
-! Copyright (C) 2009 Slava Pestov.
+! Copyright (C) 2009, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: assocs accessors alien core-graphics.types core-text
-core-text.fonts kernel hashtables namespaces sequences
+core-text.fonts kernel hashtables namespaces sequences ui.text
-ui.gadgets.worlds ui.text ui.text.private opengl opengl.gl
+ui.text.private destructors combinators core-foundation
-opengl.textures destructors combinators core-foundation
+core-foundation.strings math math.vectors init colors
-core-foundation.strings math math.vectors init colors colors.constants
+colors.constants cache arrays images ;
-cache arrays images ;
 IN: ui.text.core-text
 
 SINGLETON: core-text-renderer
@@ -18,13 +17,8 @@ M: core-text-renderer string-dim
 M: core-text-renderer flush-layout-cache
     cached-lines get purge-cache ;
 
-: rendered-line ( font string -- texture )
+M: core-text-renderer string>image ( font string -- image loc )
-    world get world-text-handle [
+    cached-line [ image>> ] [ loc>> ] bi ;
-        cached-line [ image>> ] [ loc>> ] bi <texture>
-    ] 2cache ;
-
-M: core-text-renderer draw-string ( font string -- )
-    rendered-line draw-texture ;
 
 M: core-text-renderer x>offset ( x font string -- n )
     [ 2drop 0 ] [

basis/ui/text/pango/pango.factor

@@ -1,8 +1,8 @@
-! Copyright (C) 2009 Slava Pestov.
+! Copyright (C) 2009, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien.c-types assocs cache kernel math math.vectors
+USING: accessors assocs cache kernel math math.vectors
-namespaces opengl.textures pango.cairo pango.layouts ui.gadgets.worlds
+namespaces pango.cairo pango.layouts ui.text ui.text.private
-ui.text ui.text.private pango sequences ;
+pango sequences ;
 IN: ui.text.pango
 
 SINGLETON: pango-renderer
@@ -14,13 +14,8 @@ M: pango-renderer string-dim
 M: pango-renderer flush-layout-cache
     cached-layouts get purge-cache ;
 
-: rendered-layout ( font string -- texture )
+M: pango-renderer string>image ( font string -- image loc )
-    world get world-text-handle [
+    cached-layout [ image>> ] [ text-position vneg ] bi ;
-        cached-layout [ image>> ] [ text-position vneg ] bi <texture>
-    ] 2cache ;
-
-M: pango-renderer draw-string ( font string -- )
-    rendered-layout draw-texture ;
 
 M: pango-renderer x>offset ( x font string -- n )
     cached-layout swap x>line-offset ;

basis/ui/text/text-docs.factor

@@ -48,6 +48,10 @@ HELP: line-metrics
 { $values { "font" font } { "string" string } { "metrics" line-metrics } }
 { $contract "Outputs a " { $link metrics } " object with text measurements." } ;
 
+HELP: string>image
+{ $values { "font" font } { "string" string } { "image" image } { "loc" "a pair of real numbers" } }
+{ $description "Renders a line of text into an image." } ;
+
 ARTICLE: "text-rendering" "Rendering text"
 "The " { $vocab-link "ui.text" } " vocabulary provides a cross-platform interface to the operating system's native font rendering engine. Currently, it uses Core Text on Mac OS X, Uniscribe on Windows and Pango on X11."
 { $subsections "fonts" }
@@ -64,7 +68,7 @@ ARTICLE: "text-rendering" "Rendering text"
     offset>x
 }
 "Rendering text:"
-{ $subsections draw-text }
+{ $subsections draw-text string>image }
 "Low-level text protocol for UI backends:"
 { $subsections
     string-width

basis/ui/text/text-tests.factor

@@ -1,6 +1,7 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: tools.test ui.text fonts math accessors kernel sequences ;
+USING: tools.test ui.text images fonts math arrays accessors kernel
+sequences ;
 IN: ui.text.tests
 
 [ t ] [ 0 sans-serif-font "aaa" offset>x zero? ] unit-test
@@ -20,3 +21,5 @@ IN: ui.text.tests
 [ t ] [ sans-serif-font "" text-dim first zero? ] unit-test
 
 [ f ] [ sans-serif-font font-metrics height>> zero? ] unit-test
+
+[ t ] [ serif-font "Hello world" string>image [ image? ] [ pair? ] bi* and ] unit-test

basis/ui/text/text.factor

@@ -1,8 +1,8 @@
-! Copyright (C) 2009 Slava Pestov.
+! Copyright (C) 2009, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel arrays sequences math math.order cache opengl
+USING: kernel arrays assocs sequences math math.order cache
-opengl.gl strings fonts colors accessors namespaces
+opengl opengl.gl opengl.textures strings fonts colors accessors
-ui.gadgets.worlds ;
+namespaces ui.gadgets.worlds ;
 IN: ui.text
 
 <PRIVATE
@@ -29,8 +29,6 @@ M: object string-width string-dim first ;
 
 M: object string-height string-dim second ;
 
-HOOK: draw-string font-renderer ( font string -- )
-
 HOOK: free-fonts font-renderer ( world -- )
 
 : combine-text-dim ( dim1 dim2 -- dim3 )
@@ -59,6 +57,22 @@ HOOK: font-metrics font-renderer ( font -- metrics )
 
 HOOK: line-metrics font-renderer ( font string -- metrics )
 
+HOOK: string>image font-renderer ( font string -- image loc )
+
+<PRIVATE
+
+: string-empty? ( obj -- ? )
+    dup selection? [ string>> ] when empty? ;
+
+: draw-string ( font string -- )
+    dup string-empty? [ 2drop ] [
+        world get world-text-handle
+        [ string>image <texture> ] 2cache
+        draw-texture
+    ] if ;
+
+PRIVATE>
+
 GENERIC: draw-text ( font text -- )
 
 M: string draw-text draw-string ;

basis/ui/text/uniscribe/uniscribe.factor

@@ -1,8 +1,7 @@
-! Copyright (C) 2009 Slava Pestov.
+! Copyright (C) 2009, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors assocs cache kernel math math.vectors sequences fonts
+USING: accessors assocs cache kernel math math.vectors sequences
-namespaces opengl.textures ui.text ui.text.private ui.gadgets.worlds 
+fonts namespaces ui.text ui.text.private windows.uniscribe ;
-windows.uniscribe ;
 IN: ui.text.uniscribe
 
 SINGLETON: uniscribe-renderer
@@ -14,14 +13,8 @@ M: uniscribe-renderer string-dim
 M: uniscribe-renderer flush-layout-cache
     cached-script-strings get purge-cache ;
 
-: rendered-script-string ( font string -- texture )
+M: uniscribe-renderer string>image ( font string -- image loc )
-    world get world-text-handle
+    cached-script-string image>> { 0 0 } ;
-    [ cached-script-string image>> { 0 0 } <texture> ]
-    2cache ;
-
-M: uniscribe-renderer draw-string ( font string -- )
-    dup dup selection? [ string>> ] when empty?
-    [ 2drop ] [ rendered-script-string draw-texture ] if ;
 
 M: uniscribe-renderer x>offset ( x font string -- n )
     [ 2drop 0 ] [