diff --git a/basis/core-text/core-text.factor b/basis/core-text/core-text.factor index 0648128d11..bbd4ea7d5f 100644 --- 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 0 0 - [ 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 9bf448e7b0..4525509d44 100644 --- 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 aa689d194f..fb89bdbfb0 100644 --- 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 ;