Clean up some code in core-text, and core-text.fonts

diff --git a/basis/core-text/core-text.factor b/basis/core-text/core-text.factor
index 0648128d116755fcddc977b1c2972cf34fba4fb0..bbd4ea7d5fb4beaa0bed9a25ab1a1a891b4c57b7 100644 (file)
--- a/basis/core-text/core-text.factor
+++ b/basis/core-text/core-text.factor
@@ -48,22 +48,28 @@ ERROR: not-a-string object ;
 
 TUPLE: line font line metrics image loc dim disposed ;
 
-: compute-line-metrics ( open-font line -- line-metrics )
-    [
-        [ metrics new ] dip
-        [ CTFontGetCapHeight >>cap-height ]
-        [ CTFontGetXHeight >>x-height ]
-        bi
-    ] dip
+: typographic-bounds ( line -- width ascent descent leading )
     0 <CGFloat> 0 <CGFloat> 0 <CGFloat>
-    [ CTLineGetTypographicBounds ] 3keep
+    [ CTLineGetTypographicBounds ] 3keep [ *CGFloat ] tri@ ; inline
+
+: store-typographic-bounds ( metrics width ascent descent leading -- metrics )
     {
         [ >>width ]
-        [ *CGFloat >>ascent ]
-        [ *CGFloat >>descent ]
-        [ *CGFloat >>leading ]
-    } spread
-    dup compute-height ;
+        [ >>ascent ]
+        [ >>descent ]
+        [ >>leading ]
+    } spread ; inline
+
+: compute-font-metrics ( metrics font -- metrics )
+    [ CTFontGetCapHeight >>cap-height ]
+    [ CTFontGetXHeight >>x-height ]
+    bi ; inline
+
+: compute-line-metrics ( open-font line -- line-metrics )
+    [ metrics new ] 2dip
+    [ compute-font-metrics ]
+    [ typographic-bounds store-typographic-bounds ] bi*
+    compute-height ;
 
 : metrics>dim ( bounds -- dim )
     [ width>> ] [ [ ascent>> ] [ descent>> ] bi + ] bi

diff --git a/basis/core-text/fonts/fonts.factor b/basis/core-text/fonts/fonts.factor
index 9bf448e7b069eed593520fb74b868341015f1291..4525509d4481e622b0457e92a070b9f058bad07b 100644 (file)
--- a/basis/core-text/fonts/fonts.factor
+++ b/basis/core-text/fonts/fonts.factor
@@ -118,7 +118,7 @@ MEMO: (cache-font-metrics) ( font -- metrics )
         [ CTFontGetCapHeight >>cap-height ]
         [ CTFontGetXHeight >>x-height ]
     } cleave
-    dup compute-height ;
+    compute-height ;
 
 : cache-font-metrics ( font -- metrics )
     strip-font-colors (cache-font-metrics) ;

diff --git a/basis/fonts/fonts.factor b/basis/fonts/fonts.factor
index aa689d194fdc39b36c40ba0a8647d946ab9acd32..fb89bdbfb007203ca82b448a420010f62b807b8b 100644 (file)
--- a/basis/fonts/fonts.factor
+++ b/basis/fonts/fonts.factor
@@ -60,8 +60,8 @@ italic?
 
 TUPLE: metrics width ascent descent height leading cap-height x-height ;
 
-: compute-height ( metrics -- )
-    dup [ ascent>> ] [ descent>> ] bi + >>height drop ;
+: compute-height ( metrics -- metrics )
+    dup [ ascent>> ] [ descent>> ] bi + >>height ; inline
 
 TUPLE: selection string start end color ;