steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Add x-height and cap-height metrics

db4
Slava Pestov 2009-02-15 02:13:16 -06:00
parent 09630e5bf4
commit 0c4c0410ef
3 changed files with 32 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
basis/core-text/core-text.factor
View File

@ -48,14 +48,26 @@ ERROR: not-a-string object ;
TUPLE: line font line metrics image disposed ; TUPLE: line font line metrics image disposed ;
: compute-line-metrics ( line -- line-metrics ) : compute-line-metrics ( open-font line -- line-metrics )
[
[ metrics new ] dip
[ CTFontGetCapHeight >>cap-height ]
[ CTFontGetXHeight >>x-height ]
bi
] dip
0 <CGFloat> 0 <CGFloat> 0 <CGFloat> 0 <CGFloat> 0 <CGFloat> 0 <CGFloat>
[ CTLineGetTypographicBounds ] 3keep [ *CGFloat ] tri@ [ CTLineGetTypographicBounds ] 3keep
<metrics> ; {
[ >>width ]
[ *CGFloat >>ascent ]
[ *CGFloat >>descent ]
[ *CGFloat >>leading ]
} spread
dup compute-height ;
: bounds>dim ( bounds -- dim ) : bounds>dim ( bounds -- dim )
[ width>> ] [ [ ascent>> ] [ descent>> ] bi + ] bi [ width>> ] [ [ ascent>> ] [ descent>> ] bi + ] bi
[ ceiling >fixnum ] [ ceiling >integer ]
bi@ 2array ; bi@ 2array ;
: fill-background ( context font dim -- ) : fill-background ( context font dim -- )
@ -81,7 +93,7 @@ TUPLE: line font line metrics image disposed ;
[ [
[let* | open-font [ font cache-font CFRetain |CFRelease ] [let* | open-font [ font cache-font CFRetain |CFRelease ]
line [ string open-font font foreground>> <CTLine> |CFRelease ] line [ string open-font font foreground>> <CTLine> |CFRelease ]
metrics [ line compute-line-metrics ] metrics [ open-font line compute-line-metrics ]
dim [ metrics bounds>dim ] | dim [ metrics bounds>dim ] |
open-font line metrics open-font line metrics
dim [ dim [

17
basis/core-text/fonts/fonts.factor
View File

@ -70,6 +70,10 @@ FUNCTION: CGFloat CTFontGetDescent ( CTFontRef font ) ;
FUNCTION: CGFloat CTFontGetLeading ( CTFontRef font ) ; FUNCTION: CGFloat CTFontGetLeading ( CTFontRef font ) ;
FUNCTION: CGFloat CTFontGetCapHeight ( CTFontRef font ) ;
FUNCTION: CGFloat CTFontGetXHeight ( CTFontRef font ) ;
CONSTANT: font-names CONSTANT: font-names
H{ H{
{ "monospace" "Monaco" } { "monospace" "Monaco" }
@ -106,12 +110,15 @@ MEMO: (cache-font) ( font -- open-font )
strip-font-colors (cache-font) ; strip-font-colors (cache-font) ;
MEMO: (cache-font-metrics) ( font -- metrics ) MEMO: (cache-font-metrics) ( font -- metrics )
[ metrics new ] dip
(cache-font) { (cache-font) {
[ drop 0 ] [ CTFontGetAscent >>ascent ]
[ CTFontGetAscent ] [ CTFontGetDescent >>descent ]
[ CTFontGetDescent ] [ CTFontGetLeading >>leading ]
[ CTFontGetLeading ] [ CTFontGetCapHeight >>cap-height ]
} cleave <metrics> ; [ CTFontGetXHeight >>x-height ]
} cleave
dup compute-height ;
: cache-font-metrics ( font -- metrics ) : cache-font-metrics ( font -- metrics )
strip-font-colors (cache-font-metrics) ; strip-font-colors (cache-font-metrics) ;

6
basis/fonts/fonts.factor
View File

@ -58,10 +58,10 @@ italic?
: strip-font-colors ( font -- font' ) : strip-font-colors ( font -- font' )
clone f >>background f >>foreground ; clone f >>background f >>foreground ;
TUPLE: metrics width ascent descent height leading ; TUPLE: metrics width ascent descent height leading cap-height x-height ;
: <metrics> ( width ascent descent leading -- metrics ) : compute-height ( metrics -- )
[ 2dup + ] dip metrics boa ; dup [ ascent>> ] [ descent>> ] bi + >>height drop ;
TUPLE: selection string start end color ; TUPLE: selection string start end color ;