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 ;
: 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>
[ CTLineGetTypographicBounds ] 3keep [ *CGFloat ] tri@
<metrics> ;
[ CTLineGetTypographicBounds ] 3keep
{
[ >>width ]
[ *CGFloat >>ascent ]
[ *CGFloat >>descent ]
[ *CGFloat >>leading ]
} spread
dup compute-height ;
: bounds>dim ( bounds -- dim )
[ width>> ] [ [ ascent>> ] [ descent>> ] bi + ] bi
[ ceiling >fixnum ]
[ ceiling >integer ]
bi@ 2array ;
: fill-background ( context font dim -- )
@ -81,7 +93,7 @@ TUPLE: line font line metrics image disposed ;
[
[let* | open-font [ font cache-font CFRetain |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 ] |
open-font line metrics
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 CTFontGetCapHeight ( CTFontRef font ) ;
FUNCTION: CGFloat CTFontGetXHeight ( CTFontRef font ) ;
CONSTANT: font-names
H{
{ "monospace" "Monaco" }
@ -106,12 +110,15 @@ MEMO: (cache-font) ( font -- open-font )
strip-font-colors (cache-font) ;
MEMO: (cache-font-metrics) ( font -- metrics )
[ metrics new ] dip
(cache-font) {
[ drop 0 ]
[ CTFontGetAscent ]
[ CTFontGetDescent ]
[ CTFontGetLeading ]
} cleave <metrics> ;
[ CTFontGetAscent >>ascent ]
[ CTFontGetDescent >>descent ]
[ CTFontGetLeading >>leading ]
[ CTFontGetCapHeight >>cap-height ]
[ CTFontGetXHeight >>x-height ]
} cleave
dup compute-height ;
: cache-font-metrics ( 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' )
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 )
[ 2dup + ] dip metrics boa ;
: compute-height ( metrics -- )
dup [ ascent>> ] [ descent>> ] bi + >>height drop ;
TUPLE: selection string start end color ;