Tweak font rendering to avoid roundoff error

db4
Slava Pestov 2008-05-29 02:40:32 -05:00
parent 8bff6eba52
commit cf587c054d
2 changed files with 74 additions and 56 deletions

View File

@ -203,9 +203,7 @@ TUPLE: sprite loc dim dim2 dlist texture ;
dup sprite-loc gl-translate dup sprite-loc gl-translate
GL_TEXTURE_2D over sprite-texture glBindTexture GL_TEXTURE_2D over sprite-texture glBindTexture
init-texture init-texture
GL_QUADS [ dup sprite-dim2 four-sides ] do-state GL_QUADS [ sprite-dim2 four-sides ] do-state
dup sprite-dim { 1 0 } v*
swap sprite-loc v- gl-translate
GL_TEXTURE_2D 0 glBindTexture ; GL_TEXTURE_2D 0 glBindTexture ;
: rect-vertices ( lower-left upper-right -- ) : rect-vertices ( lower-left upper-right -- )

View File

@ -3,7 +3,8 @@
USING: alien alien.accessors alien.c-types arrays io kernel libc USING: alien alien.accessors alien.c-types arrays io kernel libc
math math.vectors namespaces opengl opengl.gl prettyprint assocs math math.vectors namespaces opengl opengl.gl prettyprint assocs
sequences io.files io.styles continuations freetype sequences io.files io.styles continuations freetype
ui.gadgets.worlds ui.render ui.backend byte-arrays ; ui.gadgets.worlds ui.render ui.backend byte-arrays accessors
locals ;
IN: ui.freetype IN: ui.freetype
@ -41,8 +42,8 @@ M: font hashcode* drop font hashcode* ;
] bind ; ] bind ;
M: freetype-renderer free-fonts ( world -- ) M: freetype-renderer free-fonts ( world -- )
dup world-handle select-gl-context [ handle>> select-gl-context ]
world-fonts [ nip second free-sprites ] assoc-each ; [ fonts>> [ nip second free-sprites ] assoc-each ] bi ;
: ttf-name ( font style -- name ) : ttf-name ( font style -- name )
2array H{ 2array H{
@ -67,7 +68,7 @@ M: freetype-renderer free-fonts ( world -- )
#! We use FT_New_Memory_Face, not FT_New_Face, since #! We use FT_New_Memory_Face, not FT_New_Face, since
#! FT_New_Face only takes an ASCII path name and causes #! FT_New_Face only takes an ASCII path name and causes
#! problems on localized versions of Windows #! problems on localized versions of Windows
freetype -rot 0 f <void*> [ [ freetype ] 2dip 0 f <void*> [
FT_New_Memory_Face freetype-error FT_New_Memory_Face freetype-error
] keep *void* ; ] keep *void* ;
@ -85,29 +86,29 @@ SYMBOL: dpi
: font-units>pixels ( n font -- n ) : font-units>pixels ( n font -- n )
face-size face-size-y-scale FT_MulFix ; face-size face-size-y-scale FT_MulFix ;
: init-ascent ( font face -- ) : init-ascent ( font face -- font )
dup face-y-max swap font-units>pixels swap set-font-ascent ; dup face-y-max swap font-units>pixels >>ascent ; inline
: init-descent ( font face -- ) : init-descent ( font face -- font )
dup face-y-min swap font-units>pixels swap set-font-descent ; dup face-y-min swap font-units>pixels >>descent ; inline
: init-font ( font -- ) : init-font ( font -- font )
dup font-handle 2dup init-ascent dupd init-descent dup handle>> init-ascent
dup font-ascent over font-descent - ft-ceil dup handle>> init-descent
swap set-font-height ; dup [ ascent>> ] [ descent>> ] bi - ft-ceil >>height ; inline
: set-char-size ( handle size -- )
0 swap 6 shift dpi get-global dup FT_Set_Char_Size freetype-error ;
: <font> ( handle -- font ) : <font> ( handle -- font )
H{ } clone font new
{ set-font-handle set-font-widths } font construct H{ } clone >>widths
dup init-font ; over first2 open-face >>handle
dup handle>> rot third set-char-size
: (open-font) ( font -- open-font ) init-font ;
first3 >r open-face dup 0 r> 6 shift
dpi get-global dpi get-global FT_Set_Char_Size
freetype-error <font> ;
M: freetype-renderer open-font ( font -- open-font ) M: freetype-renderer open-font ( font -- open-font )
freetype drop open-fonts get [ (open-font) ] cache ; freetype drop open-fonts get [ <font> ] cache ;
: load-glyph ( font char -- glyph ) : load-glyph ( font char -- glyph )
>r font-handle dup r> 0 FT_Load_Char >r font-handle dup r> 0 FT_Load_Char
@ -132,30 +133,36 @@ M: freetype-renderer string-height ( open-font string -- h )
load-glyph dup load-glyph dup
FT_RENDER_MODE_NORMAL FT_Render_Glyph freetype-error ; FT_RENDER_MODE_NORMAL FT_Render_Glyph freetype-error ;
: copy-pixel ( bit tex -- bit tex ) :: copy-pixel ( i j bitmap texture -- i j )
255 f pick set-alien-unsigned-1 1+ 255 tex j set-alien-unsigned-1
f pick alien-unsigned-1 i bitmap alien-unsigned-1 j 1 + texture set-alien-unsigned-1
f pick set-alien-unsigned-1 >r 1+ r> 1+ ; i 1 + j 2 + ; inline
: (copy-row) ( bit tex bitend texend -- bitend texend ) : (copy-row) ( i j bitmap texture end -- )
>r pick over >= [ i end < [
2nip r> i j bitmap texture copy-pixel
] [ i j bitmap texture end (copy-row)
>r copy-pixel r> r> (copy-row) ] when ; inline
] if ;
: copy-row ( bit tex width width2 -- bitend texend width width2 ) : copy-row ( i j bitmap texture width width2 -- i j )
[ pick + >r pick + r> (copy-row) ] 2keep ; i j bitmap texture i width + (copy-row)
i width +
j width2 + ; inline
: copy-bitmap ( glyph texture -- ) :: copy-bitmap ( glyph texture -- )
over glyph-bitmap-rows >r [let* | texture [ texture alien-address ]
over glyph-bitmap-width dup next-power-of-2 2 * bitmap [ glyph glyph-bitmap-buffer alien-address ]
>r >r >r glyph-bitmap-buffer alien-address r> r> r> r> rows [ glyph glyph-bitmap-rows ]
[ copy-row ] times 2drop 2drop ; width [ glyph glyph-bitmap-width ]
width2 [ width next-power-of-2 2 * ] |
0 0
rows [ bitmap texture width width2 copy-row ] times
2drop
] ;
: bitmap>texture ( glyph sprite -- id ) : bitmap>texture ( glyph sprite -- id )
tuck sprite-size2 * 2 * [ tuck sprite-size2 * 2 * [
alien-address [ copy-bitmap ] keep <alien> gray-texture [ copy-bitmap ] keep gray-texture
] with-malloc ; ] with-malloc ;
: glyph-texture-loc ( glyph font -- loc ) : glyph-texture-loc ( glyph font -- loc )
@ -163,34 +170,47 @@ M: freetype-renderer string-height ( open-font string -- h )
font-ascent swap glyph-hori-bearing-y - ft-floor 2array ; font-ascent swap glyph-hori-bearing-y - ft-floor 2array ;
: glyph-texture-size ( glyph -- dim ) : glyph-texture-size ( glyph -- dim )
dup glyph-bitmap-width next-power-of-2 [ glyph-bitmap-width next-power-of-2 ]
swap glyph-bitmap-rows next-power-of-2 2array ; [ glyph-bitmap-rows next-power-of-2 ]
bi 2array ;
: <char-sprite> ( font char -- sprite ) : <char-sprite> ( open-font char -- sprite )
over >r render-glyph dup r> glyph-texture-loc over >r render-glyph dup r> glyph-texture-loc
over glyph-size pick glyph-texture-size <sprite> over glyph-size pick glyph-texture-size <sprite>
[ bitmap>texture ] keep [ init-sprite ] keep ; [ bitmap>texture ] keep [ init-sprite ] keep ;
: draw-char ( open-font char sprites -- ) :: char-sprite ( open-font sprites char -- sprite )
[ dupd <char-sprite> ] cache nip char sprites [ open-font swap <char-sprite> ] cache ;
sprite-dlist glCallList ;
: (draw-string) ( open-font sprites string loc -- ) : draw-char ( open-font sprites char loc -- )
GL_MODELVIEW [
0 0 glTranslated
char-sprite sprite-dlist glCallList
] do-matrix ;
: char-widths ( open-font string -- widths )
[ char-width ] with { } map-as ;
: scan-sums ( seq -- seq' )
0 [ + ] accumulate nip ;
:: (draw-string) ( open-font sprites string loc -- )
GL_TEXTURE_2D [ GL_TEXTURE_2D [
[ loc [
[ >r 2dup r> swap draw-char ] each 2drop string open-font string char-widths scan-sums [
[ open-font sprites ] 2dip draw-char
] 2each
] with-translation ] with-translation
] do-enabled ; ] do-enabled ;
: font-sprites ( open-font world -- pair ) : font-sprites ( font world -- open-font sprites )
world-fonts [ open-font H{ } clone 2array ] cache ; world-fonts [ open-font H{ } clone 2array ] cache first2 ;
M: freetype-renderer draw-string ( font string loc -- ) M: freetype-renderer draw-string ( font string loc -- )
>r >r world get font-sprites first2 r> r> (draw-string) ; >r >r world get font-sprites r> r> (draw-string) ;
: run-char-widths ( open-font string -- widths ) : run-char-widths ( open-font string -- widths )
[ char-width ] with { } map-as char-widths [ scan-sums ] [ 2 v/n ] bi v+ ;
dup 0 [ + ] accumulate nip swap 2 v/n v+ ;
M: freetype-renderer x>offset ( x open-font string -- n ) M: freetype-renderer x>offset ( x open-font string -- n )
dup >r run-char-widths [ <= ] with find drop dup >r run-char-widths [ <= ] with find drop