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

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

db4
Slava Pestov 2009-02-21 01:26:50 -06:00
parent 221222cb8f
commit 11f509b0c7
3 changed files with 22 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -48,22 +48,28 @@ ERROR: not-a-string object ;
TUPLE: line font line metrics image loc dim disposed ; TUPLE: line font line metrics image loc dim disposed ;
: compute-line-metrics ( open-font line -- line-metrics ) : typographic-bounds ( line -- width ascent descent leading )
[
[ 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 [ CTLineGetTypographicBounds ] 3keep [ *CGFloat ] tri@ ; inline
: store-typographic-bounds ( metrics width ascent descent leading -- metrics )
{ {
[ >>width ] [ >>width ]
[ *CGFloat >>ascent ] [ >>ascent ]
[ *CGFloat >>descent ] [ >>descent ]
[ *CGFloat >>leading ] [ >>leading ]
} spread } spread ; inline
dup compute-height ;
: 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 ) : metrics>dim ( bounds -- dim )
[ width>> ] [ [ ascent>> ] [ descent>> ] bi + ] bi [ width>> ] [ [ ascent>> ] [ descent>> ] bi + ] bi

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

@ -118,7 +118,7 @@ MEMO: (cache-font-metrics) ( font -- metrics )
[ CTFontGetCapHeight >>cap-height ] [ CTFontGetCapHeight >>cap-height ]
[ CTFontGetXHeight >>x-height ] [ CTFontGetXHeight >>x-height ]
} cleave } cleave
dup compute-height ; compute-height ;
: cache-font-metrics ( font -- metrics ) : cache-font-metrics ( font -- metrics )
strip-font-colors (cache-font-metrics) ; strip-font-colors (cache-font-metrics) ;

4
basis/fonts/fonts.factor
View File

@ -60,8 +60,8 @@ italic?
TUPLE: metrics width ascent descent height leading cap-height x-height ; TUPLE: metrics width ascent descent height leading cap-height x-height ;
: compute-height ( metrics -- ) : compute-height ( metrics -- metrics )
dup [ ascent>> ] [ descent>> ] bi + >>height drop ; dup [ ascent>> ] [ descent>> ] bi + >>height ; inline
TUPLE: selection string start end color ; TUPLE: selection string start end color ;