Add ui.text:line-metrics word, and core-text implementation

basis/core-text/core-text.factor

@@ -41,31 +41,29 @@ FUNCTION: CGRect CTLineGetImageBounds ( CTLineRef line, CGContextRef context ) ;
         CTLineCreateWithAttributedString
     ] with-destructors ;
 
-TUPLE: line font line bounds dim bitmap age refs disposed ;
+TUPLE: line font line metrics dim bitmap age refs disposed ;
 
-TUPLE: typographic-bounds width ascent descent leading ;
+: compute-line-metrics ( line -- line-metrics )
-
-: line-typographic-bounds ( line -- typographic-bounds )
     0 <CGFloat> 0 <CGFloat> 0 <CGFloat>
     [ CTLineGetTypographicBounds ] 3keep [ *CGFloat ] tri@
-    typographic-bounds boa ;
+    line-metrics boa ;
 
 : bounds>dim ( bounds -- dim )
     [ width>> ] [ [ ascent>> ] [ descent>> ] bi + ] bi
     [ ceiling >fixnum ]
     bi@ 2array ;
 
-:: <line> ( string font -- line )
+:: <line> ( font string -- line )
     [
         [let* | open-font [ font cache-font CFRetain |CFRelease ]
                 line [ string open-font font foreground>> <CTLine> |CFRelease ]
-                bounds [ line line-typographic-bounds ]
+                metrics [ line compute-line-metrics ]
                 dim [ bounds bounds>dim ] |
             dim [
                 {
                     [ font background>> >rgba-components CGContextSetRGBFillColor ]
                     [ 0 0 dim first2 <CGRect> CGContextFillRect ]
-                    [ 0 bounds descent>> CGContextSetTextPosition ]
+                    [ 0 metrics descent>> CGContextSetTextPosition ]
                     [ line swap CTLineDraw ]
                 } cleave
             ] with-bitmap-context
@@ -84,7 +82,7 @@ M: line dispose* [ font>> CFRelease ] [ line>> CFRelease ] bi ;
 
 SYMBOL: cached-lines
 
-: cached-line ( string font -- line )
+: cached-line ( font string -- line )
     cached-lines get [ <line> ] 2cache ;
 
 CONSTANT: max-line-age 10

basis/fonts/fonts.factor

@@ -34,14 +34,16 @@ TUPLE: font name size bold? italic? foreground background ;
 : serif-font ( -- font )
     <font>
         "serif" >>name
-        12 >>size ; foldable
+        12 >>size ;
 
 : sans-serif-font ( -- font )
     <font>
         "sans-serif" >>name
-        12 >>size ; foldable
+        12 >>size ;
 
 : monospace-font ( -- font )
     <font>
         "monospace" >>name
-        12 >>size ; foldable
+        12 >>size ;
+
+TUPLE: line-metrics width ascent descent leading ;

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

@@ -10,7 +10,7 @@ IN: ui.text.core-text
 SINGLETON: core-text-renderer
 
 M: core-text-renderer string-dim
-    [ " " string-dim { 0 1 } v* ] [ swap cached-line dim>> ] if-empty ;
+    [ " " string-dim { 0 1 } v* ] [ cached-line dim>> ] if-empty ;
 
 TUPLE: rendered-line line texture display-list age disposed ;
 
@@ -46,7 +46,7 @@ M: rendered-line dispose*
     [ texture>> delete-texture ]
     [ display-list>> delete-dlist ] tri ;
 
-: rendered-line ( string font -- rendered-line )
+: rendered-line ( font string -- rendered-line )
     world get fonts>>
     [ cached-line <rendered-line> ] 2cache 0 >>age ;
 
@@ -58,20 +58,22 @@ M: core-text-renderer finish-text-rendering
 
 M: core-text-renderer draw-string ( font string loc -- )
     [
-        swap rendered-line
+        rendered-line display-list>> glCallList
-        display-list>> glCallList
     ] with-translation ;
 
 M: core-text-renderer x>offset ( x font string -- n )
     [ 2drop 0 ] [
-        swap cached-line line>>
+        cached-line line>>
         swap 0 <CGPoint> CTLineGetStringIndexForPosition
     ] if-empty ;
 
 M: core-text-renderer offset>x ( n font string -- x )
-    swap cached-line line>> swap f
+    cached-line line>> swap f
     CTLineGetOffsetForStringIndex ;
 
+M: core-text-renderer line-metrics ( font string -- metrics )
+    cached-line metrics>> ;
+
 M: core-text-renderer free-fonts ( fonts -- )
     values dispose-each ;
 

basis/ui/text/text-docs.factor

@@ -44,6 +44,10 @@ HELP: offset>x
 { $values { "n" integer } { "font" font } { "string" string } { "x" real } }
 { $contract "Outputs the x co-ordinate of the character at the given index." } ;
 
+HELP: line-metrics
+{ $values { "font" font } { "string" string } { "metrics" line-metrics } }
+{ $contract "Outputs a " { $link line-metrics } " object with text measurements." } ;
+
 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 and FreeType on Windows and X11."
 { $subsection "fonts" }

basis/ui/text/text.factor

@@ -50,6 +50,8 @@ M: sequence text-dim
 
 : text-height ( font text -- h ) text-dim second ;
 
+HOOK: text-metrics font-renderer ( font string -- metrics )
+
 GENERIC# draw-text 1 ( font text loc -- )
 
 M: string draw-text draw-string ;